procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Prepare markers for insertions inside of a widget

Browse source 
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.
This commit is contained in:
Mauro Aranda 2025-01-17 17:12:08 -03:00 • committed by Eli Zaretskii
parent a1f2f5995d
commit 85113fcda9
2 changed files with 98 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

49
lisp/wid-edit.el
View file

@ -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)

51
test/lisp/wid-edit-tests.el
View file

@ -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