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

Eli Zaretskii <[email protected]>
Newsgroups gmane.emacs.diffs
Message-ID <[email protected]>
branch: emacs-31
commit 75cd27719849169716283d77e42b4f8c439808a5
Author: Stéphane Marks <[email protected]>
Commit: Eli Zaretskii <[email protected]>

    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.
---
 lisp/textmodes/markdown-ts-mode.el | 85 +++++++++++++++++++++-----------------
 1 file changed, 47 insertions(+), 38 deletions(-)

diff --git a/lisp/textmodes/markdown-ts-mode.el b/lisp/textmodes/markdown-ts-mode.el
index 7486ca2b2c8..a27255ca645 100644
--- a/lisp/textmodes/markdown-ts-mode.el
+++ b/lisp/textmodes/markdown-ts-mode.el
@@ -1602,19 +1602,14 @@ properties `markdown-ts-code-block-language' and
                  (markdown-ts--code-block-language-mode lang)))
          (existing (seq-find (lambda (ov)
                                (overlay-get ov 'markdown-ts-code-block))
-                             (overlays-at node-start))))
+                             (overlays-in node-start node-end))))
     (if existing
         (progn
           (move-overlay existing node-start node-end)
           (overlay-put existing 'face face)
           (overlay-put existing 'markdown-ts-code-block-language lang)
           (overlay-put existing 'markdown-ts-code-block-mode mode))
-      (let ((ov (make-overlay node-start node-end nil t nil)))
-        ;; 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))
+      (let ((ov (make-overlay node-start node-end nil nil t)))
         (overlay-put ov 'markdown-ts-code-block t)
         (overlay-put ov 'face face)
         (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)
   "Return non nil if point is in a code block.
 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)
   "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
 is active, since the language is stored on the code block overlay by the
 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)
   "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
-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)
-    (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)))
 
 (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))
               (tick (buffer-chars-modified-tick))
               (block-start (treesit-node-start node))
-              ;; Cannot use markers 'markdown-ts-code-beg-marker
-              ;; 'markdown-ts-code-end-marker they are set after this
+              ;; Cannot rely on anything set in
+              ;; `markdown-ts--fontify-code-block' that runs after this
               ;; function runs.
               (node-start (save-excursion
                             (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 ()
   "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
    (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)
   "Run COMMAND in BLOCK-MODE.
 ARGS are captured by `markdown-ts--maybe-run-command-in-code-block'."
-  (when-let* ((beg (get-char-property (point) 'markdown-ts-code-beg-marker))
-              (end (get-char-property (point) 'markdown-ts-code-end-marker))
+  (when-let* ((ov (cl-some
+                   (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)))
     ;; Use a temp (or work) buffer because treesit currently confuses
     ;; 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 ()
   "Manage `markdown-ts--code-block-in-context-mode-ov'."
   (cond (markdown-ts-code-block-in-context-mode
-         (let ((beg (get-char-property (point) 'markdown-ts-code-beg-marker))
-               (end (get-char-property (point) 'markdown-ts-code-end-marker)))
+         (when-let* ((ov (cl-some
+                          (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
                (move-overlay markdown-ts--code-block-in-context-mode-ov beg end)
              (setq markdown-ts--code-block-in-context-mode-ov
-                   (make-overlay beg end nil t nil)))
-           (overlay-put markdown-ts--code-block-in-context-mode-ov
-                        'markdown-ts-in-code-block t)
-           (overlay-put markdown-ts--code-block-in-context-mode-ov
-                        'evaporate t)
-           (overlay-put markdown-ts--code-block-in-context-mode-ov
-                        'priority '(nil . 20))
-           (overlay-put markdown-ts--code-block-in-context-mode-ov
-                        'face 'markdown-ts-in-code-block)))
+                   (make-overlay beg end nil nil t))
+             (overlay-put markdown-ts--code-block-in-context-mode-ov
+                          'markdown-ts-in-code-block t)
+             (overlay-put markdown-ts--code-block-in-context-mode-ov
+                          'evaporate t)
+             (overlay-put markdown-ts--code-block-in-context-mode-ov
+                          'priority '(nil . 20))
+             (overlay-put markdown-ts--code-block-in-context-mode-ov
+                          'face 'markdown-ts-in-code-block))))
         (t
          (when 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)))
            (if markdown-ts--in-table-mode-ov
                ;; Move the overlay, if needed, and reset the tick if so.
-               (when (not (eq (overlay-start markdown-ts--in-table-mode-ov)
-                              beg))
+               (unless (and (eq (overlay-start markdown-ts--in-table-mode-ov) beg)
+                            (eq (overlay-end markdown-ts--in-table-mode-ov) end))
                  (move-overlay markdown-ts--in-table-mode-ov beg end)
                  (overlay-put markdown-ts--in-table-mode-ov
                               'markdown-ts-in-table-tick nil))
              (setq markdown-ts--in-table-mode-ov
-                   (make-overlay beg end nil t nil)))
-           (overlay-put markdown-ts--in-table-mode-ov
-                        'markdown-ts-in-table t)
-           (overlay-put markdown-ts--in-table-mode-ov
-                        'evaporate t)
-           (overlay-put markdown-ts--in-table-mode-ov
-                        'priority '(nil . 20))
-           (overlay-put markdown-ts--in-table-mode-ov
-                        'face 'markdown-ts-in-table)
-           ))
+                   (make-overlay beg end nil t t))
+             (overlay-put markdown-ts--in-table-mode-ov
+                          'markdown-ts-in-table t)
+             (overlay-put markdown-ts--in-table-mode-ov
+                          'evaporate t)
+             (overlay-put markdown-ts--in-table-mode-ov
+                          'priority '(nil . 20))
+             (overlay-put markdown-ts--in-table-mode-ov
+                          'face 'markdown-ts-in-table))))
         (t
          (when markdown-ts--in-table-mode-ov
            (delete-overlay markdown-ts--in-table-mode-ov)))))
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.