Skip to content

feat: highlight faces #2

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 14 commits into
base: main
Choose a base branch
from
192 changes: 167 additions & 25 deletions erlang-ts.el
Original file line number Diff line number Diff line change
Expand Up @@ -155,21 +155,27 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active."
:override t
`( ;; Might be slow but don't know a better way to do it
(call expr: (_) @font-lock-type-face
(:pred erlang-ts-paren-is-type @font-lock-type-face))
(:pred erlang-ts-in-type-context-p @font-lock-type-face))
(type_name name: (atom) @font-lock-type-face)
(export_type_attribute types: (fa fun: (atom) @font-lock-type-face))
(record_decl name: (atom) @font-lock-type-face
(record_field name: (atom) @font-lock-property-name-face))
(record_name name: (atom) @font-lock-type-face))
(record_decl name: (atom) @font-lock-type-face)
(record_name name: (atom) @font-lock-type-face)
(record_field name: (atom) @font-lock-constant-face)
(record_field_name name: (atom) @font-lock-constant-face))

:language 'erlang
:feature 'definition
`((function_clause name: (atom) @font-lock-function-name-face)
(callback fun: (atom) @font-lock-function-name-face)
(spec fun: (atom) @font-lock-function-name-face)
(fa fun: (atom) @font-lock-function-name-face)
(binary_op_expr lhs: (atom) @font-lock-function-name-face "/"
rhs: (integer))
(internal_fun fun: (atom) @font-lock-function-name-face))
(internal_fun fun: (atom) @font-lock-function-name-face)
(external_fun module: (module name: (atom) @font-lock-constant-face)
fun: (atom) @font-lock-function-name-face)
(external_fun module: (module name: (atom) @font-lock-constant-face))
(external_fun fun: (atom) @font-lock-function-name-face))

:language 'erlang
:feature 'guards
Expand All @@ -185,22 +191,60 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active."
(remote_module module: (atom)
@module (:equal "erlang" @module))
fun: (atom) @fun (:match ,erlang-ext-bif-regexp @fun))
@font-lock-builtin-face))
@font-lock-builtin-face)
(call expr: (atom) @font-lock-builtin-face
(:match ,erlang-guards-regexp @font-lock-builtin-face)))

:language 'erlang
:feature 'preprocessor
:override t
`((wild_attribute name: (_) @font-lock-preprocessor-face)
(pp_define lhs: (macro_lhs name: (_) @font-lock-preprocessor-face))
(module_attribute (["-" "module"]) @font-lock-preprocessor-face)
(behaviour_attribute (["-" "behaviour" "behavior"]) @font-lock-preprocessor-face)
(deprecated_attribute (["-" "deprecated"]) @font-lock-preprocessor-face)
(export_attribute (["-" "export"]) @font-lock-preprocessor-face)
(import_attribute (["-" "import"]) @font-lock-preprocessor-face)
(export_type_attribute (["-" "export_type"]) @font-lock-preprocessor-face)
(compile_options_attribute (["-" "compile"]) @font-lock-preprocessor-face)
(file_attribute (["-" "file"]) @font-lock-preprocessor-face)
(feature_attribute (["-" "feature"]) @font-lock-preprocessor-face)
(optional_callbacks_attribute (["-" "optional_callbacks"]) @font-lock-preprocessor-face)

(pp_define (["-" "define"]) @font-lock-preprocessor-face)
(pp_include (["-" "include"]) @font-lock-preprocessor-face)
(pp_include_lib (["-" "include_lib"]) @font-lock-preprocessor-face)
(pp_undef (["-" "undef"]) @font-lock-preprocessor-face)
(pp_ifdef (["-" "ifdef"]) @font-lock-preprocessor-face)
(pp_ifndef (["-" "ifndef"]) @font-lock-preprocessor-face)
(pp_else (["-" "else"]) @font-lock-preprocessor-face)
(pp_endif (["-" "endif"]) @font-lock-preprocessor-face)
(pp_if (["-" "if"]) @font-lock-preprocessor-face)
(pp_elif (["-" "elif"]) @font-lock-preprocessor-face)

(record_decl (["-" "record"]) @font-lock-preprocessor-face)
(macro_call_expr name: (_) @font-lock-preprocessor-face)
(["module" "export" "import" "compile" "define" "record"
"spec" "type" "export_type" "opaque" "behaviour" "include" "include_lib"]
@font-lock-preprocessor-face))
(callback (["-" "callback"]) @font-lock-preprocessor-face)

(type_alias (["-" "type"]) @font-lock-preprocessor-face)
(opaque (["-" "opaque"]) @font-lock-preprocessor-face)
(spec (["-" "spec"]) @font-lock-preprocessor-face))

:language 'erlang
:feature 'constant
`(((atom) @font-lock-constant-face (:match "^'.*" @font-lock-constant-face))
((char) @font-lock-constant-face (:match "^$.*" @font-lock-constant-face)))
:override t
`((module_attribute name: (atom) @font-lock-constant-face)
(behaviour_attribute name: (_) @font-lock-constant-face)

(pp_define lhs: (macro_lhs name: (_) @font-lock-constant-face))
(pp_undef name: (_) @font-lock-constant-face)
(pp_ifdef name: (_) @font-lock-constant-face)
(pp_ifndef name: (_) @font-lock-constant-face)

(macro_call_expr name: (var) @font-lock-constant-face
(:pred erlang-ts-predefined-macro-p @font-lock-constant-face))

((atom) @font-lock-constant-face (:match ,erlang-atom-quoted-regexp @font-lock-constant-face))
((char) @font-lock-constant-face))

:language 'erlang
:feature 'index-atom
Expand All @@ -219,7 +263,12 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active."

:language 'erlang
:feature 'function-call
`((call expr: (_) @font-lock-function-call-face))
`(
(call expr: (atom) @font-lock-function-call-face)
(call expr: (remote module: (remote_module module: (atom) @font-lock-constant-face)
fun: (atom) @font-lock-function-call-face))
(call expr: (remote fun: (atom) @font-lock-function-call-face))
(remote module: (remote_module module: (atom) @font-lock-constant-face)))

:language 'erlang
:feature 'bracket
Expand All @@ -240,15 +289,106 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active."
Use `treesit-font-lock-level' or `treesit-font-lock-feature-list'
to change settings")

(defun erlang-ts-paren-is-type (node)
"Check if any parent of NODE is a type."
(let ((type (treesit-node-type node)))
(cond ((member type '("type_alias" "ann_type" "type_sig"
"opaque" "field_type"))
t)
((not type) nil)
(t
(erlang-ts-paren-is-type (treesit-node-parent node))))))
(defun erlang-ts-in-type-context-p (node)
"Check if NODE is within a type definition context."
(when node
(let ((parent (treesit-node-parent node)))
(cond
((null parent) nil)
((member (treesit-node-type parent)
'("type_alias" "ann_type" "type_sig" "opaque" "field_type")) t)
(t (erlang-ts-in-type-context-p parent))))))

(defun erlang-ts-predefined-macro-p (node)
"Check if macro_call_expr var NODE is a builtin macro."
(when node
(if (member (treesit-node-text node)
'("OTP_RELEASE" "MACHINE"
"MODULE" "MODULE_STRING"
"FILE" "LINE"
"FUNCTION_NAME" "FUNCTION_ARITY"
"FEATURE_AVAILABLE" "FEATURE_ENABLED"))
t
nil)))

(defvar erlang-ts--syntax-propertize-query
(when (treesit-available-p)
(treesit-query-compile
'erlang
'(((char) @node-char)
((atom) @node-atom)
((string) @node-string-triple-quoted (:match "^\"\"\"" @node-string-triple-quoted))
((string) @node-string)))))

(defun erlang-ts--process-node (node)
"Process a single or double quoted string or atom node.
NODE is the treesit node to process."
(let* ((node-text (treesit-node-text node))
(node-start (treesit-node-start node))
(node-end (treesit-node-end node))
(first-char (aref node-text 0))
(last-char (aref node-text (1- (length node-text)))))
(when (and (or (eq first-char ?\") (eq first-char ?\'))
(eq first-char last-char))
(let ((escaped-last-quote (and (eq last-char ?\")
(> (length node-text) 1)
(eq (aref node-text (- (length node-text) 2)) ?\\))))
(put-text-property node-start (1+ node-start) 'syntax-table (string-to-syntax "|"))
(put-text-property (1- node-end) node-end 'syntax-table (string-to-syntax "|"))
(unless escaped-last-quote
(put-text-property (1- node-end) node-end 'syntax-table (string-to-syntax "|")))
(let ((content-start (1+ node-start))
(content-end (1- node-end)))
(when (> content-end content-start)
(put-text-property content-start content-end 'syntax-table (syntax-table))))))))

(defun erlang-ts--process-node-char (node)
"Process char NODE like `$\'' or `$\"'."
(let* ((node-start (treesit-node-start node))
(node-end (treesit-node-end node)))
(message "modify char node")
(when (> node-end node-start)
(let ((custom-table (copy-syntax-table (syntax-table))))
(modify-syntax-entry ?' "w" custom-table)
(modify-syntax-entry ?\" "w" custom-table)
(put-text-property node-start node-end 'syntax-table custom-table)))))

(defun erlang-ts--process-node-triple-quoted (node)
"Process a triple quoted string node.
NODE is the treesit node to process."
(let* ((node-text (treesit-node-text node))
(node-start (treesit-node-start node))
(node-end (treesit-node-end node))
(text-length (length node-text)))
(put-text-property node-start (+ node-start 3) 'syntax-table (string-to-syntax "|"))
(when (>= text-length 3)
(put-text-property (- node-end 3) node-end 'syntax-table (string-to-syntax "|")))
(let ((content-start (+ node-start 3))
(content-end (- node-end 3)))
(when (> content-end content-start)
(put-text-property content-start content-end 'syntax-table (syntax-table))))))

(defun erlang-ts--syntax-propertize (start end)
"Apply syntax properties for Erlang specific patterns from START to END."
(let ((captures
(treesit-query-capture 'erlang erlang-ts--syntax-propertize-query start end)))
(pcase-dolist (`(,name . ,node) captures)
(pcase name
('node-char (erlang-ts--process-node-char node))
('node-atom (erlang-ts--process-node node))
('node-string (erlang-ts--process-node node))
('node-string-triple-quoted (erlang-ts--process-node-triple-quoted node))))))

(defvar erlang-ts-mode-syntax-table nil
"Syntax table in use in Erlang-ts-mode buffers.")

(defun erlang-ts-syntax-table-init ()
"Initialize the syntax table for `erlang-ts-mode'."
(unless erlang-ts-mode-syntax-table
(let ((table (copy-syntax-table erlang-mode-syntax-table)))
(modify-syntax-entry ?$ "w" table)
(setq erlang-ts-mode-syntax-table table)))
(set-syntax-table erlang-ts-mode-syntax-table))

(defun erlang-ts-setup ()
"Setup treesit for erlang."
Expand All @@ -269,12 +409,12 @@ Use `treesit-font-lock-level' or `treesit-font-lock-feature-list'
(builtin ;; Level 3
variable
guards
function-call
constant)
(operator ;; Level 4
delimiter
bracket
number
function-call
index-atom)))

;; Should we set this or let the user decide?
Expand Down Expand Up @@ -306,7 +446,8 @@ Use `treesit-font-lock-level' or `treesit-font-lock-feature-list'
(advice-add #'erlang-font-lock-level-3 :around #'erlang-ts--font-lock-level-3)
(advice-add #'erlang-font-lock-level-4 :around #'erlang-ts--font-lock-level-4)

(treesit-major-mode-setup))
(treesit-major-mode-setup)
(setq-local syntax-propertize-function #'erlang-ts--syntax-propertize))
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't think it's prudent to use syntax-propertize-function in a TreeSitter-powered mode, as you'll font-locking stuff at two different levels.

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

it's used to modify char syntax in captured string.
since:

...
  :syntax-table erlang-mode-syntax-table
...

erlang-mode marked char $ as "/", aka character-quote.
see also https://github.com/erlang/otp/blob/master/lib/tools/emacs/erlang.el#L1569

set syntax-propertize-function only for put-text-property to avoid ', ", $ are incorrectly highlighted in string or binary, and now there are triple-quoted string.

(Also, some emacs packages use char-syntax to jump between words.
The erlang char $a causes these packages to try to find another $ character to match the bracket)

A new commit copied erlang-mode-syntax-table and unset $.



(defun erlang-ts-unload-function ()
Expand All @@ -326,7 +467,8 @@ Use `treesit-font-lock-level' or `treesit-font-lock-feature-list'
;;;###autoload
(define-derived-mode erlang-ts-mode erlang-mode "erl-ts"
"Major mode for editing erlang with tree-sitter."
:syntax-table erlang-mode-syntax-table
:syntax-table nil
(erlang-ts-syntax-table-init)
(when (treesit-ready-p 'erlang)
(treesit-parser-create 'erlang)
(erlang-ts-setup)))
Expand Down