markdown-ts-mode: fix code block and table overlays (bug#81195)

Fix to eliminate erroneous multiple code block overlays.  Fixes
to deal with 'treesit' fontification catching up to
user-initiated code block range expansions; e.g., inserting,
yanking.  Set overlay properties only once.

* lisp/textmodes/markdown-ts-mode.el
(markdown-ts--fontify-code-block): Use 'overlays-in' not
'overlays-at'.  Use only overlays, eliminate markers.
(markdown-ts--enable-code-block-in-context-mode): Add 'sit-for'
to allow 'treesit' to catch up (pending input should not be an
issue).
(markdown-ts--run-command-in-code-block): Use overlays instead
of 'get-char-property'.
(markdown-ts--code-block-in-context-mode-update-ov): Use
overlays instead of 'get-char-property'.  Set overlay properties
only once.
(markdown-ts--in-table-mode-update-ov): Set overlay properties
only once.
This commit is contained in:
Stéphane Marks 2026-06-11 14:26:21 -04:00 committed by Eli Zaretskii
parent ae69929472
commit 75cd277198

View file

@ -1602,19 +1602,14 @@ properties `markdown-ts-code-block-language' and
(markdown-ts--code-block-language-mode lang))) (markdown-ts--code-block-language-mode lang)))
(existing (seq-find (lambda (ov) (existing (seq-find (lambda (ov)
(overlay-get ov 'markdown-ts-code-block)) (overlay-get ov 'markdown-ts-code-block))
(overlays-at node-start)))) (overlays-in node-start node-end))))
(if existing (if existing
(progn (progn
(move-overlay existing node-start node-end) (move-overlay existing node-start node-end)
(overlay-put existing 'face face) (overlay-put existing 'face face)
(overlay-put existing 'markdown-ts-code-block-language lang) (overlay-put existing 'markdown-ts-code-block-language lang)
(overlay-put existing 'markdown-ts-code-block-mode mode)) (overlay-put existing 'markdown-ts-code-block-mode mode))
(let ((ov (make-overlay node-start node-end nil t nil))) (let ((ov (make-overlay node-start node-end nil nil t)))
;; Markers need to be set only once.
(overlay-put ov 'markdown-ts-code-beg-marker (set-marker (make-marker)
node-start))
(overlay-put ov 'markdown-ts-code-end-marker (set-marker (make-marker)
node-end))
(overlay-put ov 'markdown-ts-code-block t) (overlay-put ov 'markdown-ts-code-block t)
(overlay-put ov 'face face) (overlay-put ov 'face face)
(overlay-put ov 'priority '(nil . 10)) (overlay-put ov 'priority '(nil . 10))
@ -1625,7 +1620,8 @@ properties `markdown-ts-code-block-language' and
(defun markdown-ts-at-code-block-p (&optional pos) (defun markdown-ts-at-code-block-p (&optional pos)
"Return non nil if point is in a code block. "Return non nil if point is in a code block.
If POS is nil, use point." If POS is nil, use point."
(get-char-property (or pos (point)) 'markdown-ts-code-block)) (cl-some (lambda (ov) (overlay-get ov 'markdown-ts-code-block))
(overlays-at (or pos (point)))))
(defun markdown-ts-code-block-language-at (&optional pos) (defun markdown-ts-code-block-language-at (&optional pos)
"Return the language symbol of the code block at POS. "Return the language symbol of the code block at POS.
@ -1633,14 +1629,18 @@ If POS is nil, use point. Returns nil if POS is not inside a fenced
code block. This works regardless of whether a guest tree-sitter parser code block. This works regardless of whether a guest tree-sitter parser
is active, since the language is stored on the code block overlay by the is active, since the language is stored on the code block overlay by the
host parser's fontification." host parser's fontification."
(get-char-property (or pos (point)) 'markdown-ts-code-block-language)) (cl-some (lambda (ov) (overlay-get ov 'markdown-ts-code-block-language))
(overlays-at (or pos (point)))))
(defun markdown-ts-code-block-mode-at (&optional pos) (defun markdown-ts-code-block-mode-at (&optional pos)
"Return the major mode for the code block at POS. "Return the major mode for the code block at POS.
If POS is nil, use point. Returns nil if POS is not inside a fenced If POS is nil, use point. Returns nil if POS is not inside a fenced
code block or if the language has no recognized mode." code block, or `markdown-ts-default-code-block-mode' if the language has
no recognized mode."
(setq pos (or pos (point)))
(when (markdown-ts-at-code-block-p pos) (when (markdown-ts-at-code-block-p pos)
(or (get-char-property (or pos (point)) 'markdown-ts-code-block-mode) (or (cl-some (lambda (ov) (overlay-get ov 'markdown-ts-code-block-mode))
(overlays-at pos))
markdown-ts-default-code-block-mode))) markdown-ts-default-code-block-mode)))
(defun markdown-ts--host-ranges-notifier (ranges _parser) (defun markdown-ts--host-ranges-notifier (ranges _parser)
@ -2903,8 +2903,8 @@ node as a non-ts mode."
(mode (alist-get lang markdown-ts--code-block-non-ts-modes)) (mode (alist-get lang markdown-ts--code-block-non-ts-modes))
(tick (buffer-chars-modified-tick)) (tick (buffer-chars-modified-tick))
(block-start (treesit-node-start node)) (block-start (treesit-node-start node))
;; Cannot use markers 'markdown-ts-code-beg-marker ;; Cannot rely on anything set in
;; 'markdown-ts-code-end-marker they are set after this ;; `markdown-ts--fontify-code-block' that runs after this
;; function runs. ;; function runs.
(node-start (save-excursion (node-start (save-excursion
(goto-char (treesit-node-start node)) (goto-char (treesit-node-start node))
@ -3100,6 +3100,8 @@ See `markdown-ts--run-command-in-code-block'.")
(defun markdown-ts--enable-code-block-in-context-mode () (defun markdown-ts--enable-code-block-in-context-mode ()
"Enable `markdown-ts-code-block-in-context-mode' if in a fenced code block." "Enable `markdown-ts-code-block-in-context-mode' if in a fenced code block."
;; Let treesit catch up with buffer edits.
(sit-for 0)
(markdown-ts-code-block-in-context-mode (markdown-ts-code-block-in-context-mode
(if (markdown-ts-at-code-block-p) 1 -1))) (if (markdown-ts-at-code-block-p) 1 -1)))
@ -3200,8 +3202,12 @@ command will run in the context of the `markdown-ts-mode' buffer."
(defun markdown-ts--run-command-in-code-block (block-mode command &rest args) (defun markdown-ts--run-command-in-code-block (block-mode command &rest args)
"Run COMMAND in BLOCK-MODE. "Run COMMAND in BLOCK-MODE.
ARGS are captured by `markdown-ts--maybe-run-command-in-code-block'." ARGS are captured by `markdown-ts--maybe-run-command-in-code-block'."
(when-let* ((beg (get-char-property (point) 'markdown-ts-code-beg-marker)) (when-let* ((ov (cl-some
(end (get-char-property (point) 'markdown-ts-code-end-marker)) (lambda (ov)
(when (overlay-get ov 'markdown-ts-code-block) ov))
(overlays-at (point))))
(beg (overlay-start ov))
(end (overlay-end ov))
(str (buffer-substring-no-properties beg end))) (str (buffer-substring-no-properties beg end)))
;; Use a temp (or work) buffer because treesit currently confuses ;; Use a temp (or work) buffer because treesit currently confuses
;; nodes in an indirect buffer even if the indirect buffer is not ;; nodes in an indirect buffer even if the indirect buffer is not
@ -5496,20 +5502,24 @@ This enables the keymap `markdown-ts-code-block-in-context-mode-map'."
(defun markdown-ts--code-block-in-context-mode-update-ov () (defun markdown-ts--code-block-in-context-mode-update-ov ()
"Manage `markdown-ts--code-block-in-context-mode-ov'." "Manage `markdown-ts--code-block-in-context-mode-ov'."
(cond (markdown-ts-code-block-in-context-mode (cond (markdown-ts-code-block-in-context-mode
(let ((beg (get-char-property (point) 'markdown-ts-code-beg-marker)) (when-let* ((ov (cl-some
(end (get-char-property (point) 'markdown-ts-code-end-marker))) (lambda (ov)
(when (overlay-get ov 'markdown-ts-code-block) ov))
(overlays-at (point))))
(beg (overlay-start ov))
(end (overlay-end ov)))
(if markdown-ts--code-block-in-context-mode-ov (if markdown-ts--code-block-in-context-mode-ov
(move-overlay markdown-ts--code-block-in-context-mode-ov beg end) (move-overlay markdown-ts--code-block-in-context-mode-ov beg end)
(setq markdown-ts--code-block-in-context-mode-ov (setq markdown-ts--code-block-in-context-mode-ov
(make-overlay beg end nil t nil))) (make-overlay beg end nil nil t))
(overlay-put markdown-ts--code-block-in-context-mode-ov (overlay-put markdown-ts--code-block-in-context-mode-ov
'markdown-ts-in-code-block t) 'markdown-ts-in-code-block t)
(overlay-put markdown-ts--code-block-in-context-mode-ov (overlay-put markdown-ts--code-block-in-context-mode-ov
'evaporate t) 'evaporate t)
(overlay-put markdown-ts--code-block-in-context-mode-ov (overlay-put markdown-ts--code-block-in-context-mode-ov
'priority '(nil . 20)) 'priority '(nil . 20))
(overlay-put markdown-ts--code-block-in-context-mode-ov (overlay-put markdown-ts--code-block-in-context-mode-ov
'face 'markdown-ts-in-code-block))) 'face 'markdown-ts-in-code-block))))
(t (t
(when markdown-ts--code-block-in-context-mode-ov (when markdown-ts--code-block-in-context-mode-ov
(delete-overlay markdown-ts--code-block-in-context-mode-ov))))) (delete-overlay markdown-ts--code-block-in-context-mode-ov)))))
@ -5591,22 +5601,21 @@ It is up to this function's callers to call
(end (treesit-node-end table))) (end (treesit-node-end table)))
(if markdown-ts--in-table-mode-ov (if markdown-ts--in-table-mode-ov
;; Move the overlay, if needed, and reset the tick if so. ;; Move the overlay, if needed, and reset the tick if so.
(when (not (eq (overlay-start markdown-ts--in-table-mode-ov) (unless (and (eq (overlay-start markdown-ts--in-table-mode-ov) beg)
beg)) (eq (overlay-end markdown-ts--in-table-mode-ov) end))
(move-overlay markdown-ts--in-table-mode-ov beg end) (move-overlay markdown-ts--in-table-mode-ov beg end)
(overlay-put markdown-ts--in-table-mode-ov (overlay-put markdown-ts--in-table-mode-ov
'markdown-ts-in-table-tick nil)) 'markdown-ts-in-table-tick nil))
(setq markdown-ts--in-table-mode-ov (setq markdown-ts--in-table-mode-ov
(make-overlay beg end nil t nil))) (make-overlay beg end nil t t))
(overlay-put markdown-ts--in-table-mode-ov (overlay-put markdown-ts--in-table-mode-ov
'markdown-ts-in-table t) 'markdown-ts-in-table t)
(overlay-put markdown-ts--in-table-mode-ov (overlay-put markdown-ts--in-table-mode-ov
'evaporate t) 'evaporate t)
(overlay-put markdown-ts--in-table-mode-ov (overlay-put markdown-ts--in-table-mode-ov
'priority '(nil . 20)) 'priority '(nil . 20))
(overlay-put markdown-ts--in-table-mode-ov (overlay-put markdown-ts--in-table-mode-ov
'face 'markdown-ts-in-table) 'face 'markdown-ts-in-table))))
))
(t (t
(when markdown-ts--in-table-mode-ov (when markdown-ts--in-table-mode-ov
(delete-overlay markdown-ts--in-table-mode-ov))))) (delete-overlay markdown-ts--in-table-mode-ov)))))