summaryrefslogtreecommitdiff
path: root/test/lisp/wid-edit-tests.el
diff options
context:
space:
mode:
authorMauro Aranda <maurooaranda@gmail.com>2020-11-24 08:31:18 -0300
committerMauro Aranda <maurooaranda@gmail.com>2020-11-24 08:31:18 -0300
commitcbd24607d7b7419eb0f639c95185aff13f99c10d (patch)
treecd2f4c6df1fa65acb5b4e46943ec5c8071373019 /test/lisp/wid-edit-tests.el
parent5cc570215a30301939a56075035e91aa540513cb (diff)
downloademacs-cbd24607d7b7419eb0f639c95185aff13f99c10d.tar.gz
emacs-cbd24607d7b7419eb0f639c95185aff13f99c10d.tar.bz2
emacs-cbd24607d7b7419eb0f639c95185aff13f99c10d.zip
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.
Diffstat (limited to 'test/lisp/wid-edit-tests.el')
-rw-r--r--test/lisp/wid-edit-tests.el153
1 files changed, 153 insertions, 0 deletions
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el
index 4508b680232..1bd429736ea 100644
--- a/test/lisp/wid-edit-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -148,4 +148,157 @@
;; 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