From 200c52895af62f3ff7fb3b817b791a0343039aa4 Mon Sep 17 00:00:00 2001 From: Mauro Aranda 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. (cherry picked from commit 85113fcda97970bc2468f409278e27d6570fc76f) --- 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 70dc30ae559..cfc86aac5dc 100644 --- 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 c18e6d14c4c..e34aa64f8d1 100644 --- 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 -- 2.39.5