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.

Sign up for GitHub

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
Open

feat: highlight faces #2

Changes from all commits
Commits
Show all changes
14 commits
Select commit Hold shift + click to select a range
2899bf0
refactor: predicate function in-type-context-p
JimMoen Feb 20, 2025
d042554
feat: module name as constant face
JimMoen Feb 20, 2025
a267314
feat: function-call and remote call face
JimMoen Feb 20, 2025
2017190
fix: record decl without fields
JimMoen Feb 23, 2025
c78c016
fix: callback function name
JimMoen Feb 23, 2025
947160b
fix: pp constant face
JimMoen Feb 23, 2025
61a0504
fix: preprocessor faces
JimMoen Feb 22, 2025
11382dc
feat: predefined macro as constant
JimMoen Feb 23, 2025
60ee341
fix: quoted atom and ASCII form char
JimMoen Feb 23, 2025
a37f7d2
fix: set syntax-propertize function
JimMoen Feb 23, 2025
76dc399
fix: treesit-node-text process func
JimMoen Feb 24, 2025
9a273d9
fix: external_fun highlight face
JimMoen Feb 24, 2025
e6c3a85
fix: improve record faces
JimMoen Feb 25, 2025
a952391
fix: make erlang-ts-mode-syntax-table and mark `?$` as word
JimMoen Mar 19, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
192 changes: 167 additions & 25 deletions erlang-ts.el
View file
Open in desktop
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)))
Copy link

Choose a reason for hiding this comment

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

I'd probably use when-let here to avoid the nil check branch.

(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")
Copy link

Choose a reason for hiding this comment

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

Seems like a leftover debug message.

(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