From: Mauro Aranda <maurooaranda@gmail.com>
To: Lars Ingebrigtsen <larsi@gnus.org>
Cc: Dave Abrahams <dave@boostpro.com>,
ahyatt@gmail.com, 5358@debbugs.gnu.org
Subject: bug#5358: 23.1; Adding comment loses customizations in progress
Date: Fri, 27 Sep 2019 12:04:37 -0300 [thread overview]
Message-ID: <CABczVwcK5LXO-ZOqYus4R+vXG_Rx_51aJpo9m=rcLYziCkjb0g@mail.gmail.com> (raw)
In-Reply-To: <87r241omor.fsf@gnus.org>
[-- Attachment #1.1: Type: text/plain, Size: 1089 bytes --]
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Mauro Aranda <maurooaranda@gmail.com> writes:
>
>> Subject: [PATCH] Don't discard customizations in progress when adding
comments
>> (Bug#5358)
>
> Looks good to me. Just one tiny comment:
>
>> + (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)))
>
> If it's just the funcall you expect that might fail, then moving the
> condition-case down there might be a better choice. Having a
> condition-case around code that shouldn't fail can hide errors you don't
> want to hide.
Right, thanks for noticing that.
I've moved down the condition-case, and I've added an outer catch, to
avoid the comparison in case of an error. I think that's OK, but if you
see something wrong, please let me know.
[-- Attachment #1.2: Type: text/html, Size: 1459 bytes --]
[-- Attachment #2: 0001-Don-t-discard-customizations-in-progress-when-adding.patch --]
[-- Type: text/x-patch, Size: 7197 bytes --]
From 39334b56d71ae309e9deba1568c2b21347c519e0 Mon Sep 17 00:00:00 2001
From: Mauro Aranda <maurooaranda@gmail.com>
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 | 64 ++++++++++++++++++++++++++++++++++++++---------
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 2496963..b9fd3e0 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,35 @@ 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'."
+ (catch 'get-error
+ (let* ((symbol (widget-get widget :value))
+ (get (or (get symbol 'custom-get) 'default-value))
+ (value (if (default-boundp symbol)
+ (condition-case nil
+ (funcall get symbol)
+ (error (throw 'get-error t)))
+ (symbol-value symbol))))
+ (not (equal value (widget-value (car (widget-get widget :children))))))))
+
(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 +3670,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 +3758,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
next prev parent reply other threads:[~2019-09-27 15:04 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2010-01-11 19:41 bug#5358: 23.1; Adding comment loses customizations in progress David Abrahams
2016-02-17 3:48 ` Andrew Hyatt
2016-02-18 15:29 ` Dave Abrahams
2016-02-18 16:47 ` Glenn Morris
2016-02-19 16:18 ` Andrew Hyatt
2019-09-06 14:47 ` Mauro Aranda
2019-09-27 12:31 ` Mauro Aranda
2019-09-27 14:09 ` Lars Ingebrigtsen
2019-09-27 15:04 ` Mauro Aranda [this message]
2019-09-27 16:07 ` Lars Ingebrigtsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CABczVwcK5LXO-ZOqYus4R+vXG_Rx_51aJpo9m=rcLYziCkjb0g@mail.gmail.com' \
--to=maurooaranda@gmail.com \
--cc=5358@debbugs.gnu.org \
--cc=ahyatt@gmail.com \
--cc=dave@boostpro.com \
--cc=larsi@gnus.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).