From 69ec406a67b11d2398ce795b31db7a0ae4cb479c Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Fri, 6 Sep 2019 09:55:39 -0300 Subject: [PATCH] Don't discard customizations in progress when adding comments (Bug#5358) * lisp/cus-edit.el (custom-comment-show): Add docstring. Save the widget value in the :shown-value property, before redrawing. (custom-variable-modified-p): New function, to complement the return values of custom-variable-state. (custom-variable-state-set): Use it. (custom-face-value-create): Add children to the custom-face widget before setting the state, to be able to check for user edits. (custom-face-state-set): Check for user edits before calling custom-face-state. * test/lisp/custom-tests.el (custom-test-show-comment-preserves-changes): New test. --- lisp/cus-edit.el | 63 ++++++++++++++++++++++++++++++++++++++--------- test/lisp/custom-tests.el | 28 +++++++++++++++++++++ 2 files changed, 79 insertions(+), 12 deletions(-) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 2496963..f3445c6 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2416,9 +2416,21 @@ custom-comment-hide ;; Those functions are for the menu. WIDGET is NOT the comment widget. It's ;; the global custom one (defun custom-comment-show (widget) - (widget-put widget :comment-shown t) - (custom-redraw widget) - (widget-setup)) + "Show the comment editable field that belongs to WIDGET." + (let ((child (car (widget-get widget :children))) + ;; Just to be safe, we will restore this value after redrawing. + (old-shown-value (widget-get widget :shown-value))) + (widget-put widget :comment-shown t) + ;; Save the changes made by the user before redrawing, to avoid + ;; losing customizations in progress. (Bug#5358) + (if (eq (widget-type widget) 'custom-face) + (if (eq (widget-type child) 'custom-face-edit) + (widget-put widget :shown-value `((t ,(widget-value child)))) + (widget-put widget :shown-value (widget-value child))) + (widget-put widget :shown-value (list (widget-value child)))) + (custom-redraw widget) + (widget-put widget :shown-value old-shown-value) + (widget-setup))) (defun custom-comment-invisible-p (widget) (let ((val (widget-value (widget-get widget :comment-widget)))) @@ -2810,12 +2822,34 @@ custom-variable-state 'changed)) (t 'rogue)))) +(defun custom-variable-modified-p (widget) + "Non-nil if the variable value of WIDGET has been modified. +WIDGET should be a custom-variable widget, whose first child is the widget +that holds the value. +Modified means that the widget that holds the value has been edited by the user +in a customize buffer. +To check for other states, call `custom-variable-state'." + (condition-case nil + (let* ((symbol (widget-get widget :value)) + (get (or (get symbol 'custom-get) 'default-value)) + (value (if (default-boundp symbol) + (funcall get symbol) + (symbol-value symbol)))) + (not (equal value (widget-value (car (widget-get widget :children)))))) + (error t))) + (defun custom-variable-state-set (widget &optional state) "Set the state of WIDGET to STATE. -If STATE is nil, the value is computed by `custom-variable-state'." +If STATE is nil, the new state is computed by `custom-variable-modified-p' if +WIDGET has been edited in the Custom buffer, or by `custom-variable-state' +otherwise." (widget-put widget :custom-state - (or state (custom-variable-state (widget-value widget) - (widget-get widget :value))))) + (or state + (and (custom-variable-modified-p widget) 'modified) + (custom-variable-state (widget-value widget) + (widget-value + (car + (widget-get widget :children))))))) (defun custom-variable-standard-value (widget) (get (widget-value widget) 'standard-value)) @@ -3635,9 +3669,9 @@ custom-face-value-create (insert-char ?\s indent)) (widget-create-child-and-convert widget 'sexp :value spec)))) - (custom-face-state-set widget) - (push editor children) - (widget-put widget :children children)))))) + (push editor children) + (widget-put widget :children children) + (custom-face-state-set widget)))))) (defvar custom-face-menu `(("Set for Current Session" custom-face-set) @@ -3723,9 +3757,14 @@ custom-face-state state))) (defun custom-face-state-set (widget) - "Set the state of WIDGET." - (widget-put widget :custom-state - (custom-face-state (widget-value widget)))) + "Set the state of WIDGET, a custom-face widget. +If the user edited the widget, set the state to modified. If not, the new +state is one of the return values of `custom-face-state'." + (let ((face (widget-value widget))) + (widget-put widget :custom-state + (if (face-spec-match-p face (custom-face-widget-to-spec widget)) + (custom-face-state face) + 'modified)))) (defun custom-face-action (widget &optional event) "Show the menu for `custom-face' WIDGET. diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el index 0c49db6..270acda 100644 --- a/test/lisp/custom-tests.el +++ b/test/lisp/custom-tests.el @@ -21,6 +21,10 @@ (require 'ert) +(require 'wid-edit) +(require 'cus-edit) +(require 'seq) ; For `seq-find'. + (ert-deftest custom-theme--load-path () "Test `custom-theme--load-path' behavior." (let ((tmpdir (file-name-as-directory (make-temp-file "custom-tests-" t)))) @@ -123,4 +127,28 @@ custom--test-variable (should (equal custom--test-user-option 'baz)) (should (equal custom--test-variable 'baz)))) +;; This tests Bug#5358. +(ert-deftest custom-test-show-comment-preserves-changes () + "Test that adding a comment doesn't discard modifications in progress." + (customize-option 'custom--test-user-option) + (let* ((field (seq-find (lambda (widget) + (eq custom--test-user-option (widget-value widget))) + widget-field-list)) + (parent (widget-get field :parent)) + (origvalue (widget-value field))) + ;; Move to the end of the text of the widget, and modify it. This + ;; modification should be preserved after showing the comment field. + (goto-char (widget-field-text-end field)) + (insert "bar") + (custom-comment-show parent) + ;; From now on, must use `widget-at' to get the value of the widget. + (should-not (eq origvalue (widget-value (widget-at)))) + (should (eq (widget-get parent :custom-state) 'modified)) + (should (eq (widget-value (widget-at)) + (widget-apply field + :value-to-external + (concat + (widget-apply field :value-to-internal origvalue) + "bar")))))) + ;;; custom-tests.el ends here -- 2.7.4