diff options
| author | Chong Yidong | 2007-07-05 18:37:29 +0000 |
|---|---|---|
| committer | Chong Yidong | 2007-07-05 18:37:29 +0000 |
| commit | 9db1942d9a0b5e3fe69d585c1ce52d97e9376fce (patch) | |
| tree | 77abde03519cda119d6cfc25ce6597fd184dd14c | |
| parent | 2321b0422615d95a027bd5044b4586dfbd8f8904 (diff) | |
| download | emacs-9db1942d9a0b5e3fe69d585c1ce52d97e9376fce.tar.gz emacs-9db1942d9a0b5e3fe69d585c1ce52d97e9376fce.zip | |
(custom-commands): New variable.
(custom-tool-bar-map): New variable. Initialize using
`custom-commands'.
(custom-mode): Use `custom-tool-bar-map'.
(custom-buffer-create-internal): Insert action buttons only if
tool bar is not used. Use `custom-commands'.
(Custom-help, custom-command-apply): New function.
(custom-command-apply, Custom-set, Custom-save)
(Custom-reset-current, Custom-reset-saved, Custom-reset-standard):
Use `custom-command-apply' instead of duplicating code.
(customize-group-other-window): Call `customize-group' instead of
duplicating code.
(customize-face-other-window): Call `customize-face' instead of
duplicating code.
(customize-group, customize-face): Add optional args for opening
in another window.
(custom-variable-tag): Don't inherit `variable-pitch' face.
(custom-group-tag): Inherit `variable-pitch' face.
(custom-variable-value-create): Set documentation indentation.
(custom-group-value-create): Make group name a link, instead of
using an extra "go to group" button.
(custom-prompt-variable, custom-group-set, custom-group-save)
(custom-group-reset-current, custom-group-reset-saved)
(custom-group-reset-standard): Minor cleanup.
| -rw-r--r-- | lisp/cus-edit.el | 564 |
1 files changed, 258 insertions, 306 deletions
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 9adb72c735c..0b343e6653b 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el | |||
| @@ -755,52 +755,86 @@ groups after non-groups, if nil do not order groups at all." | |||
| 755 | 755 | ||
| 756 | ;;; Custom Mode Commands. | 756 | ;;; Custom Mode Commands. |
| 757 | 757 | ||
| 758 | (defvar custom-options nil | 758 | ;; This variable is used by `custom-tool-bar-map', or directly by |
| 759 | "Customization widgets in the current buffer.") | 759 | ;; `custom-buffer-create-internal' if the toolbar is not present and |
| 760 | 760 | ;; `custom-buffer-verbose-help' is non-nil. | |
| 761 | (defun Custom-set () | 761 | |
| 762 | "Set the current value of all edited settings in the buffer." | 762 | (defvar custom-commands |
| 763 | (interactive) | 763 | '(("Set for current session" Custom-set t |
| 764 | (let ((children custom-options)) | 764 | "Apply all settings in this buffer to the current session" |
| 765 | (if (or (and (= 1 (length children)) | 765 | "index") |
| 766 | (memq (widget-type (car children)) | 766 | ("Save for future sessions" Custom-save |
| 767 | '(custom-variable custom-face))) | 767 | (or custom-file user-init-file) |
| 768 | (y-or-n-p "Set all values according to this buffer? ")) | 768 | "Apply all settings in this buffer and save them for future Emacs sessions." |
| 769 | (mapc (lambda (child) | 769 | "save") |
| 770 | (when (eq (widget-get child :custom-state) 'modified) | 770 | ("Undo edits" Custom-reset-current t |
| 771 | (widget-apply child :custom-set))) | 771 | "Restore all settings in this buffer to reflect their current values." |
| 772 | children) | 772 | "refresh") |
| 773 | (message "Aborted")))) | 773 | ("Reset to saved" Custom-reset-saved t |
| 774 | 774 | "Restore all settings in this buffer to their saved values (if any)." | |
| 775 | (defun Custom-save () | 775 | "undo") |
| 776 | "Set all edited settings, then save all settings that have been set. | 776 | ("Erase customizations" Custom-reset-standard |
| 777 | If a setting was edited and set before, this saves it. | 777 | (or custom-file user-init-file) |
| 778 | If a setting was merely edited before, this sets it then saves it." | 778 | "Un-customize all settings in this buffer and save them with standard values." |
| 779 | "delete") | ||
| 780 | ("Help for Customize" Custom-help t | ||
| 781 | "Get help for using Customize." | ||
| 782 | "help") | ||
| 783 | ("Exit" Custom-buffer-done t "Exit Customize." "exit"))) | ||
| 784 | |||
| 785 | (defun Custom-help () | ||
| 786 | "Read the node on Easy Customization in the Emacs manual." | ||
| 779 | (interactive) | 787 | (interactive) |
| 780 | (let ((children custom-options)) | 788 | (info "(emacs)Easy Customization")) |
| 781 | (if (or (and (= 1 (length children)) | ||
| 782 | (memq (widget-type (car children)) | ||
| 783 | '(custom-variable custom-face))) | ||
| 784 | (yes-or-no-p "Save all settings in this buffer? ")) | ||
| 785 | (progn | ||
| 786 | (mapc (lambda (child) | ||
| 787 | (when (memq (widget-get child :custom-state) | ||
| 788 | '(modified set changed rogue)) | ||
| 789 | (widget-apply child :custom-save))) | ||
| 790 | children) | ||
| 791 | (custom-save-all)) | ||
| 792 | (message "Aborted")))) | ||
| 793 | 789 | ||
| 794 | (defvar custom-reset-menu | 790 | (defvar custom-reset-menu |
| 795 | '(("Undo Edits" . Custom-reset-current) | 791 | '(("Undo Edits" . Custom-reset-current) |
| 796 | ("Reset to Saved" . Custom-reset-saved) | 792 | ("Reset to Saved" . Custom-reset-saved) |
| 797 | ("Erase Customization (use standard values)" . Custom-reset-standard)) | 793 | ("Erase Customizations (use standard values)" . Custom-reset-standard)) |
| 798 | "Alist of actions for the `Reset' button. | 794 | "Alist of actions for the `Reset' button. |
| 799 | The key is a string containing the name of the action, the value is a | 795 | The key is a string containing the name of the action, the value is a |
| 800 | Lisp function taking the widget as an element which will be called | 796 | Lisp function taking the widget as an element which will be called |
| 801 | when the action is chosen.") | 797 | when the action is chosen.") |
| 802 | 798 | ||
| 803 | (defun custom-reset (event) | 799 | (defvar custom-options nil |
| 800 | "Customization widgets in the current buffer.") | ||
| 801 | |||
| 802 | (defun custom-command-apply (fun query &optional strong-query) | ||
| 803 | "Call function FUN on all widgets in `custom-options'. | ||
| 804 | If there is more than one widget, ask user for confirmation using | ||
| 805 | the query string QUERY, using `y-or-n-p' if STRONG-QUERY is nil, | ||
| 806 | and `yes-or-no-p' otherwise." | ||
| 807 | (if (or (and (= 1 (length custom-options)) | ||
| 808 | (memq (widget-type (car custom-options)) | ||
| 809 | '(custom-variable custom-face))) | ||
| 810 | (funcall (if strong-query 'yes-or-no-p 'y-or-n-p) query)) | ||
| 811 | (progn (mapc fun custom-options) t) | ||
| 812 | (message "Aborted") | ||
| 813 | nil)) | ||
| 814 | |||
| 815 | (defun Custom-set (&rest ignore) | ||
| 816 | "Set the current value of all edited settings in the buffer." | ||
| 817 | (interactive) | ||
| 818 | (custom-command-apply | ||
| 819 | (lambda (child) | ||
| 820 | (when (eq (widget-get child :custom-state) 'modified) | ||
| 821 | (widget-apply child :custom-set))) | ||
| 822 | "Set all values according to this buffer? ")) | ||
| 823 | |||
| 824 | (defun Custom-save (&rest ignore) | ||
| 825 | "Set all edited settings, then save all settings that have been set. | ||
| 826 | If a setting was edited and set before, this saves it. | ||
| 827 | If a setting was merely edited before, this sets it then saves it." | ||
| 828 | (interactive) | ||
| 829 | (if (custom-command-apply | ||
| 830 | (lambda (child) | ||
| 831 | (when (memq (widget-get child :custom-state) | ||
| 832 | '(modified set changed rogue)) | ||
| 833 | (widget-apply child :custom-save))) | ||
| 834 | "Save all settings in this buffer? " t) | ||
| 835 | (custom-save-all))) | ||
| 836 | |||
| 837 | (defun custom-reset (widget &optional event) | ||
| 804 | "Select item from reset menu." | 838 | "Select item from reset menu." |
| 805 | (let* ((completion-ignore-case t) | 839 | (let* ((completion-ignore-case t) |
| 806 | (answer (widget-choose "Reset settings" | 840 | (answer (widget-choose "Reset settings" |
| @@ -812,33 +846,21 @@ when the action is chosen.") | |||
| 812 | (defun Custom-reset-current (&rest ignore) | 846 | (defun Custom-reset-current (&rest ignore) |
| 813 | "Reset all edited settings in the buffer to show their current values." | 847 | "Reset all edited settings in the buffer to show their current values." |
| 814 | (interactive) | 848 | (interactive) |
| 815 | (let ((children custom-options)) | 849 | (custom-command-apply |
| 816 | (if (or (and (= 1 (length children)) | 850 | (lambda (widget) |
| 817 | (memq (widget-type (car children)) | 851 | (if (memq (widget-get widget :custom-state) '(modified changed)) |
| 818 | '(custom-variable custom-face))) | 852 | (widget-apply widget :custom-reset-current))) |
| 819 | (y-or-n-p "Reset all settings' buffer text to show current values? ")) | 853 | "Reset all settings' buffer text to show current values? ")) |
| 820 | (mapc (lambda (widget) | ||
| 821 | (if (memq (widget-get widget :custom-state) | ||
| 822 | '(modified changed)) | ||
| 823 | (widget-apply widget :custom-reset-current))) | ||
| 824 | children) | ||
| 825 | (message "Aborted")))) | ||
| 826 | 854 | ||
| 827 | (defun Custom-reset-saved (&rest ignore) | 855 | (defun Custom-reset-saved (&rest ignore) |
| 828 | "Reset all edited or set settings in the buffer to their saved value. | 856 | "Reset all edited or set settings in the buffer to their saved value. |
| 829 | This also shows the saved values in the buffer." | 857 | This also shows the saved values in the buffer." |
| 830 | (interactive) | 858 | (interactive) |
| 831 | (let ((children custom-options)) | 859 | (custom-command-apply |
| 832 | (if (or (and (= 1 (length children)) | 860 | (lambda (widget) |
| 833 | (memq (widget-type (car children)) | 861 | (if (memq (widget-get widget :custom-state) '(modified set changed rogue)) |
| 834 | '(custom-variable custom-face))) | 862 | (widget-apply widget :custom-reset-saved))) |
| 835 | (y-or-n-p "Reset all settings (current values and buffer text) to saved values? ")) | 863 | "Reset all settings (current values and buffer text) to saved values? ")) |
| 836 | (mapc (lambda (widget) | ||
| 837 | (if (memq (widget-get widget :custom-state) | ||
| 838 | '(modified set changed rogue)) | ||
| 839 | (widget-apply widget :custom-reset-saved))) | ||
| 840 | children) | ||
| 841 | (message "Aborted")))) | ||
| 842 | 864 | ||
| 843 | (defun Custom-reset-standard (&rest ignore) | 865 | (defun Custom-reset-standard (&rest ignore) |
| 844 | "Erase all customization (either current or saved) for the group members. | 866 | "Erase all customization (either current or saved) for the group members. |
| @@ -846,20 +868,14 @@ The immediate result is to restore them to their standard values. | |||
| 846 | This operation eliminates any saved values for the group members, | 868 | This operation eliminates any saved values for the group members, |
| 847 | making them as if they had never been customized at all." | 869 | making them as if they had never been customized at all." |
| 848 | (interactive) | 870 | (interactive) |
| 849 | (let ((children custom-options)) | 871 | (custom-command-apply |
| 850 | (if (or (and (= 1 (length children)) | 872 | (lambda (widget) |
| 851 | (memq (widget-type (car children)) | 873 | (and (or (null (widget-get widget :custom-standard-value)) |
| 852 | '(custom-variable custom-face))) | 874 | (widget-apply widget :custom-standard-value)) |
| 853 | (yes-or-no-p "Erase all customizations for settings in this buffer? ")) | 875 | (memq (widget-get widget :custom-state) |
| 854 | (mapc (lambda (widget) | 876 | '(modified set changed saved rogue)) |
| 855 | (and (if (widget-get widget :custom-standard-value) | 877 | (widget-apply widget :custom-reset-standard))) |
| 856 | (widget-apply widget :custom-standard-value) | 878 | "Erase all customizations for settings in this buffer? " t)) |
| 857 | t) | ||
| 858 | (memq (widget-get widget :custom-state) | ||
| 859 | '(modified set changed saved rogue)) | ||
| 860 | (widget-apply widget :custom-reset-standard))) | ||
| 861 | children) | ||
| 862 | (message "Aborted")))) | ||
| 863 | 879 | ||
| 864 | ;;; The Customize Commands | 880 | ;;; The Customize Commands |
| 865 | 881 | ||
| @@ -888,9 +904,9 @@ it as the third element in the list." | |||
| 888 | (cond (prop | 904 | (cond (prop |
| 889 | ;; Use VAR's `variable-interactive' property | 905 | ;; Use VAR's `variable-interactive' property |
| 890 | ;; as an interactive spec for prompting. | 906 | ;; as an interactive spec for prompting. |
| 891 | (call-interactively (list 'lambda '(arg) | 907 | (call-interactively `(lambda (arg) |
| 892 | (list 'interactive prop) | 908 | (interactive ,prop) |
| 893 | 'arg))) | 909 | arg))) |
| 894 | (type | 910 | (type |
| 895 | (widget-prompt-value type | 911 | (widget-prompt-value type |
| 896 | prompt | 912 | prompt |
| @@ -1018,17 +1034,20 @@ then prompt for the MODE to customize." | |||
| 1018 | 1034 | ||
| 1019 | 1035 | ||
| 1020 | ;;;###autoload | 1036 | ;;;###autoload |
| 1021 | (defun customize-group (group) | 1037 | (defun customize-group (&optional group prompt-for-group other-window) |
| 1022 | "Customize GROUP, which must be a customization group." | 1038 | "Customize GROUP, which must be a customization group." |
| 1023 | (interactive | 1039 | (interactive) |
| 1024 | (list (let ((completion-ignore-case t)) | 1040 | (and (null group) |
| 1025 | (completing-read "Customize group (default emacs): " | 1041 | (or prompt-for-group (called-interactively-p)) |
| 1026 | obarray | 1042 | (let ((completion-ignore-case t)) |
| 1027 | (lambda (symbol) | 1043 | (setq group |
| 1028 | (or (and (get symbol 'custom-loads) | 1044 | (completing-read "Customize group (default emacs): " |
| 1029 | (not (get symbol 'custom-autoload))) | 1045 | obarray |
| 1030 | (get symbol 'custom-group))) | 1046 | (lambda (symbol) |
| 1031 | t)))) | 1047 | (or (and (get symbol 'custom-loads) |
| 1048 | (not (get symbol 'custom-autoload))) | ||
| 1049 | (get symbol 'custom-group))) | ||
| 1050 | t)))) | ||
| 1032 | (when (stringp group) | 1051 | (when (stringp group) |
| 1033 | (if (string-equal "" group) | 1052 | (if (string-equal "" group) |
| 1034 | (setq group 'emacs) | 1053 | (setq group 'emacs) |
| @@ -1036,42 +1055,25 @@ then prompt for the MODE to customize." | |||
| 1036 | (let ((name (format "*Customize Group: %s*" | 1055 | (let ((name (format "*Customize Group: %s*" |
| 1037 | (custom-unlispify-tag-name group)))) | 1056 | (custom-unlispify-tag-name group)))) |
| 1038 | (if (get-buffer name) | 1057 | (if (get-buffer name) |
| 1039 | (pop-to-buffer name) | 1058 | (if other-window |
| 1040 | (custom-buffer-create (list (list group 'custom-group)) | 1059 | (let ((pop-up-windows t) |
| 1041 | name | 1060 | (same-window-buffer-names nil) |
| 1042 | (concat " for group " | 1061 | (same-window-regexps nil)) |
| 1043 | (custom-unlispify-tag-name group)))))) | 1062 | (pop-to-buffer name)) |
| 1063 | (pop-to-buffer name)) | ||
| 1064 | (funcall (if other-window | ||
| 1065 | 'custom-buffer-create-other-window | ||
| 1066 | 'custom-buffer-create) | ||
| 1067 | (list (list group 'custom-group)) | ||
| 1068 | name | ||
| 1069 | (concat " for group " | ||
| 1070 | (custom-unlispify-tag-name group)))))) | ||
| 1044 | 1071 | ||
| 1045 | ;;;###autoload | 1072 | ;;;###autoload |
| 1046 | (defun customize-group-other-window (group) | 1073 | (defun customize-group-other-window (&optional group) |
| 1047 | "Customize GROUP, which must be a customization group." | 1074 | "Customize GROUP, which must be a customization group, in another window." |
| 1048 | (interactive | 1075 | (interactive) |
| 1049 | (list (let ((completion-ignore-case t)) | 1076 | (customize-group group t t)) |
| 1050 | (completing-read "Customize group (default emacs): " | ||
| 1051 | obarray | ||
| 1052 | (lambda (symbol) | ||
| 1053 | (or (and (get symbol 'custom-loads) | ||
| 1054 | (not (get symbol 'custom-autoload))) | ||
| 1055 | (get symbol 'custom-group))) | ||
| 1056 | t)))) | ||
| 1057 | (when (stringp group) | ||
| 1058 | (if (string-equal "" group) | ||
| 1059 | (setq group 'emacs) | ||
| 1060 | (setq group (intern group)))) | ||
| 1061 | (let ((name (format "*Customize Group: %s*" | ||
| 1062 | (custom-unlispify-tag-name group)))) | ||
| 1063 | (if (get-buffer name) | ||
| 1064 | (let ( | ||
| 1065 | ;; Copied from `custom-buffer-create-other-window'. | ||
| 1066 | (pop-up-windows t) | ||
| 1067 | (same-window-buffer-names nil) | ||
| 1068 | (same-window-regexps nil)) | ||
| 1069 | (pop-to-buffer name)) | ||
| 1070 | (custom-buffer-create-other-window | ||
| 1071 | (list (list group 'custom-group)) | ||
| 1072 | name | ||
| 1073 | (concat " for group " | ||
| 1074 | (custom-unlispify-tag-name group)))))) | ||
| 1075 | 1077 | ||
| 1076 | ;;;###autoload | 1078 | ;;;###autoload |
| 1077 | (defalias 'customize-variable 'customize-option) | 1079 | (defalias 'customize-variable 'customize-option) |
| @@ -1252,34 +1254,41 @@ Emacs that is associated with version VERSION of PACKAGE." | |||
| 1252 | (< minor1 minor2))))) | 1254 | (< minor1 minor2))))) |
| 1253 | 1255 | ||
| 1254 | ;;;###autoload | 1256 | ;;;###autoload |
| 1255 | (defun customize-face (&optional face) | 1257 | (defun customize-face (&optional face prompt-for-face other-window) |
| 1256 | "Customize FACE, which should be a face name or nil. | 1258 | "Customize FACE, which should be a face name or nil. |
| 1257 | If FACE is nil, customize all faces. If FACE is actually a | 1259 | If FACE is nil, customize all faces. If FACE is actually a |
| 1258 | face-alias, customize the face it is aliased to. | 1260 | face-alias, customize the face it is aliased to. |
| 1259 | 1261 | ||
| 1260 | Interactively, when point is on text which has a face specified, | 1262 | Interactively, when point is on text which has a face specified, |
| 1261 | suggest to customize that face, if it's customizable." | 1263 | suggest to customize that face, if it's customizable." |
| 1262 | (interactive | 1264 | (interactive) |
| 1263 | (list (read-face-name "Customize face" "all faces" t))) | 1265 | (and (null face) |
| 1266 | (or prompt-for-face (called-interactively-p)) | ||
| 1267 | (setq face (read-face-name "Customize face" "all faces" t))) | ||
| 1264 | (if (member face '(nil "")) | 1268 | (if (member face '(nil "")) |
| 1265 | (setq face (face-list))) | 1269 | (setq face (face-list))) |
| 1266 | (if (and (listp face) (null (cdr face))) | 1270 | (if (and (listp face) (null (cdr face))) |
| 1267 | (setq face (car face))) | 1271 | (setq face (car face))) |
| 1268 | (if (listp face) | 1272 | (let ((create-buffer-fn (if other-window |
| 1269 | (custom-buffer-create (custom-sort-items | 1273 | 'custom-buffer-create-other-window |
| 1270 | (mapcar (lambda (s) | 1274 | 'custom-buffer-create))) |
| 1271 | (list s 'custom-face)) | 1275 | (if (listp face) |
| 1272 | face) | 1276 | (funcall create-buffer-fn |
| 1273 | t nil) | 1277 | (custom-sort-items |
| 1274 | "*Customize Faces*") | 1278 | (mapcar (lambda (s) |
| 1275 | ;; If FACE is actually an alias, customize the face it is aliased to. | 1279 | (list s 'custom-face)) |
| 1276 | (if (get face 'face-alias) | 1280 | face) |
| 1277 | (setq face (get face 'face-alias))) | 1281 | t nil) |
| 1278 | (unless (facep face) | 1282 | "*Customize Faces*") |
| 1279 | (error "Invalid face %S" face)) | 1283 | ;; If FACE is actually an alias, customize the face it is aliased to. |
| 1280 | (custom-buffer-create (list (list face 'custom-face)) | 1284 | (if (get face 'face-alias) |
| 1281 | (format "*Customize Face: %s*" | 1285 | (setq face (get face 'face-alias))) |
| 1282 | (custom-unlispify-tag-name face))))) | 1286 | (unless (facep face) |
| 1287 | (error "Invalid face %S" face)) | ||
| 1288 | (funcall create-buffer-fn | ||
| 1289 | (list (list face 'custom-face)) | ||
| 1290 | (format "*Customize Face: %s*" | ||
| 1291 | (custom-unlispify-tag-name face)))))) | ||
| 1283 | 1292 | ||
| 1284 | ;;;###autoload | 1293 | ;;;###autoload |
| 1285 | (defun customize-face-other-window (&optional face) | 1294 | (defun customize-face-other-window (&optional face) |
| @@ -1288,28 +1297,8 @@ If FACE is actually a face-alias, customize the face it is aliased to. | |||
| 1288 | 1297 | ||
| 1289 | Interactively, when point is on text which has a face specified, | 1298 | Interactively, when point is on text which has a face specified, |
| 1290 | suggest to customize that face, if it's customizable." | 1299 | suggest to customize that face, if it's customizable." |
| 1291 | (interactive | 1300 | (interactive) |
| 1292 | (list (read-face-name "Customize face" "all faces" t))) | 1301 | (customize-face face t t)) |
| 1293 | (if (member face '(nil "")) | ||
| 1294 | (setq face (face-list))) | ||
| 1295 | (if (and (listp face) (null (cdr face))) | ||
| 1296 | (setq face (car face))) | ||
| 1297 | (if (listp face) | ||
| 1298 | (custom-buffer-create-other-window | ||
| 1299 | (custom-sort-items | ||
| 1300 | (mapcar (lambda (s) | ||
| 1301 | (list s 'custom-face)) | ||
| 1302 | face) | ||
| 1303 | t nil) | ||
| 1304 | "*Customize Faces*") | ||
| 1305 | (if (get face 'face-alias) | ||
| 1306 | (setq face (get face 'face-alias))) | ||
| 1307 | (unless (facep face) | ||
| 1308 | (error "Invalid face %S" face)) | ||
| 1309 | (custom-buffer-create-other-window | ||
| 1310 | (list (list face 'custom-face)) | ||
| 1311 | (format "*Customize Face: %s*" | ||
| 1312 | (custom-unlispify-tag-name face))))) | ||
| 1313 | 1302 | ||
| 1314 | (defalias 'customize-customized 'customize-unsaved) | 1303 | (defalias 'customize-customized 'customize-unsaved) |
| 1315 | 1304 | ||
| @@ -1541,96 +1530,60 @@ Otherwise use brackets." | |||
| 1541 | 1530 | ||
| 1542 | (defun custom-buffer-create-internal (options &optional description) | 1531 | (defun custom-buffer-create-internal (options &optional description) |
| 1543 | (custom-mode) | 1532 | (custom-mode) |
| 1544 | (if custom-buffer-verbose-help | 1533 | (let ((init-file (or custom-file user-init-file))) |
| 1545 | (progn | 1534 | ;; Insert verbose help at the top of the custom buffer. |
| 1546 | (widget-insert "This is a customization buffer") | 1535 | (when custom-buffer-verbose-help |
| 1547 | (if description | 1536 | (widget-insert "Editing a setting changes only the text in this buffer." |
| 1548 | (widget-insert description)) | 1537 | (if init-file |
| 1549 | (widget-insert (format ". | 1538 | " |
| 1550 | %s buttons; type RET or click mouse-1 to actuate one. | 1539 | To set apply your changes, use the Save or Set buttons. |
| 1551 | Editing a setting changes only the text in the buffer." | 1540 | Saving a change normally works by editing your init file." |
| 1552 | (if custom-raised-buttons | 1541 | " |
| 1553 | "`Raised' text indicates" | 1542 | Currently, these settings cannot be saved for future Emacs sessions, |
| 1554 | "Square brackets indicate"))) | 1543 | possibly because you started Emacs with `-q'.") |
| 1555 | (if init-file-user | 1544 | "\nFor details, see ") |
| 1556 | (widget-insert " | 1545 | (widget-create 'custom-manual |
| 1557 | Use the Save or Set buttons to set apply your changes. | 1546 | :tag "Saving Customizations" |
| 1558 | Saving a change normally works by editing your Emacs ") | 1547 | "(emacs)Saving Customizations") |
| 1559 | (widget-insert " | 1548 | (widget-insert " in the ") |
| 1560 | \nSince you started Emacs with `-q', you cannot save settings into | 1549 | (widget-create 'custom-manual |
| 1561 | the Emacs ")) | 1550 | :tag "Emacs manual" |
| 1562 | (widget-create 'custom-manual | 1551 | :help-echo "Read the Emacs manual." |
| 1563 | :tag "init file" | 1552 | "(emacs)Top") |
| 1564 | "(emacs)Saving Customizations") | 1553 | (widget-insert ".")) |
| 1565 | (widget-insert ".\nSee ") | 1554 | ;; Insert custom command buttons if the toolbar is not in use. |
| 1566 | (widget-create 'custom-manual | 1555 | |
| 1567 | :tag "Help" | 1556 | (widget-insert "\n") |
| 1568 | :help-echo "Read the online help." | 1557 | (when (not (and tool-bar-mode (display-graphic-p))) |
| 1569 | "(emacs)Easy Customization") | 1558 | (if custom-buffer-verbose-help |
| 1570 | (widget-insert " for more information.\n\n") | 1559 | (widget-insert "\n |
| 1571 | (widget-insert "Operate on all settings in this buffer that \ | 1560 | Operate on all settings in this buffer that are not marked HIDDEN:\n")) |
| 1572 | are not marked HIDDEN:\n ")) | 1561 | (let ((button (lambda (tag action active help icon) |
| 1573 | (widget-insert " ")) | 1562 | (widget-insert " ") |
| 1574 | (widget-create 'push-button | 1563 | (if (eval active) |
| 1575 | :tag "Set for Current Session" | 1564 | (widget-create 'push-button :tag tag |
| 1576 | :help-echo "\ | 1565 | :help-echo help :action action)))) |
| 1577 | Make your editing in this buffer take effect for this session." | 1566 | (commands custom-commands)) |
| 1578 | :action (lambda (widget &optional event) | 1567 | (apply button (pop commands)) ; Set for current session |
| 1579 | (Custom-set))) | 1568 | (apply button (pop commands)) ; Save for future sessions |
| 1580 | (if (not custom-buffer-verbose-help) | 1569 | (if custom-reset-button-menu |
| 1581 | (progn | 1570 | (progn |
| 1582 | (widget-insert " ") | 1571 | (widget-insert " ") |
| 1583 | (widget-create 'custom-manual | 1572 | (widget-create 'push-button |
| 1584 | :tag "Help" | 1573 | :tag "Reset buffer" |
| 1585 | :help-echo "Read the online help." | 1574 | :help-echo "Show a menu with reset operations." |
| 1586 | "(emacs)Easy Customization"))) | 1575 | :mouse-down-action 'ignore |
| 1587 | (when (or custom-file user-init-file) | 1576 | :action 'custom-reset)) |
| 1588 | (widget-insert " ") | 1577 | (widget-insert "\n") |
| 1589 | (widget-create 'push-button | 1578 | (apply button (pop commands)) ; Undo edits |
| 1590 | :tag "Save for Future Sessions" | 1579 | (apply button (pop commands)) ; Reset to saved |
| 1591 | :help-echo "\ | 1580 | (apply button (pop commands)) ; Erase customization |
| 1592 | Make your editing in this buffer take effect for future Emacs sessions. | 1581 | (widget-insert " ") |
| 1593 | This updates your Emacs initialization file or creates a new one." | 1582 | (pop commands) ; Help (omitted) |
| 1594 | :action (lambda (widget &optional event) | 1583 | (apply button (pop commands))))) ; Exit |
| 1595 | (Custom-save)))) | 1584 | (widget-insert "\n\n")) |
| 1596 | (if custom-reset-button-menu | 1585 | |
| 1597 | (progn | 1586 | ;; Now populate the custom buffer. |
| 1598 | (widget-insert " ") | ||
| 1599 | (widget-create 'push-button | ||
| 1600 | :tag "Reset buffer" | ||
| 1601 | :help-echo "Show a menu with reset operations." | ||
| 1602 | :mouse-down-action (lambda (&rest junk) t) | ||
| 1603 | :action (lambda (widget &optional event) | ||
| 1604 | (custom-reset event)))) | ||
| 1605 | (widget-insert "\n ") | ||
| 1606 | (widget-create 'push-button | ||
| 1607 | :tag "Undo Edits" | ||
| 1608 | :help-echo "\ | ||
| 1609 | Reset all edited text in this buffer to reflect current values." | ||
| 1610 | :action 'Custom-reset-current) | ||
| 1611 | (widget-insert " ") | ||
| 1612 | (widget-create 'push-button | ||
| 1613 | :tag "Reset to Saved" | ||
| 1614 | :help-echo "\ | ||
| 1615 | Reset all settings in this buffer to their saved values." | ||
| 1616 | :action 'Custom-reset-saved) | ||
| 1617 | (widget-insert " ") | ||
| 1618 | (when (or custom-file user-init-file) | ||
| 1619 | (widget-create 'push-button | ||
| 1620 | :tag "Erase Customization" | ||
| 1621 | :help-echo "\ | ||
| 1622 | Un-customize all settings in this buffer and save them with standard values." | ||
| 1623 | :action 'Custom-reset-standard))) | ||
| 1624 | (widget-insert " ") | ||
| 1625 | (widget-create 'push-button | ||
| 1626 | :tag "Finish" | ||
| 1627 | :help-echo | ||
| 1628 | (lambda (&rest ignore) | ||
| 1629 | (if custom-buffer-done-kill | ||
| 1630 | "Kill this buffer" | ||
| 1631 | "Bury this buffer")) | ||
| 1632 | :action #'Custom-buffer-done) | ||
| 1633 | (widget-insert "\n\n") | ||
| 1634 | (message "Creating customization items...") | 1587 | (message "Creating customization items...") |
| 1635 | (buffer-disable-undo) | 1588 | (buffer-disable-undo) |
| 1636 | (setq custom-options | 1589 | (setq custom-options |
| @@ -2431,13 +2384,13 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." | |||
| 2431 | (defface custom-variable-tag | 2384 | (defface custom-variable-tag |
| 2432 | `((((class color) | 2385 | `((((class color) |
| 2433 | (background dark)) | 2386 | (background dark)) |
| 2434 | (:foreground "light blue" :weight bold :inherit variable-pitch)) | 2387 | (:foreground "light blue" :weight bold)) |
| 2435 | (((min-colors 88) (class color) | 2388 | (((min-colors 88) (class color) |
| 2436 | (background light)) | 2389 | (background light)) |
| 2437 | (:foreground "blue1" :weight bold :inherit variable-pitch)) | 2390 | (:foreground "blue1" :weight bold)) |
| 2438 | (((class color) | 2391 | (((class color) |
| 2439 | (background light)) | 2392 | (background light)) |
| 2440 | (:foreground "blue" :weight bold :inherit variable-pitch)) | 2393 | (:foreground "blue" :weight bold)) |
| 2441 | (t (:weight bold))) | 2394 | (t (:weight bold))) |
| 2442 | "Face used for unpushable variable tags." | 2395 | "Face used for unpushable variable tags." |
| 2443 | :group 'custom-faces) | 2396 | :group 'custom-faces) |
| @@ -2629,8 +2582,8 @@ try matching its doc string against `custom-guess-doc-alist'." | |||
| 2629 | (widget-put widget :custom-magic magic) | 2582 | (widget-put widget :custom-magic magic) |
| 2630 | (push magic buttons)) | 2583 | (push magic buttons)) |
| 2631 | (widget-put widget :buttons buttons) | 2584 | (widget-put widget :buttons buttons) |
| 2632 | (insert "\n") | ||
| 2633 | ;; Insert documentation. | 2585 | ;; Insert documentation. |
| 2586 | (widget-put widget :documentation-indent 3) | ||
| 2634 | (widget-add-documentation-string-button | 2587 | (widget-add-documentation-string-button |
| 2635 | widget :visibility-widget 'custom-visibility) | 2588 | widget :visibility-widget 'custom-visibility) |
| 2636 | 2589 | ||
| @@ -3750,13 +3703,13 @@ and so forth. The remaining group tags are shown with `custom-group-tag'." | |||
| 3750 | (defface custom-group-tag | 3703 | (defface custom-group-tag |
| 3751 | `((((class color) | 3704 | `((((class color) |
| 3752 | (background dark)) | 3705 | (background dark)) |
| 3753 | (:foreground "light blue" :weight bold :height 1.2)) | 3706 | (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch)) |
| 3754 | (((min-colors 88) (class color) | 3707 | (((min-colors 88) (class color) |
| 3755 | (background light)) | 3708 | (background light)) |
| 3756 | (:foreground "blue1" :weight bold :height 1.2)) | 3709 | (:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch)) |
| 3757 | (((class color) | 3710 | (((class color) |
| 3758 | (background light)) | 3711 | (background light)) |
| 3759 | (:foreground "blue" :weight bold :height 1.2)) | 3712 | (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch)) |
| 3760 | (t (:weight bold))) | 3713 | (t (:weight bold))) |
| 3761 | "Face used for low level group tags." | 3714 | "Face used for low level group tags." |
| 3762 | :group 'custom-faces) | 3715 | :group 'custom-faces) |
| @@ -3900,28 +3853,22 @@ If GROUPS-ONLY non-nil, return only those members that are groups." | |||
| 3900 | ;; Nested style. | 3853 | ;; Nested style. |
| 3901 | ((eq state 'hidden) | 3854 | ((eq state 'hidden) |
| 3902 | ;; Create level indicator. | 3855 | ;; Create level indicator. |
| 3903 | (unless (eq custom-buffer-style 'links) | ||
| 3904 | (insert-char ?\ (* custom-buffer-indent (1- level))) | ||
| 3905 | (insert "-- ")) | ||
| 3906 | ;; Create tag. | 3856 | ;; Create tag. |
| 3907 | (let ((begin (point))) | ||
| 3908 | (insert tag) | ||
| 3909 | (widget-specify-sample widget begin (point))) | ||
| 3910 | (insert " group: ") | ||
| 3911 | ;; Create link/visibility indicator. | ||
| 3912 | (if (eq custom-buffer-style 'links) | 3857 | (if (eq custom-buffer-style 'links) |
| 3913 | (push (widget-create-child-and-convert | 3858 | (push (widget-create-child-and-convert |
| 3914 | widget 'custom-group-link | 3859 | widget 'custom-group-link |
| 3915 | :tag "Go to Group" | 3860 | :tag tag |
| 3916 | symbol) | 3861 | symbol) |
| 3917 | buttons) | 3862 | buttons) |
| 3863 | (insert-char ?\ (* custom-buffer-indent (1- level))) | ||
| 3864 | (insert "-- ") | ||
| 3918 | (push (widget-create-child-and-convert | 3865 | (push (widget-create-child-and-convert |
| 3919 | widget 'custom-group-visibility | 3866 | widget 'custom-group-visibility |
| 3920 | :help-echo "Show members of this group." | 3867 | :help-echo "Show members of this group." |
| 3921 | :action 'custom-toggle-parent | 3868 | :action 'custom-toggle-parent |
| 3922 | (not (eq state 'hidden))) | 3869 | (not (eq state 'hidden))) |
| 3923 | buttons)) | 3870 | buttons)) |
| 3924 | (insert " \n") | 3871 | (insert " : ") |
| 3925 | ;; Create magic button. | 3872 | ;; Create magic button. |
| 3926 | (let ((magic (widget-create-child-and-convert | 3873 | (let ((magic (widget-create-child-and-convert |
| 3927 | widget 'custom-magic nil))) | 3874 | widget 'custom-magic nil))) |
| @@ -3949,9 +3896,9 @@ If GROUPS-ONLY non-nil, return only those members that are groups." | |||
| 3949 | (insert "/- ") | 3896 | (insert "/- ") |
| 3950 | ;; Create tag. | 3897 | ;; Create tag. |
| 3951 | (let ((start (point))) | 3898 | (let ((start (point))) |
| 3952 | (insert tag) | 3899 | (insert tag " group: ") |
| 3953 | (widget-specify-sample widget start (point))) | 3900 | (widget-specify-sample widget start (point))) |
| 3954 | (insert " group: ") | 3901 | (insert (widget-docstring widget)) |
| 3955 | ;; Create visibility indicator. | 3902 | ;; Create visibility indicator. |
| 3956 | (unless (eq custom-buffer-style 'links) | 3903 | (unless (eq custom-buffer-style 'links) |
| 3957 | (insert "--------") | 3904 | (insert "--------") |
| @@ -4072,44 +4019,34 @@ Optional EVENT is the location for the menu." | |||
| 4072 | 4019 | ||
| 4073 | (defun custom-group-set (widget) | 4020 | (defun custom-group-set (widget) |
| 4074 | "Set changes in all modified group members." | 4021 | "Set changes in all modified group members." |
| 4075 | (let ((children (widget-get widget :children))) | 4022 | (dolist (child (widget-get widget :children)) |
| 4076 | (mapc (lambda (child) | 4023 | (when (eq (widget-get child :custom-state) 'modified) |
| 4077 | (when (eq (widget-get child :custom-state) 'modified) | 4024 | (widget-apply child :custom-set)))) |
| 4078 | (widget-apply child :custom-set))) | ||
| 4079 | children ))) | ||
| 4080 | 4025 | ||
| 4081 | (defun custom-group-save (widget) | 4026 | (defun custom-group-save (widget) |
| 4082 | "Save all modified group members." | 4027 | "Save all modified group members." |
| 4083 | (let ((children (widget-get widget :children))) | 4028 | (dolist (child (children (widget-get widget :children))) |
| 4084 | (mapc (lambda (child) | 4029 | (when (memq (widget-get child :custom-state) '(modified set)) |
| 4085 | (when (memq (widget-get child :custom-state) '(modified set)) | 4030 | (widget-apply child :custom-save)))) |
| 4086 | (widget-apply child :custom-save))) | ||
| 4087 | children ))) | ||
| 4088 | 4031 | ||
| 4089 | (defun custom-group-reset-current (widget) | 4032 | (defun custom-group-reset-current (widget) |
| 4090 | "Reset all modified group members." | 4033 | "Reset all modified group members." |
| 4091 | (let ((children (widget-get widget :children))) | 4034 | (dolist (child (widget-get widget :children)) |
| 4092 | (mapc (lambda (child) | 4035 | (when (eq (widget-get child :custom-state) 'modified) |
| 4093 | (when (eq (widget-get child :custom-state) 'modified) | 4036 | (widget-apply child :custom-reset-current)))) |
| 4094 | (widget-apply child :custom-reset-current))) | ||
| 4095 | children ))) | ||
| 4096 | 4037 | ||
| 4097 | (defun custom-group-reset-saved (widget) | 4038 | (defun custom-group-reset-saved (widget) |
| 4098 | "Reset all modified or set group members." | 4039 | "Reset all modified or set group members." |
| 4099 | (let ((children (widget-get widget :children))) | 4040 | (dolist (child (widget-get widget :children)) |
| 4100 | (mapc (lambda (child) | 4041 | (when (memq (widget-get child :custom-state) '(modified set)) |
| 4101 | (when (memq (widget-get child :custom-state) '(modified set)) | 4042 | (widget-apply child :custom-reset-saved)))) |
| 4102 | (widget-apply child :custom-reset-saved))) | ||
| 4103 | children ))) | ||
| 4104 | 4043 | ||
| 4105 | (defun custom-group-reset-standard (widget) | 4044 | (defun custom-group-reset-standard (widget) |
| 4106 | "Reset all modified, set, or saved group members." | 4045 | "Reset all modified, set, or saved group members." |
| 4107 | (let ((children (widget-get widget :children))) | 4046 | (dolist (child (widget-get widget :children)) |
| 4108 | (mapc (lambda (child) | 4047 | (when (memq (widget-get child :custom-state) |
| 4109 | (when (memq (widget-get child :custom-state) | 4048 | '(modified set saved)) |
| 4110 | '(modified set saved)) | 4049 | (widget-apply child :custom-reset-standard)))) |
| 4111 | (widget-apply child :custom-reset-standard))) | ||
| 4112 | children ))) | ||
| 4113 | 4050 | ||
| 4114 | (defun custom-group-state-update (widget) | 4051 | (defun custom-group-state-update (widget) |
| 4115 | "Update magic." | 4052 | "Update magic." |
| @@ -4498,6 +4435,32 @@ The format is suitable for use with `easy-menu-define'." | |||
| 4498 | (let ((menu (custom-menu-create ',symbol))) | 4435 | (let ((menu (custom-menu-create ',symbol))) |
| 4499 | (if (consp menu) (cdr menu) menu))))) | 4436 | (if (consp menu) (cdr menu) menu))))) |
| 4500 | 4437 | ||
| 4438 | ;;; Toolbar and menubar support | ||
| 4439 | |||
| 4440 | (easy-menu-define | ||
| 4441 | Custom-mode-menu custom-mode-map | ||
| 4442 | "Menu used in customization buffers." | ||
| 4443 | (nconc (list "Custom" | ||
| 4444 | (customize-menu-create 'customize)) | ||
| 4445 | (mapcar (lambda (arg) | ||
| 4446 | (let ((tag (nth 0 arg)) | ||
| 4447 | (command (nth 1 arg)) | ||
| 4448 | (active (nth 2 arg)) | ||
| 4449 | (help (nth 3 arg))) | ||
| 4450 | (vector tag command :active (eval active) :help help))) | ||
| 4451 | custom-commands))) | ||
| 4452 | |||
| 4453 | (defvar tool-bar-map) | ||
| 4454 | (defvar custom-tool-bar-map | ||
| 4455 | (if (display-graphic-p) | ||
| 4456 | (let ((map (make-sparse-keymap))) | ||
| 4457 | (mapc | ||
| 4458 | (lambda (arg) | ||
| 4459 | (tool-bar-local-item-from-menu | ||
| 4460 | (nth 1 arg) (nth 4 arg) map custom-mode-map)) | ||
| 4461 | custom-commands) | ||
| 4462 | map))) | ||
| 4463 | |||
| 4501 | ;;; The Custom Mode. | 4464 | ;;; The Custom Mode. |
| 4502 | 4465 | ||
| 4503 | (defun Custom-no-edit (pos &optional event) | 4466 | (defun Custom-no-edit (pos &optional event) |
| @@ -4513,18 +4476,6 @@ The format is suitable for use with `easy-menu-define'." | |||
| 4513 | (widget-apply-action button event) | 4476 | (widget-apply-action button event) |
| 4514 | (error "You can't edit this part of the Custom buffer")))) | 4477 | (error "You can't edit this part of the Custom buffer")))) |
| 4515 | 4478 | ||
| 4516 | (easy-menu-define Custom-mode-menu | ||
| 4517 | custom-mode-map | ||
| 4518 | "Menu used in customization buffers." | ||
| 4519 | `("Custom" | ||
| 4520 | ,(customize-menu-create 'customize) | ||
| 4521 | ["Set" Custom-set t] | ||
| 4522 | ["Save" Custom-save t] | ||
| 4523 | ["Undo Edits" Custom-reset-current t] | ||
| 4524 | ["Reset to Saved" Custom-reset-saved t] | ||
| 4525 | ["Erase Customization" Custom-reset-standard t] | ||
| 4526 | ["Info" (info "(emacs)Easy Customization") t])) | ||
| 4527 | |||
| 4528 | (defvar custom-field-keymap | 4479 | (defvar custom-field-keymap |
| 4529 | (let ((map (copy-keymap widget-field-keymap))) | 4480 | (let ((map (copy-keymap widget-field-keymap))) |
| 4530 | (define-key map "\C-c\C-c" 'Custom-set) | 4481 | (define-key map "\C-c\C-c" 'Custom-set) |
| @@ -4581,6 +4532,7 @@ if that value is non-nil." | |||
| 4581 | mode-name "Custom") | 4532 | mode-name "Custom") |
| 4582 | (use-local-map custom-mode-map) | 4533 | (use-local-map custom-mode-map) |
| 4583 | (easy-menu-add Custom-mode-menu) | 4534 | (easy-menu-add Custom-mode-menu) |
| 4535 | (set (make-local-variable 'tool-bar-map) custom-tool-bar-map) | ||
| 4584 | (make-local-variable 'custom-options) | 4536 | (make-local-variable 'custom-options) |
| 4585 | (make-local-variable 'custom-local-buffer) | 4537 | (make-local-variable 'custom-local-buffer) |
| 4586 | (make-local-variable 'widget-documentation-face) | 4538 | (make-local-variable 'widget-documentation-face) |