From 2899bf062db7e6bf199025ecef9d903760a0ef7d Mon Sep 17 00:00:00 2001 From: JimMoen Date: Thu, 20 Feb 2025 17:45:27 +0800 Subject: [PATCH 1/9] refactor: predicate function in-type-context-p --- erlang-ts.el | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/erlang-ts.el b/erlang-ts.el index 1563c3f..6f1f382 100644 --- a/erlang-ts.el +++ b/erlang-ts.el @@ -155,7 +155,7 @@ 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 @@ -185,7 +185,9 @@ 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 @@ -240,15 +242,15 @@ 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-setup () "Setup treesit for erlang." From 286256f474526d4513306a013d40163da130b466 Mon Sep 17 00:00:00 2001 From: JimMoen Date: Thu, 20 Feb 2025 17:50:33 +0800 Subject: [PATCH 2/9] feat: function-call and remote call face --- erlang-ts.el | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/erlang-ts.el b/erlang-ts.el index 6f1f382..b274fb6 100644 --- a/erlang-ts.el +++ b/erlang-ts.el @@ -169,7 +169,11 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active." (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 @@ -221,7 +225,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 @@ -271,12 +280,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? From 8d10332d10dcc578534314ee3e02b5a024fa7bf2 Mon Sep 17 00:00:00 2001 From: JimMoen Date: Sun, 23 Feb 2025 16:48:30 +0800 Subject: [PATCH 3/9] fix: callback function name --- erlang-ts.el | 1 + 1 file changed, 1 insertion(+) diff --git a/erlang-ts.el b/erlang-ts.el index b274fb6..7b145c1 100644 --- a/erlang-ts.el +++ b/erlang-ts.el @@ -165,6 +165,7 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active." :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 "/" From b4be800298c833850277a0b354eaa631fa1c3758 Mon Sep 17 00:00:00 2001 From: JimMoen Date: Sun, 23 Feb 2025 16:47:59 +0800 Subject: [PATCH 4/9] fix: record decl without fields --- erlang-ts.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/erlang-ts.el b/erlang-ts.el index 7b145c1..0cf0298 100644 --- a/erlang-ts.el +++ b/erlang-ts.el @@ -160,6 +160,9 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active." (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)) + ;; for records without fields e.g + ;; `-record(name, {}).` + (record_decl name: (atom) @font-lock-type-face) (record_name name: (atom) @font-lock-type-face)) :language 'erlang From 64b99adf14015b59384943cbdb96a1eaca07ebfd Mon Sep 17 00:00:00 2001 From: JimMoen Date: Sat, 22 Feb 2025 19:27:00 +0800 Subject: [PATCH 5/9] fix: preprocessor faces - To make `-` before attrs highlighted --- erlang-ts.el | 32 ++++++++++++++++++++++++++++---- 1 file changed, 28 insertions(+), 4 deletions(-) diff --git a/erlang-ts.el b/erlang-ts.el index 0cf0298..75645a6 100644 --- a/erlang-ts.el +++ b/erlang-ts.el @@ -201,11 +201,35 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active." :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 From 6b6aad8c24b6495799a92228f97fd330cc3f8a77 Mon Sep 17 00:00:00 2001 From: JimMoen Date: Sun, 23 Feb 2025 18:55:47 +0800 Subject: [PATCH 6/9] feat: predefined macro as constant --- erlang-ts.el | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/erlang-ts.el b/erlang-ts.el index 75645a6..3ce0702 100644 --- a/erlang-ts.el +++ b/erlang-ts.el @@ -233,7 +233,11 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active." :language 'erlang :feature 'constant - `(((atom) @font-lock-constant-face (:match "^'.*" @font-lock-constant-face)) + :override t + `((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 "^'.*" @font-lock-constant-face)) ((char) @font-lock-constant-face (:match "^$.*" @font-lock-constant-face))) :language 'erlang @@ -289,6 +293,18 @@ Use `treesit-font-lock-level' or `treesit-font-lock-feature-list' '("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))) + (defun erlang-ts-setup () "Setup treesit for erlang." From 6e24cac83d74b9d095271437f12e1eac0b2c32db Mon Sep 17 00:00:00 2001 From: JimMoen Date: Sun, 23 Feb 2025 21:22:46 +0800 Subject: [PATCH 7/9] fix: quoted atom and ASCII form char set syntax-propertize function - `$` in atom and string - Tripled-quoted string in doc or Var make erlang-ts-mode-syntax-table and mark `?$` as word - for char like `$'`, `$"`, `$\"`, modify text property as word --- erlang-ts.el | 88 +++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 84 insertions(+), 4 deletions(-) diff --git a/erlang-ts.el b/erlang-ts.el index 3ce0702..56d0b9b 100644 --- a/erlang-ts.el +++ b/erlang-ts.el @@ -237,8 +237,8 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active." `((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 "^'.*" @font-lock-constant-face)) - ((char) @font-lock-constant-face (:match "^$.*" @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 @@ -305,6 +305,84 @@ Use `treesit-font-lock-level' or `treesit-font-lock-feature-list' 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))) + (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." @@ -361,7 +439,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)) (defun erlang-ts-unload-function () @@ -381,7 +460,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))) From 70b6c4a167e265b364a82b508767a0c16d460751 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Fri, 17 Oct 2025 16:06:30 +0200 Subject: [PATCH 8/9] Color function calls in level 3 and Module in level 4 Let the user choose if they want different colors for module, function. --- erlang-ts.el | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/erlang-ts.el b/erlang-ts.el index 56d0b9b..cb3daec 100644 --- a/erlang-ts.el +++ b/erlang-ts.el @@ -174,10 +174,8 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active." (binary_op_expr lhs: (atom) @font-lock-function-name-face "/" rhs: (integer)) (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)) + (external_fun module: (module name: (atom) @font-lock-function-name-face) + fun: (atom) @font-lock-function-name-face)) :language 'erlang :feature 'guards @@ -256,17 +254,20 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active." `((var) @font-lock-variable-name-face) :language 'erlang - :feature 'function-call - `( - (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)) + :feature 'remote-module + :override t + `((call expr: (remote module: (remote_module module: (atom) @font-lock-constant-face) + fun: (atom) @font-lock-function-name-face)) + (external_fun module: (module name: (atom) @font-lock-constant-face)) (remote module: (remote_module module: (atom) @font-lock-constant-face))) + :language 'erlang + :feature 'function-call + `((call expr: (_) @font-lock-function-call-face)) + :language 'erlang :feature 'bracket - '((["(" ")" "[" "]" "{" "{" "}" "<<" ">>"]) @font-lock-bracket-face) + '((["(" ")" "[" "]" "{" "}" "<<" ">>"]) @font-lock-bracket-face) :language 'erlang :feature 'delimiter @@ -405,6 +406,7 @@ NODE is the treesit node to process." function-call constant) (operator ;; Level 4 + remote-module delimiter bracket number From bf5adaa17a55a8a0d21c30de949d6074731711a0 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Fri, 17 Oct 2025 16:40:40 +0200 Subject: [PATCH 9/9] Add OTP-28 operators And update instructions, because an updated treesitter grammer is required. --- README.md | 2 +- erlang-ts.el | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index 6a37c35..c4cbdcc 100644 --- a/README.md +++ b/README.md @@ -23,7 +23,7 @@ Add to your .emacs file: :mode ("\\.erl\\'" . erlang-ts-mode) :defer 't) ``` -Install/compile erlang treesitter support (first time only): +Install/compile erlang treesitter support (first time or update treesitter grammer): ``` M-x treesit-install-language-grammar diff --git a/erlang-ts.el b/erlang-ts.el index cb3daec..e74b943 100644 --- a/erlang-ts.el +++ b/erlang-ts.el @@ -23,7 +23,7 @@ ;; Keywords: erlang, languages, treesitter ;; URL: https://github.com/erlang/emacs-erlang-ts ;; Package-Requires: ((emacs "29.2") (erlang "27.2")) -;; Package-Version: 0.2 +;; Package-Version: 0.3 ;;; Commentary: @@ -46,7 +46,7 @@ ;; :mode ("\\.erl\\'" . erlang-ts-mode) ;; :defer 't) ;; ``` -;; Install/compile erlang treesitter support (first time only): +;; Install/compile erlang treesitter support (first time or upgrade grammer): ;; ;; ``` ;; M-x treesit-install-language-grammar @@ -275,9 +275,9 @@ FUNC with ARGS will be called if `erlang-ts-mode' is not active." :language 'erlang :feature 'operator - ;; Add "<:-" "<:=" "&&" when available in tree-sitter '(([ "->" "||" "<-" "<=" "+" "-" "*" "/" "++" - ">" ">=" "<" "=<" "=" "==" "=:=" "=/="]) + ">" ">=" "<" "=<" "=" "==" "=:=" "=/=" + "<:-" "<:=" "&&"]) @font-lock-operator-face)) "Tree-sitter font-lock settings for `erlang-ts-mode'.