Subject: Re: bug#69941: 30.0.50; Faulty fontification of radio button widgets

From: Mauro Aranda <[email-masked]>
Date: Fri, 17 Jan 2025 17:13:07 -0300

Stefan Monnier <[email-masked]> writes:

 >> I attach a patch that implements something like that, along with a new
 >> test to check the recursive case.
 >
 > Great.  A few more comments:
 >
 >> +  (let* ((parent (widget-get widget :parent))
 >> +         (parent-from-marker (and parent (widget-get parent :from)))
 >> +         (parent-to-marker (and parent (widget-get parent :to)))
 >> +         (continue nil)
 >> +         (lst nil)
 >> +         (pos (point)))
 >> +    (when (and parent-from-marker
 >> +               (eq pos (marker-position parent-from-marker)))
 >> +      (set-marker-insertion-type parent-from-marker nil)
 >> +      (push (cons parent-from-marker t) lst)
 >> +      (setq continue t))
 >> +    (when (and parent-to-marker
 >> +               (eq pos (marker-position parent-to-marker)))
 >> +      (set-marker-insertion-type parent-to-marker t)
 >> +      (push (cons parent-to-marker nil) lst)
 >> +      (setq continue t))
 >> +    (when continue
 >> +      (setq lst
 >> + (append lst (widget--prepare-markers-for-inside-insertion
 >> parent))))
 >> +    lst))
 >
 > It just occurred to me that if widget updates happen recursively
 > (meaning that another widget update happens between the two calls to
 > `widget--prepare-markers-for-*-insertion`), then the
 > `widget--prepare-markers-for-outside-insertion` done at the end
 > of the inner call will mean that any insertion that happens afterwards
 > can end up inserting "outside" instead of "inside".  So, I think to
 > protect against that, we need the above code to push only those markers
 > which we do change (i.e. we need to test the current value of
 > `marker-insertion-type` before pushing it to `lst`).
 > Does that make sense, or am I imagining things?
 >

I think I get what you mean.  It makes sense, although I couldn't figure
out a precise scenario where this might actually happen.  I'll try to
explain:

Recursive updates happen anytime we are creating a composite
widget, and I think the situation you describe could potentially happen
when we are recreating a composite widget that's inside another
composite widget and that should be common enough to worry about it.

So we have: composite-widget > composite-widget2 > children.

If we're recreating the 'composite-widget2', then it will have markers
pointing nowhere (because of the deletion that happens first in
`widget-default-value-set`).  So the code will prepare the markers of
'composite-widget', but when `widget-default-create` gets called for
creating 'children', `widget--prepare-markers-for-inside-insertion` will
return an empty list, effectively avoiding the scenario you though
about, IIUC.

Nevertheless, since my imagination can only go so far, and because it's
quite easy to add those checks, I implemented that in the attached
patch.

 > PS: While I'm here, I might as well mention the irrelevant tweaks
 >   I'd be tempted to do:
 >
 > - Maybe instead of "prepare" I'd use "revert" in the name of the
 >   second function.
 > - `continue` is non-nil exactly when `lst` is non-nil, so we can drop
 >   `continue`.
 > - Since `lst` is a freshly consructed list, we can use `nconc`.
 > - The `setq` at the end is right before returning `lst`
 >   so we don't need it, instead we can finish with:
 >
 >     (when lst
 >       (nconc lst (widget--prepare-markers-for-inside-insertion 
parent)))))

These are most welcome, thanks.  New patch attached.
From cf0adbdf0db9b68d531df9a67717bfdf1a7554ba Mon Sep 17 00:00:00 2001
From: Mauro Aranda <[email-masked]>
Date: Fri, 17 Jan 2025 17:12:08 -0300
Subject: [PATCH] Prepare markers for insertions inside of a widget

Recreating child widgets without recreating the parent widget
may lead to situations where the parent widget doesn't cover its
children or buttons entirely anymore.  This bug manifests as a
faulty fontification of children or buttons, for example.
(Bug#69941)

* lisp/wid-edit.el (widget--prepare-markers-for-inside-insertion)
(widget--prepare-markers-for-outside-insertion): New functions.
(widget-default-create): Use them.

* test/lisp/wid-edit-tests.el (widget-test-insertion-at-parent-markers)
(widget-test-insertion-at-parent-markers-2): New tests.
---
 lisp/wid-edit.el            | 49 +++++++++++++++++++++++++++++++++--
 test/lisp/wid-edit-tests.el | 51 +++++++++++++++++++++++++++++++++++++
 2 files changed, 98 insertions(+), 2 deletions(-)

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index ca4e1e184cb..c272d3ec006 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1727,6 +1727,49 @@ widget-default-completions
           (call-interactively
            (widget-get widget :complete-function))))))))
 
+(defun widget--prepare-markers-for-inside-insertion (widget)
+  "Prepare the WIDGET's parent for insertions inside it, if necessary.
+
+Usually, the :from marker has type t, while the :to marker has type nil.
+When recreating a child or a button inside a composite widget right at these
+markers, they have to be changed to nil and t respectively,
+so that the WIDGET's parent (if any), properly contains all of its
+recreated children and buttons.
+
+Prepares also the markers of the WIDGET's grandparent, if necessary.
+
+Returns a list of the markers that had its type changed, for later resetting."
+  (let* ((parent (widget-get widget :parent))
+         (parent-from-marker (and parent (widget-get parent :from)))
+         (parent-to-marker (and parent (widget-get parent :to)))
+         (lst nil)
+         (pos (point)))
+    (when (and parent-from-marker
+               (eq pos (marker-position parent-from-marker))
+               (marker-insertion-type parent-from-marker))
+      (set-marker-insertion-type parent-from-marker nil)
+      (push (cons parent-from-marker t) lst))
+    (when (and parent-to-marker
+               (eq pos (marker-position parent-to-marker))
+               (not (marker-insertion-type parent-to-marker)))
+      (set-marker-insertion-type parent-to-marker t)
+      (push (cons parent-to-marker nil) lst))
+    (when lst
+      (nconc lst (widget--prepare-markers-for-inside-insertion parent)))))
+
+(defun widget--revert-markers-for-outside-insertion (markers)
+  "Revert MARKERS for insertions that do not belong to a widget.
+
+MARKERS is a list of the form (MARKER . NEW-TYPE), as returned by
+`widget--prepare-markers-for-inside-insertion' and this function sets MARKER
+to NEW-TYPE.
+
+Coupled with `widget--prepare-parent-for-inside-insertion', this has the effect
+of setting markers back to the type needed for insertions that do not belong
+to a given widget."
+  (dolist (marker markers)
+    (set-marker-insertion-type (car marker) (cdr marker))))
+
 (defun widget-default-create (widget)
   "Create WIDGET at point in the current buffer."
   (widget-specify-insert
@@ -1734,7 +1777,8 @@ widget-default-create
 	 button-begin button-end
 	 sample-begin sample-end
 	 doc-begin doc-end
-	 value-pos)
+         value-pos
+         (markers (widget--prepare-markers-for-inside-insertion widget)))
      (insert (widget-get widget :format))
      (goto-char from)
      ;; Parse escapes in format.
@@ -1794,7 +1838,8 @@ widget-default-create
 	  (widget-specify-doc widget doc-begin doc-end))
      (when value-pos
        (goto-char value-pos)
-       (widget-apply widget :value-create)))
+       (widget-apply widget :value-create))
+     (widget--revert-markers-for-outside-insertion markers))
    (let ((from (point-min-marker))
 	 (to (point-max-marker)))
      (set-marker-insertion-type from t)
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el
index 6f3c87a809f..6dc6ff1234f 100644
--- a/test/lisp/wid-edit-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -414,4 +414,55 @@ widget-test-restricted-sexp-empty-val
       (delete-char 1)
       (should (string= (widget-value w) "")))))
 
+;; The following two tests are for Bug#69941.  Markers need to be prepared
+;; against "inside" insertions at them.  That is, a recreated child should
+;; still be covered by the parent's :from and :to markers.
+(ert-deftest widget-test-insertion-at-parent-markers ()
+  "Test that recreating a child keeps the parent's markers covering it.
+
+Test the most common situation, where only one parent needs to be adjusted."
+  (with-temp-buffer
+    (let* ((group (widget-create 'group
+                                 :format "%v"
+                                 '(item :value 1 :format "%v")))
+           (item (car (widget-get group :children)))
+           (ofrom (marker-position (widget-get group :from)))
+           (oto (marker-position (widget-get group :to))))
+      (widget-insert "\n")
+      (widget-setup)
+      ;; Change item, without recreating the group.  This causes changes
+      ;; right at the :from and :to markers, and if they don't have
+      ;; the right type, the group's :from-:to span won't include its
+      ;; child, the item widget, anymore.
+      (widget-value-set item 2)
+      ;; The positions should be the same as they were when the group
+      ;; widget was first created.
+      (should (= ofrom (widget-get group :from)))
+      (should (= oto (widget-get group :to))))))
+
+(ert-deftest widget-test-insertion-at-parent-markers-2 ()
+  "Test that recreating a child keeps the parent's marker covering it.
+
+Test the uncommon situation in which we might need to prepare the grandparent's
+markers (and so on) as well."
+  (with-temp-buffer
+    (let* ((group (widget-create '(group
+                                   :format "%v"
+                                   (group
+                                    :format "%v"
+                                    (item :value 1 :format "%v")))))
+           (group2 (car (widget-get group :children)))
+           (item (car (widget-get group2 :children)))
+           (ofrom (marker-position (widget-get group :from)))
+           (oto (marker-position (widget-get group :to)))
+           (ofrom2 (marker-position (widget-get group2 :from)))
+           (oto2 (marker-position (widget-get group2 :to))))
+      (widget-insert "\n")
+      (widget-setup)
+      (widget-value-set item 2)
+      (should (= ofrom (widget-get group :from)))
+      (should (= oto (widget-get group :to)))
+      (should (= ofrom2 (widget-get group2 :from)))
+      (should (= oto2 (widget-get group2 :to))))))
+
 ;;; wid-edit-tests.el ends here
-- 
2.34.1