Merge branch 'symbols-over-strings'

CHANGELOG.md

@@ -4,6 +4,16 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/).
 
 ## [Unreleased]
+- Used keywords instead of strings for field names.
+  + Replaced `ts-field-name-for-id`, `ts-field-id-for-name` with `ts-lang-field`, `ts-lang-field-id`.
+  + Replaced `ts-current-field-name` with `ts-current-field`.
+  + Replaced `ts-get-child-by-field-name` with `ts-get-child-by-field`.
+- Used symbols for named node types.
+  + Replaced `ts-type-name-for-id` with `ts-lang-node-type`.
+  + Added `ts-lang-node-type-id`.
+  + Changed the return type of `ts-node-type`.
+- Renamed `ts-type-named-p` to `ts-lang-node-type-named-p`.
+- Added optional param `NODE-TYPE` to `tree-sitter-node-at-point`.
 
 ## [0.9.2] - 2020-07-20
 - Upgraded `tree-sitter` crate to add `.` as a valid start of predicates, in addition to `#`.

README.md

@@ -53,12 +53,12 @@ If you want to hack on `emacs-tree-sitter` itself, see the section [Setup for De
              (beg (min p m))
              (end (max p m))
              (root (ts-root-node tree-sitter-tree))
-             (node (ts-get-named-descendant-for-position-range root beg end))
+             (node (ts-get-descendant-for-position-range root beg end))
              (node-beg (ts-node-start-position node))
              (node-end (ts-node-end-position node)))
         ;; Already marking current node. Try its parent node instead.
-        (when (and (= beg node-beg) (= end node-end))
-          (when-let ((node (ts-get-parent node)))
+        (while (and (= beg node-beg) (= end node-end) node)
+          (when (setq node (ts-get-parent node))
             (setq node-beg (ts-node-start-position node)
                   node-end (ts-node-end-position node))))
         (set-mark node-end)

lisp/tree-sitter-core.el

@@ -134,6 +134,12 @@ This function must be called with narrowing disabled, e.g. within a
    (position-bytes beg)
    (position-bytes end)))
 
+(defun ts-get-child-by-field (node field)
+  "Return NODE's child associated with FIELD, which should be a keyword."
+  (unless (keywordp field)
+    (signal 'wrong-type-argument (list 'keywordp field)))
+  (ts--get-child-by-field-name node (substring (symbol-name field) 1)))
+
 (defun ts-node-start-position (node)
   "Return NODE's start position."
   (byte-to-position (ts-node-start-byte node)))
@@ -154,6 +160,21 @@ This function must be called with narrowing disabled, e.g. within a
 Return the index of the child node if one was found, nil otherwise."
   (ts-goto-first-child-for-byte cursor (position-bytes position)))
 
+(defun ts-lang-field-id (language field)
+  "Return the numeric id of FIELD in LANGUAGE. FIELD should be a keyword."
+  (unless (keywordp field)
+    (signal 'wrong-type-argument (list 'keywordp field)))
+  (ts--lang-field-id-for-name language (substring (symbol-name field) 1)))
+
+(defun ts-lang-node-type-id (language node-type)
+  "Return the numeric id of NODE-TYPE in LANGUAGE.
+NODE-TYPE should be a symbol (named nodes) or a string (anonymous nodes)."
+  (cond
+   ((symbolp node-type)
+    (ts--lang-type-id-for-name language (symbol-name node-type) :named))
+   (t
+    (ts--lang-type-id-for-name language node-type nil))))
+
 
 ;;; Querying.
 

lisp/tree-sitter-tests.el

@@ -23,6 +23,9 @@
 
 (require 'ert)
 
+(eval-when-compile
+  (require 'subr-x))
+
 (defun ts-test-make-parser (lang-symbol)
   "Return a new parser for LANG-SYMBOL."
   (let ((parser (ts-make-parser))
@@ -80,6 +83,11 @@ If RESET is non-nil, also do another full parse and check again."
 (ert-deftest creating-parser ()
   (should (ts-parser-p (ts-test-make-parser 'rust))))
 
+(ert-deftest language::info ()
+  (dolist (lang-symbol '(rust bash javascript c))
+    (let ((language (tree-sitter-require lang-symbol)))
+      (should (eq lang-symbol (ts--lang-symbol language))))))
+
 (ert-deftest language::equality ()
   (ts-test-with 'rust parser
     ;; XXX: `equal' seems to return nil even if 2 `user-ptr' objects have the same pointer and
@@ -90,21 +98,33 @@ If RESET is non-nil, also do another full parse and check again."
 (ert-deftest language::node-types ()
   (let* ((language (tree-sitter-require 'rust))
          (type-count (ts-lang-count-types language)))
+    (ert-info ("Round tripping node-type node-type-id")
+      (dolist (node-type '(identifier function_item "if" "else"))
+        (should (equal (thread-last node-type
+                         (ts-lang-node-type-id language)
+                         (ts-lang-node-type language))
+                       node-type))))
     (ert-info ("0 should be the special node type \"end\"")
-      (should (equal "end" (ts-type-name-for-id language 0))))
+      (should (equal 'end (ts-lang-node-type language 0))))
     (ert-info ("Node type IDs should be from 0 to type count minus 1")
-      (should-not (null (ts-type-name-for-id language 1)))
-      (should-not (null (ts-type-name-for-id language (- type-count 1))))
-      (should (null (ts-type-name-for-id language type-count))))))
+      (should-not (null (ts-lang-node-type language 1)))
+      (should-not (null (ts-lang-node-type language (- type-count 1))))
+      (should (null (ts-lang-node-type language type-count))))))
 
 (ert-deftest language::fields ()
   (let* ((language (tree-sitter-require 'rust))
          (field-count (ts-lang-count-fields language)))
+    (ert-info ("Round tripping field field-id")
+      (dolist (field '(:name :left :right :value))
+        (should (eq (thread-last field
+                      (ts-lang-field-id language)
+                      (ts-lang-field language))
+                    field))))
     (ert-info ("Field IDs should be from 1 to field count")
-      (should (null (ts-field-name-for-id language 0)))
-      (should-not (null (ts-field-name-for-id language 1)))
-      (should-not (null (ts-field-name-for-id language field-count)))
-      (should (null (ts-field-name-for-id language (1+ field-count)))))))
+      (should (null (ts-lang-field language 0)))
+      (should (keywordp (ts-lang-field language 1)))
+      (should (keywordp (ts-lang-field language field-count)))
+      (should (null (ts-lang-field language (1+ field-count)))))))
 
 (ert-deftest parsing::rust-string ()
   (ts-test-with 'rust parser
@@ -170,6 +190,20 @@ If RESET is non-nil, also do another full parse and check again."
       (delete-region beg end)
       (ts-test-tree-sexp orig-sexp :reset))))
 
+(ert-deftest minor-mode::node-at-point ()
+  (ts-test-lang-with-file 'rust "lisp/test-files/types.rs"
+    (should (eq 'source_file (ts-node-type (tree-sitter-node-at-point 'source_file))))
+    (search-forward "erase_")
+    (should (eq 'identifier (ts-node-type (tree-sitter-node-at-point))))
+    (should (eq 'function_item (ts-node-type (tree-sitter-node-at-point 'function_item))))
+    (should (null (tree-sitter-node-at-point "function_item")))
+    (should (null (tree-sitter-node-at-point 'impl_item)))
+    ;; FIX: Signal an error for non-existing node types.
+    (should (null (tree-sitter-node-at-point 'non-existing-node-type)))
+    (search-forward "struc")
+    (should (equal "struct" (ts-node-type (tree-sitter-node-at-point))))
+    (should (eq 'struct_item (ts-node-type (tree-sitter-node-at-point 'struct_item))))))
+
 (ert-deftest node::eq ()
   (ts-test-with 'rust parser
     (let* ((tree (ts-parse-string parser "fn foo() {}"))
@@ -188,6 +222,30 @@ tree is held (since nodes internally reference the tree)."
       (should (eql 1 (ts-count-children node))))
     (garbage-collect)))
 
+(ert-deftest node::types ()
+  (ts-test-with 'rust parser
+    (ert-info ("Error nodes")
+      (let* ((root (ts-root-node (ts-parse-string parser "fn")))
+             (err (ts-get-nth-child root 0)))
+        (should (ts-node-has-error-p root))
+        (should-not (ts-node-error-p root))
+        (should (eq (ts-node-type root) 'source_file))
+        (ert-info ("Should have a special type")
+          (should (eq (ts-node-type err) 'ERROR)))
+        (should (ts-node-error-p err))
+        (should (ts-node-has-error-p err))))
+    (ert-info ("Missing nodes")
+      (let* ((root (ts-root-node (ts-parse-string parser "let x = 1")))
+             (decl (ts-get-nth-child root 0))
+             (n (ts-count-children decl))
+             (semi (ts-get-nth-child decl (- n 1))))
+        (should (ts-node-has-error-p root))
+        (should-not (ts-node-error-p root))
+        (should (eq (ts-node-type root) 'source_file))
+        (ert-info ("Should have a normal type")
+          (should (equal (ts-node-type semi) ";")))
+        (should (ts-node-missing-p semi))))))
+
 (ert-deftest cursor::walk ()
   (ts-test-with 'rust parser
     (let* ((tree (ts-parse-string parser "fn foo() {}"))
@@ -201,9 +259,9 @@ tree is held (since nodes internally reference the tree)."
     (let* ((node (ts-root-node tree-sitter-tree))
            (cursor (ts-make-cursor node)))
       (ts-goto-first-child cursor)
-      (should-not (equal (ts-node-type (ts-current-node cursor)) "source_file"))
+      (should-not (equal (ts-node-type (ts-current-node cursor)) 'source_file))
       (ts-reset-cursor cursor node)
-      (should (equal (ts-node-type (ts-current-node cursor)) "source_file")))))
+      (should (equal (ts-node-type (ts-current-node cursor)) 'source_file)))))
 
 (ert-deftest cursor::using-without-tree ()
   (ts-test-with 'rust parser

lisp/tree-sitter.el

@@ -262,11 +262,21 @@ Both SETUP-FUNCTION and TEARDOWN-FUNCTION should be idempotent."
        ,teardown)))
 
 ;;;###autoload
-(defun tree-sitter-node-at-point ()
-  "Return the syntax node at point."
-  (let ((root (ts-root-node tree-sitter-tree))
-        (p (point)))
-    (ts-get-descendant-for-position-range root p p)))
+(defun tree-sitter-node-at-point (&optional node-type)
+  "Return the smallest syntax node at point whose type is NODE-TYPE.
+If NODE-TYPE is nil, return the smallest syntax node at point."
+  (let* ((root (ts-root-node tree-sitter-tree))
+         (p (point))
+         (node (ts-get-descendant-for-position-range root p p)))
+    (if node-type
+        (let ((this node) result)
+          (while this
+            (if (equal node-type (ts-node-type this))
+                (setq result this
+                      this nil)
+              (setq this (ts-get-parent this))))
+          result)
+      node)))
 
 (provide 'tree-sitter)
 ;;; tree-sitter.el ends here

src/cursor.rs

@@ -4,12 +4,13 @@ use std::{
     ops::{Deref, DerefMut},
 };
 
-use emacs::{defun, Result, Value};
+use emacs::{defun, Result, Value, GlobalRef};
 use tree_sitter::{Tree, TreeCursor};
 
 use crate::{
     types::{self, Shared, Either, BytePos},
     node::RNode,
+    lang::Language,
 };
 
 // -------------------------------------------------------------------------------------------------
@@ -124,11 +125,13 @@ fn current_field_id(cursor: &RCursor) -> Result<Option<u16>> {
     Ok(cursor.borrow().field_id())
 }
 
-/// Return the field name of CURSOR's current node.
-/// Return nil if the current node doesn't have a field.
+/// Return the field associated with CURSOR's current node, as a keyword.
+/// Return nil if the current node is not associated with a field.
 #[defun]
-fn current_field_name(cursor: &RCursor) -> Result<Option<&'static str>> {
-    Ok(cursor.borrow().field_name())
+fn current_field(cursor: &RCursor) -> Result<Option<&'static GlobalRef>> {
+    let cursor = cursor.borrow();
+    let language: Language = cursor.reft.language().into();
+    Ok(cursor.field_id().and_then(|id| language.info().field_name(id)))
 }
 
 macro_rules! defun_cursor_walks {