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

From: Mauro Aranda <[email-masked]>
Date: Fri, 17 Jan 2025 08:52:29 -0300

Stefan Monnier <[email-masked]> writes:

 >> I attach a patch with a first idea (based on Stefan's suggestions),
 >> where we "protect" the parent's markers, inside widget-default-create.
 >> This is so we can try to catch almost all situations where this bug
 >> might arise.
 >
 > I can't judge whether `widget-default-create` covers all the cases, but
 > other than that, it's looking good (well, I find this "set and later 
reset"
 > to be rather ugly/brittle, but that's probably as good as it gets given
 > what we have).

Thanks for taking a look.

 >> +(defun widget--protect-parent-markers (widget)
 >> +  "Protect the :from and :to markers of the WIDGET's parent, if 
necessary.
 >> +
 >> +Usually, the :from marker has type t, while the :to marker has type 
nil.
 >> +When creating a child or a button inside a composite widget, they 
have to be
 >> +changed to nil and t respectively, so that the WIDGET's parent (if 
any),
 >> +properly contains all of its children and buttons."
 >> +  (let* ((parent (widget-get widget :parent))
 >> +         (parent-from-marker (and parent (widget-get parent :from)))
 >> +         (parent-to-marker (and parent (widget-get parent :to)))
 >> +         (pos (point)))
 >> +    (when (and parent-from-marker
 >> +               (eq pos (marker-position parent-from-marker)))
 >> +      (set-marker-insertion-type parent-from-marker nil))
 >> +    (when (and parent-to-marker
 >> +               (eq pos (marker-position parent-to-marker)))
 >> +      (set-marker-insertion-type parent-to-marker t))))
 >> +
 >> +(defun widget--unprotect-parent-markers (widget)
 >> +  "Unprotect the :from and :to markers of the WIDGET's parent, if 
necessary.
 >> +
 >> +Changes the :from marker type back to t and the :to marker type 
back to nil."
 >> +  (let* ((parent (widget-get widget :parent))
 >> +         (parent-from-marker (and parent (widget-get parent :from)))
 >> +         (parent-to-marker (and parent (widget-get parent :to))))
 >> +    (when parent-from-marker
 >> +      (set-marker-insertion-type parent-from-marker t))
 >> +    (when parent-to-marker
 >> +      (set-marker-insertion-type parent-to-marker nil))))
 >
 > I'm not a big fan of the name "protect" here, to be honest.
 > Maybe `widget--prepare-parent-for-insertion`?

Sounds a little bit better, thanks.  I went for something similar.

 >> It doesn't catch _all_, in theory, since it might happen
 >> that a grandparent widget doesn't adjust its markers, but maybe that's
 >> unusual enough that we can get away with it.
 >
 > We can probably handle that case easily by just adding to
 > `widget--protect-parent-markers` a recursive call if either the :from or
 > the :to marker had to be adjusted.  The only difficulty I see is making
 > sure we adjust all the makers in the "unprotect" case that we
 > protected earlier.  Maybe we should make
 > `widget--protect-parent-markers` return a list of (MARKER
 > . PREVIOUS-TYPE) so the `widget--unprotect-parent-markers`
 > would turn into something like (mapcar (apply-partially #'apply
 > #'set-marker-insertion-type) ...).
 > IIUC that list would be empty in the vast majority of cases.

Thanks for this idea.

I attach a patch that implements something like that, along with a new
test to check the recursive case.
From 46fa8a16858baabda6a3f1fbdaaa2f0d3e720e5b Mon Sep 17 00:00:00 2001
From: Mauro Aranda <[email-masked]>
Date: Fri, 17 Jan 2025 08:30:59 -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            | 52 +++++++++++++++++++++++++++++++++++--
 test/lisp/wid-edit-tests.el | 51 ++++++++++++++++++++++++++++++++++++
 2 files changed, 101 insertions(+), 2 deletions(-)

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index ca4e1e184cb..d1078114c99 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1727,6 +1727,52 @@ 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)))
+         (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))
+
+(defun widget--prepare-markers-for-outside-insertion (markers)
+  "Prepare 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 +1780,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 +1841,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--prepare-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