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

Fix treesit--merge-ranges (bug#73324)

Browse source 
* lisp/treesit.el (treesit--merge-ranges): Make sure that old
ranges that intersects with START-END are actually discarded.
* test/src/treesit-tests.el (treesit-range-merge): New test.
This commit is contained in:
Yuan Fu 2024-09-20 20:40:26 -07:00
parent 76c6b4d279
commit 0834106a62
No known key found for this signature in database
GPG key ID: 56E19BC57664A442
2 changed files with 30 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
lisp/treesit.el
View file

@ -634,20 +634,39 @@ Return the merged list of ranges."
;; New range and old range don't intersect, new comes ;; New range and old range don't intersect, new comes
;; before, push new. ;; before, push new.
((<= new-end old-beg) ((<= new-end old-beg)
(push (car new-ranges) result) (unless (eq new-beg new-end)
(push (car new-ranges) result))
(setq new-ranges (cdr new-ranges))) (setq new-ranges (cdr new-ranges)))
;; New range and old range don't intersect, old comes ;; New range and old range don't intersect, old comes
;; before, push old. ;; before, push old.
((<= old-end new-beg) ((<= old-end new-beg)
(push (car old-ranges) result) (unless (eq old-beg old-end)
(push (car old-ranges) result))
(setq old-ranges (cdr old-ranges))) (setq old-ranges (cdr old-ranges)))
(t ;; New and old range intersect, discard old. (t ;; New and old range intersect, discard old.
(setq old-ranges (cdr old-ranges)))))) (setq old-ranges (cdr old-ranges))))))
(let ((left-over (or new-ranges old-ranges))) ;; At this point, either old-ranges has left-over or new-ranges has
(dolist (range left-over) ;; left-over, but not both.
(push range result))) (while old-ranges
;; For each left-over old range, push to result unless it
;; intersects with START-END.
(let ((old-beg (caar old-ranges))
(old-end (cdar old-ranges)))
(unless (or (and (< start old-end)
(< old-beg end))
(eq old-beg old-end))
(push (car old-ranges) result)))
(setq old-ranges (cdr old-ranges)))
;; Unconditionally push left-over new ranges to result.
(while new-ranges
(unless (eq (caar new-ranges) (cdar new-ranges))
(push (car new-ranges) result))
(setq new-ranges (cdr new-ranges)))
(nreverse result))) (nreverse result)))
;; TODO: truncate ranges that exceeds START and END instead of
;; discarding them. Merge into treesit--merge-ranges so we don't loop
;; over the ranges twice (might be premature optimization tho).
(defun treesit--clip-ranges (ranges start end) (defun treesit--clip-ranges (ranges start end)
"Clip RANGES in between START and END. "Clip RANGES in between START and END.
RANGES is a list of ranges of the form (BEG . END). Ranges RANGES is a list of ranges of the form (BEG . END). Ranges
@ -872,6 +891,7 @@ SETTING should be a setting in `treesit-font-lock-settings'."
(setf (nth 1 new-setting) t) (setf (nth 1 new-setting) t)
new-setting)) new-setting))
;; FIXME: Rewrite this in more readable fashion.
(defun treesit--font-lock-level-setter (sym val) (defun treesit--font-lock-level-setter (sym val)
"Custom setter for `treesit-font-lock-level'. "Custom setter for `treesit-font-lock-level'.
Set the default value of SYM to VAL, recompute fontification Set the default value of SYM to VAL, recompute fontification

5
test/src/treesit-tests.el
View file

@ -684,6 +684,11 @@ visible_end.)"
(should (equal '((16 . 28)) (treesit-query-range (should (equal '((16 . 28)) (treesit-query-range
'javascript query nil nil '(1 . -1))))))) 'javascript query nil nil '(1 . -1)))))))
(ert-deftest treesit-range-merge ()
"Test merging ranges."
(should (equal (treesit--merge-ranges '((1 . 1) (3 . 483)) nil 1 488)
nil)))
(ert-deftest treesit-range-fixup-after-edit () (ert-deftest treesit-range-fixup-after-edit ()
"Tests if Emacs can fix OOB ranges after deleting text or narrowing." "Tests if Emacs can fix OOB ranges after deleting text or narrowing."
(skip-unless (treesit-language-available-p 'json)) (skip-unless (treesit-language-available-p 'json))