Skip to content

Commit

Permalink
A lot of code cleanup
Browse files Browse the repository at this point in the history 
This should fix a kind of rare bug, where still some things would not
get highlighted at all.

I've also documented the code more and done some general cleanup.

Additionally, Stefan Monnier notified me per email that I should be
using add-hook and remove-hook for window-scroll-functions.
  • Loading branch information
@th0rex
th0rex committed Mar 29, 2020
1 parent cee69ec commit 43509f3
Showing 1 changed file with 74 additions and 58 deletions.
132 changes: 74 additions & 58 deletions lisp/tree-sitter-highlight.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -142,15 +142,15 @@
("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
"Where queries for languages are stored.
Directory needs to look as follows:
`tree-sitter-highlight-query-dir'/tree-sitter-<language>/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
Expand All @@ -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
Expand Down Expand Up @@ -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))))

Expand All @@ -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))
Expand All @@ -234,76 +230,95 @@ 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)
(pcase-let ((`(,key . ,value) x))
(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)
)
Expand All @@ -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
Expand Down

0 comments on commit 43509f3

Please sign in to comment.