aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/cus-edit.el64
-rw-r--r--test/lisp/custom-tests.el28
2 files changed, 80 insertions, 12 deletions
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 24969633373..b9fd3e0a2d4 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -2416,9 +2416,21 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
2416;; Those functions are for the menu. WIDGET is NOT the comment widget. It's 2416;; Those functions are for the menu. WIDGET is NOT the comment widget. It's
2417;; the global custom one 2417;; the global custom one
2418(defun custom-comment-show (widget) 2418(defun custom-comment-show (widget)
2419 (widget-put widget :comment-shown t) 2419 "Show the comment editable field that belongs to WIDGET."
2420 (custom-redraw widget) 2420 (let ((child (car (widget-get widget :children)))
2421 (widget-setup)) 2421 ;; Just to be safe, we will restore this value after redrawing.
2422 (old-shown-value (widget-get widget :shown-value)))
2423 (widget-put widget :comment-shown t)
2424 ;; Save the changes made by the user before redrawing, to avoid
2425 ;; losing customizations in progress. (Bug#5358)
2426 (if (eq (widget-type widget) 'custom-face)
2427 (if (eq (widget-type child) 'custom-face-edit)
2428 (widget-put widget :shown-value `((t ,(widget-value child))))
2429 (widget-put widget :shown-value (widget-value child)))
2430 (widget-put widget :shown-value (list (widget-value child))))
2431 (custom-redraw widget)
2432 (widget-put widget :shown-value old-shown-value)
2433 (widget-setup)))
2422 2434
2423(defun custom-comment-invisible-p (widget) 2435(defun custom-comment-invisible-p (widget)
2424 (let ((val (widget-value (widget-get widget :comment-widget)))) 2436 (let ((val (widget-value (widget-get widget :comment-widget))))
@@ -2810,12 +2822,35 @@ Possible return values are `standard', `saved', `set', `themed',
2810 'changed)) 2822 'changed))
2811 (t 'rogue)))) 2823 (t 'rogue))))
2812 2824
2825(defun custom-variable-modified-p (widget)
2826 "Non-nil if the variable value of WIDGET has been modified.
2827WIDGET should be a custom-variable widget, whose first child is the widget
2828that holds the value.
2829Modified means that the widget that holds the value has been edited by the user
2830in a customize buffer.
2831To check for other states, call `custom-variable-state'."
2832 (catch 'get-error
2833 (let* ((symbol (widget-get widget :value))
2834 (get (or (get symbol 'custom-get) 'default-value))
2835 (value (if (default-boundp symbol)
2836 (condition-case nil
2837 (funcall get symbol)
2838 (error (throw 'get-error t)))
2839 (symbol-value symbol))))
2840 (not (equal value (widget-value (car (widget-get widget :children))))))))
2841
2813(defun custom-variable-state-set (widget &optional state) 2842(defun custom-variable-state-set (widget &optional state)
2814 "Set the state of WIDGET to STATE. 2843 "Set the state of WIDGET to STATE.
2815If STATE is nil, the value is computed by `custom-variable-state'." 2844If STATE is nil, the new state is computed by `custom-variable-modified-p' if
2845WIDGET has been edited in the Custom buffer, or by `custom-variable-state'
2846otherwise."
2816 (widget-put widget :custom-state 2847 (widget-put widget :custom-state
2817 (or state (custom-variable-state (widget-value widget) 2848 (or state
2818 (widget-get widget :value))))) 2849 (and (custom-variable-modified-p widget) 'modified)
2850 (custom-variable-state (widget-value widget)
2851 (widget-value
2852 (car
2853 (widget-get widget :children)))))))
2819 2854
2820(defun custom-variable-standard-value (widget) 2855(defun custom-variable-standard-value (widget)
2821 (get (widget-value widget) 'standard-value)) 2856 (get (widget-value widget) 'standard-value))
@@ -3635,9 +3670,9 @@ the present value is saved to its :shown-value property instead."
3635 (insert-char ?\s indent)) 3670 (insert-char ?\s indent))
3636 (widget-create-child-and-convert 3671 (widget-create-child-and-convert
3637 widget 'sexp :value spec)))) 3672 widget 'sexp :value spec))))
3638 (custom-face-state-set widget) 3673 (push editor children)
3639 (push editor children) 3674 (widget-put widget :children children)
3640 (widget-put widget :children children)))))) 3675 (custom-face-state-set widget))))))
3641 3676
3642(defvar custom-face-menu 3677(defvar custom-face-menu
3643 `(("Set for Current Session" custom-face-set) 3678 `(("Set for Current Session" custom-face-set)
@@ -3723,9 +3758,14 @@ This is one of `set', `saved', `changed', `themed', or `rogue'."
3723 state))) 3758 state)))
3724 3759
3725(defun custom-face-state-set (widget) 3760(defun custom-face-state-set (widget)
3726 "Set the state of WIDGET." 3761 "Set the state of WIDGET, a custom-face widget.
3727 (widget-put widget :custom-state 3762If the user edited the widget, set the state to modified. If not, the new
3728 (custom-face-state (widget-value widget)))) 3763state is one of the return values of `custom-face-state'."
3764 (let ((face (widget-value widget)))
3765 (widget-put widget :custom-state
3766 (if (face-spec-match-p face (custom-face-widget-to-spec widget))
3767 (custom-face-state face)
3768 'modified))))
3729 3769
3730(defun custom-face-action (widget &optional event) 3770(defun custom-face-action (widget &optional event)
3731 "Show the menu for `custom-face' WIDGET. 3771 "Show the menu for `custom-face' WIDGET.
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index 0c49db6c76d..270acda292c 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -21,6 +21,10 @@
21 21
22(require 'ert) 22(require 'ert)
23 23
24(require 'wid-edit)
25(require 'cus-edit)
26(require 'seq) ; For `seq-find'.
27
24(ert-deftest custom-theme--load-path () 28(ert-deftest custom-theme--load-path ()
25 "Test `custom-theme--load-path' behavior." 29 "Test `custom-theme--load-path' behavior."
26 (let ((tmpdir (file-name-as-directory (make-temp-file "custom-tests-" t)))) 30 (let ((tmpdir (file-name-as-directory (make-temp-file "custom-tests-" t))))
@@ -123,4 +127,28 @@
123 (should (equal custom--test-user-option 'baz)) 127 (should (equal custom--test-user-option 'baz))
124 (should (equal custom--test-variable 'baz)))) 128 (should (equal custom--test-variable 'baz))))
125 129
130;; This tests Bug#5358.
131(ert-deftest custom-test-show-comment-preserves-changes ()
132 "Test that adding a comment doesn't discard modifications in progress."
133 (customize-option 'custom--test-user-option)
134 (let* ((field (seq-find (lambda (widget)
135 (eq custom--test-user-option (widget-value widget)))
136 widget-field-list))
137 (parent (widget-get field :parent))
138 (origvalue (widget-value field)))
139 ;; Move to the end of the text of the widget, and modify it. This
140 ;; modification should be preserved after showing the comment field.
141 (goto-char (widget-field-text-end field))
142 (insert "bar")
143 (custom-comment-show parent)
144 ;; From now on, must use `widget-at' to get the value of the widget.
145 (should-not (eq origvalue (widget-value (widget-at))))
146 (should (eq (widget-get parent :custom-state) 'modified))
147 (should (eq (widget-value (widget-at))
148 (widget-apply field
149 :value-to-external
150 (concat
151 (widget-apply field :value-to-internal origvalue)
152 "bar"))))))
153
126;;; custom-tests.el ends here 154;;; custom-tests.el ends here