diff --git a/lisp/tree-sitter-highlight.el b/lisp/tree-sitter-highlight.el index 53ecb329..235f91e1 100644 --- a/lisp/tree-sitter-highlight.el +++ b/lisp/tree-sitter-highlight.el @@ -142,7 +142,7 @@ ("variable.parameter" . tree-sitter-variable-parameter-face)) "Alist of query identifier to face used for highlighting matches." :type '(alist :key-type string - :value-type face) + :value-type face) :group 'tree-sitter-highlight) (defcustom tree-sitter-highlight-query-dir nil @@ -150,7 +150,7 @@ Directory needs to look as follows: `tree-sitter-highlight-query-dir'/tree-sitter-/queries/highlights.scm" :type '(choice (const :tag "none" nil) - (directory :tag "path")) + (directory :tag "path")) :group 'tree-sitter-highlight) (defcustom tree-sitter-highlight-setup-functions nil @@ -160,20 +160,14 @@ to faces. Each function takes no arguments." :type 'hook :group 'tree-sitter-highlight) -(defvar-local tree-sitter-highlight--capture-names nil) (defvar-local tree-sitter-highlight--face-hash nil "Hashtable from query identifier to face, built from `tree-sitter-highlight-default-faces' and `tree-sitter-highlight-buffer-faces'.") (defvar-local tree-sitter-highlight--injections nil) (defvar-local tree-sitter-highlight--injections-query nil) -(defvar-local tree-sitter-highlight--jit-function nil) -(defvar-local tree-sitter-highlight--orig-scroll-functions nil) (defvar-local tree-sitter-highlight--query nil) (defvar-local tree-sitter-highlight--query-cursor nil) -(defvar-local tree-sitter-highlight--orig-buffer-function nil) -(defvar-local tree-sitter-highlight--orig-region-function nil) - (defun tree-sitter-highlight--read-file (language file) "Read FILE from the queries directory for the given LANGUAGE." (let ((path (concat tree-sitter-highlight-query-dir @@ -207,13 +201,14 @@ to faces. Each function takes no arguments." (defun tree-sitter-highlight--apply (x) "Apply the face for the match X in the buffer." (let* ((node (cdr x)) - ;; (index (car x)) - ;; (name (aref tree-sitter-highlight--capture-names index)) (name (car x)) (face (or (gethash name tree-sitter-highlight--face-hash) - (gethash (car (split-string name "\\.")) tree-sitter-highlight--face-hash))) + (gethash (car (split-string name "\\.")) tree-sitter-highlight--face-hash))) (start (ts-node-start-position node)) (end (ts-node-end-position node))) + ;; Make sure to not override other faces that have already been placed here. + ;; I'm not sure if the expected behaviour is to override or not to override + ;; (i.e. what should take precedence in tree-sitter, the first or the last match?) (unless (get-text-property start 'face) (add-face-text-property start end face)))) @@ -226,6 +221,7 @@ to faces. Each function takes no arguments." x))))) (defun tree-sitter-highlight--get-matches (start end) + "Run the query for the current buffer in the region START to END." (ts-set-point-range tree-sitter-highlight--query-cursor (ts--point-from-position start) (ts--point-from-position end)) @@ -234,60 +230,78 @@ to faces. Each function takes no arguments." tree-sitter-highlight--query (ts-root-node tree-sitter-tree) nil - ;; t #'ts-node-text) ) -(defun tree-sitter-highlight--jit (old-tree) - (when old-tree - (let ((changes (ts-changed-ranges old-tree tree-sitter-tree)) - (wstart (window-start)) - (wend (window-end))) - ;; TODO: Remember what we've highlighted, similar to how font-lock does it. - ;; Already highlighted regions shouldn't be re-highlighted. - - ;; Find changes that are within the current window - (mapc #'(lambda (range) - (let ((start (aref range 0)) - (end (aref range 1))) - ;; TODO: Improve this - (tree-sitter-highlight--highlight (max wstart start) (min wend end)))) - changes)))) - (defun tree-sitter-highlight--highlight (start end) + "Highlight the buffer from START to END with tree-sitter. + +This will remove all face properties in that region." + ;; TODO: Remember what we've highlighted, similar to how font-lock does it. + ;; Already highlighted regions shouldn't be re-highlighted. (ts--save-context (with-silent-modifications - (remove-text-properties start - end - '(face nil)) + (remove-text-properties start end '(face nil)) (let ((matches (tree-sitter-highlight--get-matches start end))) (seq-do #'(lambda (match) (seq-do #'tree-sitter-highlight--apply (cdr match))) matches))))) -;; (seq-do #'tree-sitter-highlight--apply - -;; (ts-highlight (ts-root-node tree-sitter-tree) -;; tree-sitter-highlight--query-cursor -;; tree-sitter-highlight--query -;; tree-sitter-highlight--injections-query -;; #'ts-node-text -;; (lambda (start end) -;; (remove-text-properties (ts-byte-to-position start) -;; (ts-byte-to-position end) -;; '(face nil))) -;; (lambda (language) -;; (car (tree-sitter-highlight--get-injection (intern language)))) -;; (lambda (language) -;; (cadr (tree-sitter-highlight--get-injection (intern language)))) -;; (ts-byte-from-position start) -;; (ts-byte-from-position end))))) - -(defun tree-sitter-highlight--highlight-window (_window start) - (tree-sitter-highlight--highlight start (window-end nil t))) + +(defun tree-sitter-highlight--jit (old-tree) + "Highlight the buffer just-in-time, i.e. after the buffer was parsed with tree-sitter." + (when old-tree + (let ((changes (ts-changed-ranges old-tree tree-sitter-tree)) + (wstart (window-start)) + (wend (window-end))) + + ;; The old version: + ;; + ;; Find changes that are within the current window + ;; (mapc #'(lambda (range) + ;; (let ((start (aref range 0)) + ;; (end (aref range 1))) + ;; ;; TODO: Improve this + ;; (tree-sitter-highlight--highlight (max wstart start) (min wend end)))) + ;; changes)))) + + ;; The new version: + ;; Should at least never *miss* something, but certainly does "too much" (unneeded) work. + ;; Checks if the start or the end of any changed range lies within window-start and window-end. + ;; If any does, then highlight the whole visible region. + (when (seq-reduce #'(lambda (acc range) + (let ((start (aref range 0)) + (end (aref range 1))) + (or ;; Any previous range was visible + acc + ;; ... or the start is visible + (and (>= start wstart) + (<= start wend)) + ;; ... or the end is visible + (and (>= end wstart) + (<= end wend))))) + changes nil) + ;; Highlight the whole visible region. + (tree-sitter-highlight--highlight wstart wend))))) + +(defun tree-sitter-highlight--highlight-window (_window _start) + "Highlight the _WINDOW after scrolling took place. + +Sadly we currently re-highlight the whole buffer. +The previous code (tree-sitter-highlight--highlight start (window-end nil t)) +was not correct. +For example, if I place a single \" (without the \ ) in a Rust file and then +scroll around, code below that \" would not be highlighted at all, if there wasn't +anything that closed the \". +I think this happens because we constrain the query to the visible region, and nothing matches +there, since the start of the string is further up in the buffer, and the end of it is further down. +" + (tree-sitter-highlight--highlight (point-min) (point-max))) (defun tree-sitter-highlight--enable () "Enable `tree-sitter-highlight' in this buffer." (run-hooks 'tree-sitter-highlight-setup-functions) + ;; Construct the hash table for identifier (function.builtin, etc) to the face + ;; that should be used. (setq tree-sitter-highlight--face-hash (let ((table (make-hash-table :test 'equal))) (mapc (lambda (x) @@ -295,15 +309,16 @@ to faces. Each function takes no arguments." (puthash key value table))) tree-sitter-highlight-default-faces) table)) + ;; Read the queries for the current file type from disk. + ;; TODO: We could cache this for each file type I think. (let ((x (tree-sitter-highlight--make-queries (alist-get major-mode tree-sitter-major-mode-language-alist)))) - (setq tree-sitter-highlight--query (car x) - tree-sitter-highlight--injections-query (cadr x))) - (setq tree-sitter-highlight--capture-names (ts-query-capture-names tree-sitter-highlight--query)) + (setq tree-sitter-highlight--query (car x) + tree-sitter-highlight--injections-query (cadr x))) (setq tree-sitter-highlight--query-cursor (ts-make-query-cursor)) - (make-variable-buffer-local 'window-scroll-functions) - (setq tree-sitter-highlight--orig-scroll-functions window-scroll-functions) - (setq window-scroll-functions (cons #'tree-sitter-highlight--highlight-window window-scroll-functions)) + (add-hook 'window-scroll-functions + #'tree-sitter-highlight--highlight-window nil t) + ;; Highlight the current window. (tree-sitter-highlight--highlight-window nil (window-start)) (add-hook 'tree-sitter-after-change-functions #'tree-sitter-highlight--jit nil t) ) @@ -314,7 +329,8 @@ to faces. Each function takes no arguments." (remove-text-properties (point-min) (point-max) '(face nil))) - (setq window-scroll-functions tree-sitter-highlight--orig-scroll-functions) + (remove-hook 'window-scroll-functions + #'tree-sitter-highlight--highlight-window t) (remove-hook 'tree-sitter-after-change-functions #'tree-sitter-highlight--jit t)) (define-minor-mode tree-sitter-highlight-mode