diff options
| -rw-r--r-- | lisp/cus-edit.el | 64 | ||||
| -rw-r--r-- | test/lisp/custom-tests.el | 28 |
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. | ||
| 2827 | WIDGET should be a custom-variable widget, whose first child is the widget | ||
| 2828 | that holds the value. | ||
| 2829 | Modified means that the widget that holds the value has been edited by the user | ||
| 2830 | in a customize buffer. | ||
| 2831 | To 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. |
| 2815 | If STATE is nil, the value is computed by `custom-variable-state'." | 2844 | If STATE is nil, the new state is computed by `custom-variable-modified-p' if |
| 2845 | WIDGET has been edited in the Custom buffer, or by `custom-variable-state' | ||
| 2846 | otherwise." | ||
| 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 | 3762 | If the user edited the widget, set the state to modified. If not, the new |
| 3728 | (custom-face-state (widget-value widget)))) | 3763 | state 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 |