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.

(cherry picked from commit 85113fcda97970bc2468f409278e27d6570fc76f)

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 70dc30ae55944739aaf88c296e6c458e652c71f6..cfc86aac5dca7eac543326467c1cb3a6ef3a8ff7 100644 (file)
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1730,6 +1730,49 @@ The value of the :type attribute should be an unconverted widget type."
           (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
@@ -1737,7 +1780,8 @@ The value of the :type attribute should be an unconverted widget type."
         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.
@@ -1797,7 +1841,8 @@ The value of the :type attribute should be an unconverted widget type."
          (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 c18e6d14c4ce7cd95f1c72cc5bd24a612b9ad1e4..e34aa64f8d134e155c7b9d791e61346af1e62ef5 100644 (file)
--- a/test/lisp/wid-edit-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -430,4 +430,55 @@ return nil, even with a non-nil bubblep argument."
       (should-not (overlay-buffer field-overlay))
       (should-not (overlay-buffer field-end-overlay)))))
 
+;; 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