feature/tree-sitter dd65d1c396 25/26: Consolidate treesit parser create functions

[Yuan Fu]

branch: feature/tree-sitter
commit dd65d1c396da2e024468196c4d5bcb72198f524a
Author: Yuan Fu <yuan@debian-BULLSEYE-live-builder-AMD64>
Commit: Yuan Fu <yuan@debian-BULLSEYE-live-builder-AMD64>

    Consolidate treesit parser create functions
    
    Merge treesit-parser-create, treesit-get-parser,
    treesit-get-parser-create into one: treesit-parser-create.
    
    * src/treesit.c (Ftreesit_parser_language): make BUFFER parameter
    optional, add new parameter NO-REUSE.  Optionally reuse parser.
    * test/src/treesit-tests.el: Change all parser creation to use
    treesit-parser-create.  Remove tests for the removed functions.
    * lisp/treesit.el (treesit-get-parser, treesit-get-parser-create):
    Remove.
    * lisp/treesit.el (treesit-set-ranges, treesit-get-ranges)
    (treesit-buffer-root-node, treesit-query-string)
    (treesit-font-lock-fontify-region, treesit-search-forward)
    (treesit-query-validate): Change to use treesit-parser-create.
---
 lisp/treesit.el           | 30 ++++++++----------------------
 src/treesit.c             | 37 ++++++++++++++++++++++++++-----------
 test/src/treesit-tests.el | 37 ++++++++++---------------------------
 3 files changed, 44 insertions(+), 60 deletions(-)

diff --git a/lisp/treesit.el b/lisp/treesit.el
index 100ca23316..5b65e00e07 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -65,27 +65,13 @@ available on the system at all."
 
 ;;; Parser API supplement
 
-(defun treesit-get-parser (language)
-  "Find the first parser using LANGUAGE in `treesit-parser-list'."
-  (catch 'found
-    (dolist (parser treesit-parser-list)
-      (when (eq language (treesit-parser-language parser))
-        (throw 'found parser)))))
-
-(defun treesit-get-parser-create (language)
-  "Find the first parser using LANGUAGE in `treesit-parser-list'.
-If none exists, create one and return it."
-  (or (treesit-get-parser language)
-      (treesit-parser-create
-       (current-buffer) language)))
-
 (defun treesit-parse-string (string language)
   "Parse STRING using a parser for LANGUAGE.
 Return the root node of the syntax tree."
   (with-temp-buffer
     (insert string)
     (treesit-parser-root-node
-     (treesit-parser-create (current-buffer) language))))
+     (treesit-parser-create language))))
 
 (defun treesit-language-at (point)
   "Return the language used at POINT."
@@ -97,7 +83,7 @@ Return the root node of the syntax tree."
   "Set the ranges of PARSER-OR-LANG to RANGES."
   (treesit-parser-set-included-ranges
    (cond ((symbolp parser-or-lang)
-          (or (treesit-get-parser parser-or-lang)
+          (or (treesit-parser-create parser-or-lang)
               (error "Cannot find a parser for %s" parser-or-lang)))
          ((treesit-parser-p parser-or-lang)
           parser-or-lang)
@@ -109,7 +95,7 @@ Return the root node of the syntax tree."
   "Get the ranges of PARSER-OR-LANG."
   (treesit-parser-included-ranges
    (cond ((symbolp parser-or-lang)
-          (or (treesit-get-parser parser-or-lang)
+          (or (treesit-parser-create parser-or-lang)
               (error "Cannot find a parser for %s" parser-or-lang)))
          ((treesit-parser-p parser-or-lang)
           parser-or-lang)
@@ -178,7 +164,7 @@ Use the first parser in `treesit-parser-list', if LANGUAGE 
is
 non-nil, use the first parser for LANGUAGE."
   (if-let ((parser
             (or (if language
-                    (or (treesit-get-parser language)
+                    (or (treesit-parser-create language)
                         (error "Cannot find a parser for %s" language))
                   (or (car treesit-parser-list)
                       (error "Buffer has no parser"))))))
@@ -410,7 +396,7 @@ Raise an treesit-query-error if QUERY is malformed."
 See `treesit-query-capture' for QUERY."
   (with-temp-buffer
     (insert string)
-    (let ((parser (treesit-parser-create (current-buffer) language)))
+    (let ((parser (treesit-parser-create language)))
       (treesit-query-capture
        (treesit-parser-root-node parser)
        query))))
@@ -520,7 +506,7 @@ If LOUDLY is non-nil, message some debugging information."
   (dolist (setting treesit-font-lock-settings)
     (when-let* ((language (nth 0 setting))
                 (match-pattern (nth 1 setting))
-                (parser (treesit-get-parser-create language)))
+                (parser (treesit-parser-create language)))
       (when-let ((node (treesit-node-on start end parser)))
         (let ((captures (treesit-query-capture
                          node match-pattern
@@ -888,7 +874,7 @@ parent in the tree, never go down into children when 
traversing
 the tree."
   (cl-loop for idx from 1 to (abs arg)
            for parser = (if lang
-                            (treesit-get-parser-create lang)
+                            (treesit-parser-create lang)
                           (car treesit-parser-list))
            for node =
            (if-let ((starting-point (point))
@@ -1088,7 +1074,7 @@ to the offending pattern and highlight the pattern."
   (cl-assert (or (consp query) (stringp query)))
   (let ((buf (get-buffer-create "*tree-sitter check query*")))
     (with-temp-buffer
-      (treesit-get-parser-create language)
+      (treesit-parser-create language)
       (condition-case err
           (progn (treesit-query-in language query)
                  (message "QUERY is valid"))
diff --git a/src/treesit.c b/src/treesit.c
index 5a53b09675..fcb333b8ec 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -692,23 +692,38 @@ DEFUN ("treesit-node-parser",
 
 DEFUN ("treesit-parser-create",
        Ftreesit_parser_create, Streesit_parser_create,
-       2, 2, 0,
+       1, 3, 0,
        doc: /* Create and return a parser in BUFFER for LANGUAGE.
 
-The parser is automatically added to BUFFER's
-`treesit-parser-list'.  LANGUAGE should be the symbol of a
-function provided by a tree-sitter language dynamic module, e.g.,
-'treesit-json.  If BUFFER is nil, use the current buffer.  */)
-  (Lisp_Object buffer, Lisp_Object language)
+The parser is automatically added to BUFFER's `treesit-parser-list'.
+LANGUAGE is a language symbol.  If BUFFER is nil, use the current
+buffer.  If BUFFER already has a parser for LANGUAGE, return that
+parser.  If NO-REUSE is non-nil, always create a new parser.  */)
+  (Lisp_Object language, Lisp_Object buffer, Lisp_Object no_reuse)
 {
-  if (NILP (buffer))
-    buffer = Fcurrent_buffer ();
+  ts_initialize ();
 
-  CHECK_BUFFER (buffer);
   CHECK_SYMBOL (language);
-  ts_check_buffer_size (XBUFFER (buffer));
+  struct buffer *old_buffer = current_buffer;
+  if (!NILP (buffer))
+    {
+      CHECK_BUFFER (buffer);
+      set_buffer_internal (XBUFFER (buffer));
+    }
+  ts_check_buffer_size (current_buffer);
 
-  ts_initialize ();
+  /* See if we can reuse a parser.  */
+  for (Lisp_Object tail = Fsymbol_value (Qtreesit_parser_list);
+       NILP (no_reuse) && !NILP (tail);
+       tail = XCDR (tail))
+    {
+      struct Lisp_TS_Parser *parser = XTS_PARSER (XCAR (tail));
+      if (EQ (parser->language_symbol, language))
+       {
+         set_buffer_internal (old_buffer);
+         return XCAR (tail);
+       }
+    }
 
   TSParser *parser = ts_parser_new ();
   TSLanguage *lang = ts_load_language (language, true);
diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el
index c6d5f25472..32971fbacb 100644
--- a/test/src/treesit-tests.el
+++ b/test/src/treesit-tests.el
@@ -25,8 +25,7 @@
 (ert-deftest treesit-basic-parsing ()
   "Test basic parsing routines."
   (with-temp-buffer
-    (let ((parser (treesit-parser-create
-                   (current-buffer) 'json)))
+    (let ((parser (treesit-parser-create 'json)))
       (should
        (eq parser (car treesit-parser-list)))
       (should
@@ -55,8 +54,7 @@
     (let (parser root-node doc-node object-node pair-node)
       (progn
         (insert "[1,2,{\"name\": \"Bob\"},3]")
-        (setq parser (treesit-parser-create
-                      (current-buffer) 'json))
+        (setq parser (treesit-parser-create 'json))
         (setq root-node (treesit-parser-root-node
                          parser)))
       ;; `treesit-node-type'.
@@ -129,8 +127,7 @@
     (let (parser root-node pattern doc-node object-node pair-node)
       (progn
         (insert "[1,2,{\"name\": \"Bob\"},3]")
-        (setq parser (treesit-parser-create
-                      (current-buffer) 'json))
+        (setq parser (treesit-parser-create 'json))
         (setq root-node (treesit-parser-root-node
                          parser)))
 
@@ -181,8 +178,7 @@
       (progn
         (insert "xxx[1,{\"name\": \"Bob\"},2,3]xxx")
         (narrow-to-region (+ (point-min) 3) (- (point-max) 3))
-        (setq parser (treesit-parser-create
-                      (current-buffer) 'json))
+        (setq parser (treesit-parser-create 'json))
         (setq root-node (treesit-parser-root-node
                          parser)))
       ;; This test is from the basic test.
@@ -233,8 +229,7 @@
     (let (parser root-node pattern doc-node object-node pair-node)
       (progn
         (insert "[[1],oooxxx[1,2,3],xxx[1,2]]")
-        (setq parser (treesit-parser-create
-                      (current-buffer) 'json))
+        (setq parser (treesit-parser-create 'json))
         (setq root-node (treesit-parser-root-node
                          parser)))
       (should-error
@@ -258,9 +253,9 @@
     (let (html css js html-range css-range js-range)
       (progn
         (insert "<html><script>1</script><style>body {}</style></html>")
-        (setq html (treesit-get-parser-create 'html))
-        (setq css (treesit-get-parser-create 'css))
-        (setq js (treesit-get-parser-create 'javascript)))
+        (setq html (treesit-parser-create 'html))
+        (setq css (treesit-parser-create 'css))
+        (setq js (treesit-parser-create 'javascript)))
       ;; JavaScript.
       (setq js-range
             (treesit-query-range
@@ -287,13 +282,6 @@
 
 (ert-deftest treesit-parser-supplemental ()
   "Supplemental node functions."
-  ;; `treesit-get-parser'.
-  (with-temp-buffer
-    (should (equal (treesit-get-parser 'json) nil)))
-  ;; `treesit-get-parser-create'.
-  (with-temp-buffer
-    (should (not (equal (treesit-get-parser-create 'json)
-                        nil))))
   ;; `treesit-parse-string'.
   (should (equal (treesit-node-string
                   (treesit-parse-string
@@ -304,14 +292,10 @@
     (let (parser root-node doc-node object-node pair-node)
       (progn
         (insert "[1,2,{\"name\": \"Bob\"},3]")
-        (setq parser (treesit-parser-create
-                      (current-buffer) 'json))
+        (setq parser (treesit-parser-create 'json))
         (setq root-node (treesit-parser-root-node
                          parser))
         (setq doc-node (treesit-node-child root-node 0)))
-      ;; `treesit-get-parser'.
-      (should (not (equal (treesit-get-parser 'json)
-                          nil)))
       ;; `treesit-language-at'.
       (should (equal (treesit-language-at (point))
                      'json))
@@ -326,8 +310,7 @@
   (let (parser root-node doc-node array-node)
     (progn
       (insert "[1,2,{\"name\": \"Bob\"},3]")
-      (setq parser (treesit-parser-create
-                    (current-buffer) 'json))
+      (setq parser (treesit-parser-create 'json))
       (setq root-node (treesit-parser-root-node
                        parser))
       (setq doc-node (treesit-node-child root-node 0)))