summaryrefslogtreecommitdiff
path: root/lisp/wid-edit.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 /lisp/wid-edit.el
parent5cc570215a30301939a56075035e91aa540513cb (diff)
downloademacs-cbd24607d7b7419eb0f639c95185aff13f99c10d.tar.gz
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 'lisp/wid-edit.el')
-rw-r--r--lisp/wid-edit.el72
1 files changed, 58 insertions, 14 deletions
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 4e2cf7416d4..8250316bcc7 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -591,9 +591,25 @@ Otherwise, just return the value."
(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 @@ But if NO-TRUNCATE is non-nil, include them."
(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 @@ But if NO-TRUNCATE is non-nil, include them."
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 @@ If the item is checked, CHOSEN is a cons whose cdr is the value."
(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 @@ Return an alist of (TYPE MATCH)."
(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 @@ Save CHILD into the :last-deleted list, so it can be inserted later."
(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 @@ example:
`(cons :format "Key: %v" ,key-type ,value-type)))
(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 @@ example:
(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))
+
(define-widget 'radio 'radio-button-choice
"A union of several sexp types."