aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorChong Yidong2007-07-05 18:37:29 +0000
committerChong Yidong2007-07-05 18:37:29 +0000
commit9db1942d9a0b5e3fe69d585c1ce52d97e9376fce (patch)
tree77abde03519cda119d6cfc25ce6597fd184dd14c
parent2321b0422615d95a027bd5044b4586dfbd8f8904 (diff)
downloademacs-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.el564
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
777If a setting was edited and set before, this saves it. 777 (or custom-file user-init-file)
778If 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.
799The key is a string containing the name of the action, the value is a 795The key is a string containing the name of the action, the value is a
800Lisp function taking the widget as an element which will be called 796Lisp function taking the widget as an element which will be called
801when the action is chosen.") 797when 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'.
804If there is more than one widget, ask user for confirmation using
805the query string QUERY, using `y-or-n-p' if STRONG-QUERY is nil,
806and `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.
826If a setting was edited and set before, this saves it.
827If 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.
829This also shows the saved values in the buffer." 857This 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.
846This operation eliminates any saved values for the group members, 868This operation eliminates any saved values for the group members,
847making them as if they had never been customized at all." 869making 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.
1257If FACE is nil, customize all faces. If FACE is actually a 1259If FACE is nil, customize all faces. If FACE is actually a
1258face-alias, customize the face it is aliased to. 1260face-alias, customize the face it is aliased to.
1259 1261
1260Interactively, when point is on text which has a face specified, 1262Interactively, when point is on text which has a face specified,
1261suggest to customize that face, if it's customizable." 1263suggest 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
1289Interactively, when point is on text which has a face specified, 1298Interactively, when point is on text which has a face specified,
1290suggest to customize that face, if it's customizable." 1299suggest 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. 1539To set apply your changes, use the Save or Set buttons.
1551Editing a setting changes only the text in the buffer." 1540Saving a change normally works by editing your init file."
1552 (if custom-raised-buttons 1541 "
1553 "`Raised' text indicates" 1542Currently, these settings cannot be saved for future Emacs sessions,
1554 "Square brackets indicate"))) 1543possibly because you started Emacs with `-q'.")
1555 (if init-file-user 1544 "\nFor details, see ")
1556 (widget-insert " 1545 (widget-create 'custom-manual
1557Use the Save or Set buttons to set apply your changes. 1546 :tag "Saving Customizations"
1558Saving 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
1561the 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"))
1572are 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))))
1577Make 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
1592Make your editing in this buffer take effect for future Emacs sessions. 1581 (widget-insert " ")
1593This 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 "\
1609Reset 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 "\
1615Reset 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 "\
1622Un-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)