Add region-restricted parsing and highlighting

Author: ubolonton

CHANGELOG.md

@@ -6,6 +6,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/).
 ## [Unreleased]
 - Added customization option `tsc-dyn-get-from`, which is a list of sources to get the dynamic module `tsc-dyn` from. Its default value is `(:github :compilation)`.
 - Made `tree-sitter-hl`'s region-fontification function fall back to the underlying non-tree-sitter function when called outside of `tree-sitter-hl-mode`. This fixes an issue where `jupyter-repl-mode`'s [input cells are not highlighted](https://github.com/nnicandro/emacs-jupyter/issues/363).
+- Added support for parsing and highlighting a single region, to enable `jupyter-repl` [integration](https://github.com/emacs-tree-sitter/elisp-tree-sitter/issues/78).
 
 ## [0.16.1] - 2021-12-11
 - Modified CI pipelines to publish additional pre-built dynamic modules. Their filenames include the platform they are built for. The files without platform in name will eventually be deprecated.

lisp/tree-sitter-hl.el

@@ -364,6 +364,21 @@ See `tree-sitter-hl-add-patterns'."
       (setf (map-elt tree-sitter-hl--patterns-alist lang-symbol)
             (append (list patterns) (remove patterns old-list))))))
 
+(defun tree-sitter-hl-dry-up-region (beg end)
+  "Make the highlighting in the region between BEG and END 'permanent'."
+  (let ((pos beg) next)
+    (while (< pos end)
+      ;; Determine the end of the current contiguous block...
+      (setq next (next-single-property-change pos 'face))
+      ;; ... which should be capped to END.
+      (when (or (null next)
+                (> next end))
+        (setq next end))
+      ;; Convert `face' to `font-lock-face'.
+      (when-let ((face (get-text-property pos 'face)))
+        (put-text-property pos next 'font-lock-face face))
+      (setq pos next))))
+
 ;;; ----------------------------------------------------------------------------
 ;;; Internal workings.
 
@@ -524,12 +539,32 @@ If LOUDLY is non-nil, print debug messages."
   "Highlight the region (BEG . END).
 
 This is a wrapper around `tree-sitter-hl--highlight-region' that falls back to
-OLD-FONTIFY-FN when the current buffer doesn't have `tree-sitter-hl-mode'
-enabled. An example is `jupyter-repl-mode', which copies and uses other major
-modes' fontification functions to highlight its input cells. See
-https://github.com/emacs-tree-sitter/elisp-tree-sitter/issues/78#issuecomment-1005987817."
-  (if tree-sitter-hl--query
-      (tree-sitter-hl--highlight-region beg end loudly)
+OLD-FONTIFY-FN in certain situations:
+
+1. When the current buffer doesn't have `tree-sitter-hl-mode' enabled. An
+   example is `jupyter-repl-mode', which copies and uses other major modes'
+   fontification functions to highlight its input cells. See
+   https://github.com/emacs-tree-sitter/elisp-tree-sitter/issues/78#issuecomment-1005987817.
+
+2. When the code to parse and highlight is confined to a single region. The
+   motivating use case parsing and highlighting the current input cell in
+   `jupyter-repl-mode'. See `tree-sitter-get-parse-region-function'."
+  (if (and tree-sitter-hl--query tree-sitter-tree)
+      (if tree-sitter--parse-region
+          ;; Highlight only the region that `tree-sitter' parsed. Use the
+          ;; underlying fontification function for the rest.
+          (pcase-let ((`(,code-beg . ,code-end) tree-sitter--parse-region))
+            (let ((tree-hl-beg (max beg code-beg))
+                  (tree-hl-end (min end code-end)))
+              (if (<= tree-hl-end tree-hl-beg)
+                  (funcall old-fontify-fn beg end loudly)
+                (when (< beg tree-hl-beg)
+                  (funcall old-fontify-fn beg tree-hl-beg loudly))
+                (when (< tree-hl-end end)
+                  (funcall old-fontify-fn tree-hl-end end loudly))
+                (tree-sitter-hl--highlight-region beg end loudly)
+                `(jit-lock-bounds ,beg . ,end))))
+        (tree-sitter-hl--highlight-region beg end loudly))
     (funcall old-fontify-fn beg end loudly)))
 
 (defun tree-sitter-hl--invalidate (&optional old-tree)

lisp/tree-sitter.el

@@ -45,7 +45,7 @@ syntax tree. It is run after `tree-sitter-mode-hook'."
 
 (defcustom tree-sitter-after-on-hook nil
   "Functions to call after enabling `tree-sitter-mode'.
-Use this to enable other minor modes that depends on the syntax tree."
+Use this to enable other minor modes that depend on the syntax tree."
   :type 'hook
   :group 'tree-sitter)
 
@@ -64,6 +64,22 @@ Use this to enable other minor modes that depends on the syntax tree."
 (defvar-local tree-sitter-language nil
   "Tree-sitter language.")
 
+(defvar-local tree-sitter-get-parse-region-function nil
+  "The function that provides the region to parse.
+
+This is intended to be used by major modes that want to parse code chunks, one
+at a time. An example is `jupyter-repl-mode'.
+
+This function should return a (BEG . END) cons cell. If it returns nil, the
+whole buffer will be parsed. If there is no code chunk to parse, the major mode
+should call `tree-sitter-pause' instead.")
+
+(defvar-local tree-sitter--parse-region nil
+  "The region that corresponds to the current syntax tree.
+Normally this is nil, which means the whole buffer was parsed.
+
+This is non-nil only if `tree-sitter-get-parse-region-function' was set.")
+
 (defvar-local tree-sitter--text-before-change nil)
 
 (defvar-local tree-sitter--beg-before-change nil)
@@ -140,6 +156,19 @@ OLD-LEN is the char length of the old text."
 (defun tree-sitter--do-parse ()
   "Parse the current buffer and update the syntax tree."
   (let ((old-tree tree-sitter-tree))
+    ;; Check and set range restriction (should be provided by the major mode).
+    (when (functionp tree-sitter-get-parse-region-function)
+      (when-let ((region (funcall tree-sitter-get-parse-region-function)))
+        ;; TODO: Check validity.
+        (setq tree-sitter--parse-region region)
+        (tsc-set-included-ranges
+         tree-sitter-parser
+         (pcase-let ((`(,beg . ,end) region))
+           (tsc--save-context
+             (vector (vector (position-bytes beg)
+                             (position-bytes end)
+                             (tsc--point-from-position beg)
+                             (tsc--point-from-position end))))))))
     (setq tree-sitter-tree
           ;; https://github.com/emacs-tree-sitter/elisp-tree-sitter/issues/3
           (tsc--without-restriction
@@ -180,6 +209,25 @@ signal an error."
        (when err
          ,@error-forms))))
 
+(defun tree-sitter-pause ()
+  "Pause incremental parsing in the current bufer.
+This should only be called by major modes that use
+`tree-sitter-get-parse-region-function'.
+
+Functions that depend on the syntax tree will stop working until
+`tree-sitter-resume' is called."
+  (setq tree-sitter-tree nil))
+
+(defun tree-sitter-resume ()
+  "Resume incremental parsing. If it was paused before, do a full parse first."
+  (tree-sitter--do-parse))
+
+;;;###autoload
+(defun tree-sitter-enable (lang-symbol)
+  "Turn on `tree-sitter-mode' for LANG-SYMBOL in the current buffer."
+  (setq tree-sitter-language (tree-sitter-require lang-symbol))
+  (tree-sitter-mode))
+
 ;;;###autoload
 (define-minor-mode tree-sitter-mode
   "Minor mode that keeps an up-to-date syntax tree using incremental parsing."