From: Mauro Aranda <maurooaranda@gmail.com>
To: Leo Vivier <zaeph@zaeph.net>
Cc: 44579@debbugs.gnu.org
Subject: bug#44579: Unintended behaviour with defcustom’s ‘choice’ widgets and ":inline t" & Wrong documentation on "(elisp) Splicing into Lists"
Date: Mon, 16 Nov 2020 20:48:54 -0300 [thread overview]
Message-ID: <CABczVwcOgcq8pQ88uWxRkbKJ9tPCG9rP1jnBiCPAEq2cXxuTng@mail.gmail.com> (raw)
In-Reply-To: <87lff7yksx.fsf@hidden>
[-- Attachment #1.1: Type: text/plain, Size: 3460 bytes --]
tags 44579 patch
quit
Leo Vivier <zaeph@zaeph.net> writes:
> Hi there,
>
> There seems to be a problem in `defcustom' forms with the way the
> `choice' widget handles `:inline t'.
>
> I’ve written an .el file to walk you through it: I’ve documented the
> bug, the explanation, and a tentative solution.
>
[...]
> ;; > When the element-type is a ‘choice’, you use ‘:inline’ not in the
> ;; > ‘choice’ itself, but in (some of) the alternatives of the ‘choice’.
For
> ;; > example, to match a list which must start with a file name, followed
> ;; > either by the symbol ‘t’ or two strings, use this customization type:
> ;; >
> ;; > (list file
> ;; > (choice (const t)
> ;; > (list :inline t string string)))
> ;; >
> ;; > If the user chooses the first alternative in the choice, then the
> ;; > overall list has two elements and the second element is ‘t’. If the
> ;; > user chooses the second alternative, then the overall list has three
> ;; > elements and the second and third must be strings.
>
> ;; The first option in ‘choice’ works.
> (defcustom zp/testing '("foo" t)
> "Testing variable."
> :type
> '(list file
> (choice (const t)
> (list :inline t
> string
> string))))
>
> (customize-variable 'zp/testing)
> ;; => The form is recognised.
>
> ;; The second option in ‘choice’ doesn’t work.
> (defcustom zp/testing '("foo" "bar" "baz")
> "Testing variable."
> :type
> '(list file
> (choice (const t)
> (list :inline t
> string
> string))))
>
> (customize-variable 'zp/testing)
> ;; => The form is *not* recognised.
Confirmed.
> ;;; SUGGESTED FIX
>
> ;; ‘choice’ needs to be made aware of the ":inline t" in its options.
> ;;
> ;; Since ‘choice’ is intended to receed into the background once the
> ;; appropriate option has been pattern-matched, it doesn’t make sense to
have
> ;; it carry the ":inline t". Instead, it should respect the ":inline t"
that
> ;; is present in its option when said option is matched.
Yes, something like that. This bug happens because the choice widget is
unable to tell to widget-match-inline that it wants to try to match more
than one member of a list, when one of its choices is inline. So
widget-match-inline only passes it one element, in this case a string,
and one string won't match a list of two strings.
So the choice widget needs to be able to tell widget-match-inline about
that. To avoid a large impact of tweaking the code to fix this, I made
a change to affect only choice widgets with inline choices, which are
the ones that suffer exhibit this bug.
The patch to wid-edit.el is a little larger, because once the choice
widget can match inline values, then it has to be able to create them.
I added tests for both matching choice widgets and creating the choice
widgets as a part of other grouping widgets. In current master, the
following tests should fail, exposing the bug:
widget-test-choice-match-all-inline
widget-test-choice-match-some-inline
And without the changes to the create functions, the following tests
would fail:
widget-test-repeat-can-handle-inlinable-choice
widget-test-list-can-handle-inlinable-choice
widget-test-option-can-handle-inlinable-choice
[-- Attachment #1.2: Type: text/html, Size: 4191 bytes --]
[-- Attachment #2: 0001-Fix-matching-of-inline-choices-for-the-choice-widget.patch --]
[-- Type: text/x-patch, Size: 14906 bytes --]
From afce8db9e42ab20bf0e27fb087b9c17a41aeb70a Mon Sep 17 00:00:00 2001
From: Mauro Aranda <maurooaranda@gmail.com>
Date: Mon, 16 Nov 2020 20:05:04 -0300
Subject: [PATCH] Fix matching of inline choices for the choice widget
A choice widget should be able to match either no inline values or
inline values, upon request. (Bug#44579)
* lisp/wid-edit.el (choice): New property, :inline-bubbles-p. A
predicate that returns non-nil if the choice widget can act as an
inline widget. Document it.
(widget-choice-inline-bubbles-p): New function, for the
:inline-bubbles-p property of the choice widget.
(widget-inline-p): New function. Use the :inline-bubbles-p property
of the widget, if any.
(widget-match-inline): Use the above to see if the widget can act like
an inline widget. Document it.
(widget-choice-value-create): Account for the case of a choice widget
that has inline members.
(widget-checklist-add-item, widget-editable-list-value-create)
(widget-group-value-create): Use widget-inline-p rather than just
checking for a non-nil :inline property, allowing these functions to
pass the complete information to widgets like the choice widget to
create their values.
* test/lisp/wid-edit-tests.el (widget-test-choice-match-no-inline)
(widget-test-choice-match-all-inline)
widget-test-choice-match-some-inline): New tests, to check that choice
widgets can match its choices, inline or not.
(widget-test-inline-p): New test, for the new function
widget-inline-p.
(widget-test-repeat-can-handle-choice)
(widget-test-repeat-can-handle-inlinable-choice)
(widget-test-list-can-handle-choice)
(widget-test-list-can-handle-inlinable-choice)
(widget-test-option-can-handle-choice)
(widget-test-option-can-handle-inlinable-choice): New tests. This
grouping widgets need to be able to create a choice widget regardless
if it has inline choices or not.
---
lisp/wid-edit.el | 72 +++++++++++++----
test/lisp/wid-edit-tests.el | 153 ++++++++++++++++++++++++++++++++++++
2 files changed, 211 insertions(+), 14 deletions(-)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 4e2cf7416d..8250316bcc 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -591,9 +591,25 @@ widget-default-get
(widget-put widget :args args)))
(widget-apply widget :default-get)))))
+(defun widget-inline-p (widget &optional bubblep)
+ "Non-nil if the widget WIDGET is inline.
+
+With BUBBLEP non-nil, check also if WIDGET has a member that bubbles its inline
+property (if any), up to WIDGET, so that WIDGET can act as an inline widget."
+ (or (widget-get widget :inline)
+ (and bubblep
+ (widget-get widget :inline-bubbles-p)
+ (widget-apply widget :inline-bubbles-p))))
+
(defun widget-match-inline (widget vals)
- "In WIDGET, match the start of VALS."
- (cond ((widget-get widget :inline)
+ "In WIDGET, match the start of VALS.
+
+For an inline widget or for a widget that acts like one (see `widget-inline-p'),
+try to match elements in VALS as far as possible. Otherwise, match the first
+element of the list VALS.
+
+Return a list whose car contains all members of VALS that matched WIDGET."
+ (cond ((widget-inline-p widget t)
(widget-apply widget :match-inline vals))
((and (listp vals)
(widget-apply widget :match (car vals)))
@@ -2198,7 +2214,7 @@ widget-choice-value-create
(let ((value (widget-get widget :value))
(args (widget-get widget :args))
(explicit (widget-get widget :explicit-choice))
- current)
+ current val inline-p fun)
(if explicit
(progn
;; If the user specified the choice for this value,
@@ -2207,15 +2223,24 @@ widget-choice-value-create
widget explicit value)))
(widget-put widget :choice explicit)
(widget-put widget :explicit-choice nil))
+ (setq inline-p (widget-inline-p widget t))
(while args
(setq current (car args)
args (cdr args))
- (when (widget-apply current :match value)
- (widget-put widget :children (list (widget-create-child-value
- widget current value)))
- (widget-put widget :choice current)
- (setq args nil
- current nil)))
+ (if inline-p
+ (if (widget-get current :inline)
+ (setq val value
+ fun :match-inline)
+ (setq val (car value)
+ fun :match))
+ (setq val value
+ fun :match))
+ (when (widget-apply current fun val)
+ (widget-put widget :children (list (widget-create-child-value
+ widget current val)))
+ (widget-put widget :choice current)
+ (setq args nil
+ current nil)))
(when current
(let ((void (widget-get widget :void)))
(widget-put widget :children (list (widget-create-child-and-convert
@@ -2438,7 +2463,7 @@ widget-checklist-add-item
(let ((child (widget-create-child widget type)))
(widget-apply child :deactivate)
child))
- ((widget-get type :inline)
+ ((widget-inline-p type t)
(widget-create-child-value
widget type (cdr chosen)))
(t
@@ -2795,7 +2820,7 @@ widget-editable-list-value-create
(if answer
(setq children (cons (widget-editable-list-entry-create
widget
- (if (widget-get type :inline)
+ (if (widget-inline-p type t)
(car answer)
(car (car answer)))
t)
@@ -2979,7 +3004,7 @@ widget-group-value-create
(insert-char ?\s (widget-get widget :indent)))
(push (cond ((null answer)
(widget-create-child widget arg))
- ((widget-get arg :inline)
+ ((widget-inline-p arg t)
(widget-create-child-value widget arg (car answer)))
(t
(widget-create-child-value widget arg (car (car answer)))))
@@ -3900,12 +3925,17 @@ widget-alist-convert-option
`(cons :format "Key: %v" ,key-type ,value-type)))
\f
(define-widget 'choice 'menu-choice
- "A union of several sexp types."
+ "A union of several sexp types.
+
+If one of the choices of a choice widget has an :inline t property,
+then the choice widget can act as an inline widget on its own if the
+current choice is inline."
:tag "Choice"
:format "%{%t%}: %[Value Menu%] %v"
:button-prefix 'widget-push-button-prefix
:button-suffix 'widget-push-button-suffix
- :prompt-value 'widget-choice-prompt-value)
+ :prompt-value 'widget-choice-prompt-value
+ :inline-bubbles-p #'widget-choice-inline-bubbles-p)
(defun widget-choice-prompt-value (widget prompt value _unbound)
"Make a choice."
@@ -3948,6 +3978,20 @@ widget-choice-prompt-value
(if current
(widget-prompt-value current prompt nil t)
value)))
+
+(defun widget-choice-inline-bubbles-p (widget)
+ "Non-nil if the choice WIDGET has at least one choice that is inline.
+This is used when matching values, because a choice widget needs to
+match a value inline rather than just match it if at least one of its choices
+is inline."
+ (let ((args (widget-get widget :args))
+ cur found)
+ (while (and args (not found))
+ (setq cur (car args)
+ args (cdr args)
+ found (widget-get cur :inline)))
+ found))
+
\f
(define-widget 'radio 'radio-button-choice
"A union of several sexp types."
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el
index 4508b68023..1bd429736e 100644
--- a/test/lisp/wid-edit-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -148,4 +148,157 @@ widget-test-moving-editable-list-item
;; Check that we effectively moved the item to the last position.
(should (equal (widget-value lst) '("beg" "middle" "end"))))))
+(ert-deftest widget-test-choice-match-no-inline ()
+ "Test that a no-inline choice widget can match its values."
+ (let* ((choice '(choice (const nil) (const t) string function))
+ (widget (widget-convert choice)))
+ (should (widget-apply widget :match nil))
+ (should (widget-apply widget :match t))
+ (should (widget-apply widget :match ""))
+ (should (widget-apply widget :match 'ignore))))
+
+(ert-deftest widget-test-choice-match-all-inline ()
+ "Test that a choice widget with all inline members can match its values."
+ (let* ((lst '(list (choice (list :inline t symbol number)
+ (list :inline t symbol regexp))))
+ (widget (widget-convert lst)))
+ (should-not (widget-apply widget :match nil))
+ (should (widget-apply widget :match '(:test 2)))
+ (should (widget-apply widget :match '(:test ".*")))
+ (should-not (widget-apply widget :match '(:test ignore)))))
+
+(ert-deftest widget-test-choice-match-some-inline ()
+ "Test that a choice widget with some inline members can match its values."
+ (let* ((lst '(list string
+ (choice (const t)
+ (list :inline t symbol number)
+ (list :inline t symbol regexp))))
+ (widget (widget-convert lst)))
+ (should-not (widget-apply widget :match nil))
+ (should (widget-apply widget :match '("" t)))
+ (should (widget-apply widget :match '("" :test 2)))
+ (should (widget-apply widget :match '("" :test ".*")))
+ (should-not (widget-apply widget :match '(:test ignore)))))
+
+(ert-deftest widget-test-inline-p ()
+ "Test `widget-inline-p'.
+For widgets without an :inline t property, `widget-inline-p' has to return nil.
+But if the widget is a choice widget, it has to return nil if passed nil as
+the bubblep argument, or non-nil if one of the members of the choice widget has
+an :inline t property and we pass a non-nil bubblep argument. If no members of
+the choice widget have an :inline t property, then `widget-inline-p' has to
+return nil, even with a non-nil bubblep argument."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'repeat
+ :value '(nil)
+ '(choice (const nil) (const t)
+ (list :inline t symbol number))
+ '(choice (const nil) (const t)
+ (list function string))))
+ (children (widget-get widget :children))
+ (child-1 (car children))
+ (child-2 (cadr children)))
+ (should-not (widget-inline-p widget))
+ (should-not (widget-inline-p child-1))
+ (should (widget-inline-p child-1 'bubble))
+ (should-not (widget-inline-p child-2))
+ (should-not (widget-inline-p child-2 'bubble)))))
+
+(ert-deftest widget-test-repeat-can-handle-choice ()
+ "Test that we can create a repeat widget with a choice correctly."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'repeat
+ :entry-format "%i %d %v"
+ :value '((:test 2))
+ '(choice (const nil) (const t)
+ (list symbol number))))
+ (child (car (widget-get widget :children))))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (should child)
+ (should (equal (widget-value widget) '((:test 2)))))))
+
+(ert-deftest widget-test-repeat-can-handle-inlinable-choice ()
+ "Test that we can create a repeat widget with an inlinable choice correctly."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'repeat
+ :entry-format "%i %d %v"
+ :value '(:test 2)
+ '(choice (const nil) (const t)
+ (list :inline t symbol number))))
+ (child (widget-get widget :children)))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (should child)
+ (should (equal (widget-value widget) '(:test 2))))))
+
+(ert-deftest widget-test-list-can-handle-choice ()
+ "Test that we can create a list widget with a choice correctly."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'list
+ :value '((1 "One"))
+ '(choice string
+ (list number string))))
+ (child (car (widget-get widget :children))))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (should child)
+ (should (equal (widget-value widget) '((1 "One")))))))
+
+(ert-deftest widget-test-list-can-handle-inlinable-choice ()
+ "Test that we can create a list widget with an inlinable choice correctly."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'list
+ :value '(1 "One")
+ '(choice string
+ (list :inline t number string))))
+ (child (car (widget-get widget :children))))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (should child)
+ (should (equal (widget-value widget) '(1 "One"))))))
+
+(ert-deftest widget-test-option-can-handle-choice ()
+ "Test that we can create a option widget with a choice correctly."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'repeat
+ :value '(("foo"))
+ '(list (option
+ (choice string
+ (list :inline t
+ number string))))))
+ (child (car (widget-get widget :children))))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (should child)
+ (should (equal (widget-value widget) '(("foo")))))))
+
+(ert-deftest widget-test-option-can-handle-inlinable-choice ()
+ "Test that we can create a option widget with an inlinable choice correctly."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'repeat
+ :value '((1 "One"))
+ '(list (option
+ (choice string
+ (list :inline t
+ number string))))))
+ (child (car (widget-get widget :children))))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (should child)
+ (should (equal (widget-value widget) '((1 "One")))))))
+
;;; wid-edit-tests.el ends here
--
2.29.2
next prev parent reply other threads:[~2020-11-16 23:48 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-11-11 15:28 bug#44579: Unintended behaviour with defcustom’s ‘choice’ widgets and ":inline t" & Wrong documentation on "(elisp) Splicing into Lists" Leo Vivier
2020-11-16 23:48 ` Mauro Aranda [this message]
2020-11-17 17:56 ` Leo Vivier
2020-11-24 6:36 ` Lars Ingebrigtsen
2020-11-24 11:33 ` Mauro Aranda
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=CABczVwcOgcq8pQ88uWxRkbKJ9tPCG9rP1jnBiCPAEq2cXxuTng@mail.gmail.com \
--to=maurooaranda@gmail.com \
--cc=44579@debbugs.gnu.org \
--cc=zaeph@zaeph.net \
/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).