emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/android a1c5461edab 2/6: Merge remote-tracking branch 'origin/ma


From: Po Lu
Subject: feature/android a1c5461edab 2/6: Merge remote-tracking branch 'origin/master' into feature/android
Date: Mon, 27 Mar 2023 04:45:37 -0400 (EDT)

branch: feature/android
commit a1c5461edabb8b4c336a708c84aa65e28b2695b0
Merge: c0873f2382f a27b0f7f307
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Merge remote-tracking branch 'origin/master' into feature/android
---
 doc/lispref/parsing.texi               |   3 +-
 etc/NEWS                               |  12 ++
 lisp/emacs-lisp/byte-opt.el            |   4 +-
 lisp/emacs-lisp/eldoc.el               |  26 ++-
 lisp/gnus/nnselect.el                  |   4 +-
 lisp/progmodes/eglot.el                |   5 +-
 src/treesit.c                          | 367 ++++++++++++++++++++-------------
 test/infra/Dockerfile.emba             |  12 +-
 test/lisp/emacs-lisp/shortdoc-tests.el |  30 ++-
 test/lisp/net/tramp-tests.el           |  38 +++-
 10 files changed, 334 insertions(+), 167 deletions(-)

diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi
index cba323d3a56..86a5d9f2e52 100644
--- a/doc/lispref/parsing.texi
+++ b/doc/lispref/parsing.texi
@@ -1311,7 +1311,8 @@ matches regular expression @var{regexp}.  Matching is 
case-sensitive.
 
 @deffn Predicate pred fn &rest nodes
 Matches if function @var{fn} returns non-@code{nil} when passed each
-node in @var{nodes} as arguments.
+node in @var{nodes} as arguments.  The function runs with the current
+buffer set to the buffer of node being queried.
 @end deffn
 
 Note that a predicate can only refer to capture names that appear in
diff --git a/etc/NEWS b/etc/NEWS
index 461cb9f2402..6865b373784 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -296,6 +296,18 @@ their customization options.
 
 * Incompatible Lisp Changes in Emacs 30.1
 
+---
+** The escape sequence '\x' not followed by hex digits is now an error.
+Previously, '\x' without at least one hex digit denoted character code
+zero (NUL) but as this was neither intended nor documented or even
+known by anyone, it is now treated as an error by the Lisp reader.
+
+---
+** Connection-local variables are applied in buffers visiting a remote file.
+This overrides possible directory-local or file-local variables with
+the same name.
+
+---
 ** User option 'tramp-completion-reread-directory-timeout' has been removed.
 This user option has been obsoleted in Emacs 27, use
 'remote-file-name-inhibit-cache' instead.
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 3c7aeb89525..0891ec80beb 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -2765,7 +2765,9 @@ If FOR-EFFECT is non-nil, the return value is assumed to 
be of no importance."
                       (or (memq (caar tmp) '(byte-discard byte-discardN))
                           ;; Make sure we don't hoist a discardN-preserve-tos
                           ;; that really should be merged or deleted instead.
-                          (and (eq (caar tmp) 'byte-discardN-preserve-tos)
+                          (and (or (eq (caar tmp) 'byte-discardN-preserve-tos)
+                                   (and (eq (caar tmp) 'byte-stack-set)
+                                        (eql (cdar tmp) 1)))
                                (let ((next (cadr tmp)))
                                  (not (or (memq (car next)
                                                 '(byte-discardN-preserve-tos
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 2108e189fbd..ef4cda4650f 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -454,9 +454,10 @@ documentation-displaying frontends.  For example, KEY can 
be:
   documentation buffer accordingly.
 
 * `:echo', controlling how `eldoc-display-in-echo-area' should
-  present this documentation item, to save space.  If VALUE is
-  `skip' don't echo DOCSTRING.  If a number, only echo DOCSTRING
-  up to that character position.
+  present this documentation item in the echo area, to save
+  space.  If VALUE is a string, echo it instead of DOCSTRING.  If
+  a number, only echo DOCSTRING up to that character position.
+  If `skip', don't echo DOCSTRING at all.
 
 Finally, major modes should modify this hook locally, for
 example:
@@ -498,6 +499,10 @@ If INTERACTIVE, display it.  Else, return said buffer."
            (display-buffer (current-buffer)))
           (t (current-buffer)))))
 
+(defvar eldoc-doc-buffer-separator
+  (concat "\n" (propertize "\n" 'face '(:inherit separator-line :extend t)) 
"\n")
+  "String used to separate items in Eldoc documentation buffer.")
+
 (defun eldoc--format-doc-buffer (docs)
   "Ensure DOCS are displayed in an *eldoc* buffer."
   (with-current-buffer (if (buffer-live-p eldoc--doc-buffer)
@@ -521,7 +526,8 @@ If INTERACTIVE, display it.  Else, return said buffer."
                       ": "
                       this-doc))
                do (insert this-doc)
-               when rest do (insert "\n")
+               when rest do
+               (insert eldoc-doc-buffer-separator)
                finally (goto-char (point-min)))
       ;; Rename the buffer, taking into account whether it was
       ;; hidden or not
@@ -544,7 +550,10 @@ Helper for `eldoc-display-in-echo-area'."
            for echo = (plist-get plist :echo)
            for thing = (plist-get plist :thing)
            unless (eq echo 'skip) do
-           (when echo (setq this-doc (substring this-doc 0 echo)))
+           (setq this-doc
+                 (cond ((integerp echo) (substring this-doc 0 echo))
+                       ((stringp echo) echo)
+                       (t this-doc)))
            (when thing (setq this-doc
                              (concat
                               (propertize (format "%s" thing)
@@ -911,8 +920,11 @@ the docstrings eventually produced, using
       (let* ((eldoc--make-callback #'make-callback)
              (res (funcall eldoc-documentation-strategy)))
         ;; Observe the old and the new protocol:
-        (cond (;; Old protocol: got string, output immediately;
-               (stringp res) (register-doc 0 res nil) (display-doc))
+        (cond (;; Old protocol: got string, e-d-strategy is iself the
+               ;; origin function, and we output immediately;
+               (stringp res)
+               (register-doc 0 res nil eldoc-documentation-strategy)
+               (display-doc))
               (;; Old protocol: got nil, clear the echo area;
                (null res) (eldoc--message nil))
               (;; New protocol: trust callback will be called;
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 87cb1275313..66577282a0f 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -64,6 +64,7 @@
 
 (defvar gnus-inhibit-demon)
 (defvar gnus-message-group-art)
+(defvar gnus-search-use-parsed-queries)
 
 ;; For future use
 (defvoo nnselect-directory gnus-directory
@@ -677,7 +678,8 @@ artlist; otherwise store the ARTLIST in the group 
parameters."
          ;; If so we perform the query, massage the result, and return
          ;; the new headers back to the caller to incorporate into the
          ;; current summary buffer.
-         (let* ((group-spec
+         (let* ((gnus-search-use-parsed-queries t)
+                 (group-spec
                  (list (delq nil (list
                                   (or server (gnus-group-server artgroup))
                                   (unless gnus-refer-thread-use-search
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 806e498c38c..cc9c8115b08 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -222,7 +222,10 @@ chosen (interactively or automatically)."
                                 (dart-mode . ("dart" "language-server"
                                               "--client-id" 
"emacs.eglot-dart"))
                                 ((elixir-mode elixir-ts-mode heex-ts-mode)
-                                 . ("language_server.sh"))
+                                 . ,(if (and (fboundp 'w32-shell-dos-semantics)
+                                             (w32-shell-dos-semantics))
+                                        '("language_server.bat")
+                                      '("language_server.sh")))
                                 (ada-mode . ("ada_language_server"))
                                 (scala-mode . ,(eglot-alternatives
                                                 '("metals" "metals-emacs")))
diff --git a/src/treesit.c b/src/treesit.c
index 5a4fe3e8803..36a297ec7da 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -2407,87 +2407,111 @@ treesit_predicates_for_pattern (TSQuery *query, 
uint32_t pattern_index)
   return Fnreverse (result);
 }
 
-/* Translate a capture NAME (symbol) to a node.
-   Signals treesit-query-error if such node is not captured.  */
-static Lisp_Object
+/* Translate a capture NAME (symbol) to a node.  If everything goes
+   fine, set NODE and return true; if error occurs (e.g., when there
+   is no node for the capture name), set NODE to Qnil, SIGNAL_DATA to
+   a suitable signal data, and return false.  */
+static bool
 treesit_predicate_capture_name_to_node (Lisp_Object name,
-                                       struct capture_range captures)
+                                       struct capture_range captures,
+                                       Lisp_Object *node,
+                                       Lisp_Object *signal_data)
 {
-  Lisp_Object node = Qnil;
+  *node = Qnil;
   for (Lisp_Object tail = captures.start; !EQ (tail, captures.end);
        tail = XCDR (tail))
     {
       if (EQ (XCAR (XCAR (tail)), name))
        {
-         node = XCDR (XCAR (tail));
+         *node = XCDR (XCAR (tail));
          break;
        }
     }
 
-  if (NILP (node))
-    xsignal3 (Qtreesit_query_error,
-             build_string ("Cannot find captured node"),
-             name, build_string ("A predicate can only refer"
-                                 " to captured nodes in the "
-                                 "same pattern"));
-  return node;
+  if (NILP (*node))
+    {
+      *signal_data = list3 (build_string ("Cannot find captured node"),
+                           name, build_string ("A predicate can only refer"
+                                               " to captured nodes in the "
+                                               "same pattern"));
+      return false;
+    }
+  return true;
 }
 
 /* Translate a capture NAME (symbol) to the text of the captured node.
-   Signals treesit-query-error if such node is not captured.  */
-static Lisp_Object
+   If everything goes fine, set TEXT to the text and return true;
+   otherwise set TEXT to Qnil and set SIGNAL_DATA to a suitable signal
+   data.  */
+static bool
 treesit_predicate_capture_name_to_text (Lisp_Object name,
-                                       struct capture_range captures)
+                                       struct capture_range captures,
+                                       Lisp_Object *text,
+                                       Lisp_Object *signal_data)
 {
-  Lisp_Object node = treesit_predicate_capture_name_to_node (name, captures);
+  Lisp_Object node = Qnil;
+  if (!treesit_predicate_capture_name_to_node (name, captures, &node, 
signal_data))
+    return false;
 
   struct buffer *old_buffer = current_buffer;
   set_buffer_internal (XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer));
-  Lisp_Object text = Fbuffer_substring (Ftreesit_node_start (node),
-                                       Ftreesit_node_end (node));
+  *text = Fbuffer_substring (Ftreesit_node_start (node),
+                            Ftreesit_node_end (node));
   set_buffer_internal (old_buffer);
-  return text;
+  return true;
 }
 
 /* Handles predicate (#equal A B).  Return true if A equals B; return
    false otherwise.  A and B can be either string, or a capture name.
    The capture name evaluates to the text its captured node spans in
-   the buffer.  */
+   the buffer.  If everything goes fine, don't touch SIGNAL_DATA; if
+   error occurs, set it to a suitable signal data.  */
 static bool
-treesit_predicate_equal (Lisp_Object args, struct capture_range captures)
+treesit_predicate_equal (Lisp_Object args, struct capture_range captures,
+                        Lisp_Object *signal_data)
 {
   if (XFIXNUM (Flength (args)) != 2)
-    xsignal2 (Qtreesit_query_error,
-             build_string ("Predicate `equal' requires "
-                           "two arguments but only given"),
-             Flength (args));
-
+    {
+      *signal_data = list2 (build_string ("Predicate `equal' requires "
+                                         "two arguments but only given"),
+                           Flength (args));
+      return false;
+    }
   Lisp_Object arg1 = XCAR (args);
   Lisp_Object arg2 = XCAR (XCDR (args));
-  Lisp_Object text1 = (STRINGP (arg1)
-                      ? arg1
-                      : treesit_predicate_capture_name_to_text (arg1,
-                                                                captures));
-  Lisp_Object text2 = (STRINGP (arg2)
-                      ? arg2
-                      : treesit_predicate_capture_name_to_text (arg2,
-                                                                captures));
+  Lisp_Object text1 = arg1;
+  Lisp_Object text2 = arg2;
+  if (SYMBOLP (arg1))
+    {
+      if (!treesit_predicate_capture_name_to_text (arg1, captures, &text1,
+                                                  signal_data))
+       return false;
+    }
+  if (SYMBOLP (arg2))
+    {
+      if (!treesit_predicate_capture_name_to_text (arg2, captures, &text2,
+                                                  signal_data))
+       return false;
+    }
 
   return !NILP (Fstring_equal (text1, text2));
 }
 
 /* Handles predicate (#match "regexp" @node).  Return true if "regexp"
-   matches the text spanned by @node; return false otherwise.  Matching
-   is case-sensitive.  */
+   matches the text spanned by @node; return false otherwise.
+   Matching is case-sensitive.  If everything goes fine, don't touch
+   SIGNAL_DATA; if error occurs, set it to a suitable signal data.  */
 static bool
-treesit_predicate_match (Lisp_Object args, struct capture_range captures)
+treesit_predicate_match (Lisp_Object args, struct capture_range captures,
+                        Lisp_Object *signal_data)
 {
   if (XFIXNUM (Flength (args)) != 2)
-    xsignal2 (Qtreesit_query_error,
-             build_string ("Predicate `match' requires two "
-                           "arguments but only given"),
-             Flength (args));
-
+    {
+      *signal_data = list2 (build_string ("Predicate `match' requires two "
+                                         "arguments but only given"),
+                           Flength (args));
+      return false;
+    }
   Lisp_Object regexp = XCAR (args);
   Lisp_Object capture_name = XCAR (XCDR (args));
 
@@ -2504,12 +2528,10 @@ treesit_predicate_match (Lisp_Object args, struct 
capture_range captures)
              build_string ("The second argument to `match' should "
                            "be a capture name, not a string"));
 
-  Lisp_Object node = treesit_predicate_capture_name_to_node (capture_name,
-                                                            captures);
-
-  struct buffer *old_buffer = current_buffer;
-  struct buffer *buffer = XBUFFER (XTS_PARSER (XTS_NODE 
(node)->parser)->buffer);
-  set_buffer_internal (buffer);
+  Lisp_Object node = Qnil;
+  if (!treesit_predicate_capture_name_to_node (capture_name, captures, &node,
+                                              signal_data))
+    return false;
 
   TSNode treesit_node = XTS_NODE (node)->node;
   ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg;
@@ -2537,61 +2559,71 @@ treesit_predicate_match (Lisp_Object args, struct 
capture_range captures)
   ZV = old_zv;
   ZV_BYTE = old_zv_byte;
 
-  set_buffer_internal (old_buffer);
-
   return (val > 0);
 }
 
 /* Handles predicate (#pred FN ARG...).  Return true if FN returns
    non-nil; return false otherwise.  The arity of FN must match the
-   number of ARGs  */
+   number of ARGs.  If everything goes fine, don't touch SIGNAL_DATA;
+   if error occurs, set it to a suitable signal data.  */
 static bool
-treesit_predicate_pred (Lisp_Object args, struct capture_range captures)
+treesit_predicate_pred (Lisp_Object args, struct capture_range captures,
+                       Lisp_Object *signal_data)
 {
   if (XFIXNUM (Flength (args)) < 2)
-    xsignal2 (Qtreesit_query_error,
-             build_string ("Predicate `pred' requires "
-                           "at least two arguments, "
-                           "but was only given"),
-             Flength (args));
+    {
+      *signal_data = list2 (build_string ("Predicate `pred' requires "
+                                         "at least two arguments, "
+                                         "but was only given"),
+                           Flength (args));
+      return false;
+    }
 
   Lisp_Object fn = Fintern (XCAR (args), Qnil);
   Lisp_Object nodes = Qnil;
   Lisp_Object tail = XCDR (args);
   FOR_EACH_TAIL (tail)
-    nodes = Fcons (treesit_predicate_capture_name_to_node (XCAR (tail),
-                                                          captures),
-                  nodes);
+  {
+    Lisp_Object node = Qnil;
+    if (!treesit_predicate_capture_name_to_node (XCAR (tail), captures, &node,
+                                                signal_data))
+      return false;
+    nodes = Fcons (node, nodes);
+  }
   nodes = Fnreverse (nodes);
 
   return !NILP (CALLN (Fapply, fn, nodes));
 }
 
 /* If all predicates in PREDICATES passes, return true; otherwise
-   return false.  */
+   return false.  If everything goes fine, don't touch SIGNAL_DATA; if
+   error occurs, set it to a suitable signal data.  */
 static bool
-treesit_eval_predicates (struct capture_range captures, Lisp_Object predicates)
+treesit_eval_predicates (struct capture_range captures, Lisp_Object predicates,
+                        Lisp_Object *signal_data)
 {
   bool pass = true;
   /* Evaluate each predicates.  */
   for (Lisp_Object tail = predicates;
-       !NILP (tail); tail = XCDR (tail))
+       pass && !NILP (tail); tail = XCDR (tail))
     {
       Lisp_Object predicate = XCAR (tail);
       Lisp_Object fn = XCAR (predicate);
       Lisp_Object args = XCDR (predicate);
       if (!NILP (Fstring_equal (fn, Vtreesit_str_equal)))
-       pass &= treesit_predicate_equal (args, captures);
+       pass &= treesit_predicate_equal (args, captures, signal_data);
       else if (!NILP (Fstring_equal (fn, Vtreesit_str_match)))
-       pass &= treesit_predicate_match (args, captures);
+       pass &= treesit_predicate_match (args, captures, signal_data);
       else if (!NILP (Fstring_equal (fn, Vtreesit_str_pred)))
-       pass &= treesit_predicate_pred (args, captures);
+       pass &= treesit_predicate_pred (args, captures, signal_data);
       else
-       xsignal3 (Qtreesit_query_error,
-                 build_string ("Invalid predicate"),
-                 fn, build_string ("Currently Emacs only supports"
-                                   " equal, match, and pred"
-                                   " predicate"));
+       {
+         *signal_data = list3 (build_string ("Invalid predicate"),
+                               fn, build_string ("Currently Emacs only 
supports"
+                                                 " equal, match, and pred"
+                                                 " predicates"));
+         pass = false;
+       }
     }
   /* If all predicates passed, add captures to result list.  */
   return pass;
@@ -2631,8 +2663,8 @@ You can use `treesit-query-validate' to validate and 
debug a query.  */)
       Lisp_Object signal_symbol = Qnil;
       Lisp_Object signal_data = Qnil;
       TSQuery *treesit_query = treesit_ensure_query_compiled (lisp_query,
-                                                        &signal_symbol,
-                                                        &signal_data);
+                                                             &signal_symbol,
+                                                             &signal_data);
 
       if (treesit_query == NULL)
        xsignal (signal_symbol, signal_data);
@@ -2641,6 +2673,92 @@ You can use `treesit-query-validate' to validate and 
debug a query.  */)
     }
 }
 
+/* Resolve OBJ into a tree-sitter node Lisp_Object.  OBJ can be a
+   node, a parser, or a language symbol.  Note that this function can
+   signal.  */
+static Lisp_Object treesit_resolve_node (Lisp_Object obj)
+{
+  if (TS_NODEP (obj))
+    {
+      treesit_check_node (obj); /* Check if up-to-date.  */
+      return obj;
+    }
+  else if (TS_PARSERP (obj))
+    {
+      treesit_check_parser (obj); /* Check if deleted.  */
+      return Ftreesit_parser_root_node (obj);
+    }
+  else if (SYMBOLP (obj))
+    {
+      Lisp_Object parser
+       = Ftreesit_parser_create (obj, Fcurrent_buffer (), Qnil);
+      return Ftreesit_parser_root_node (parser);
+    }
+  else
+    xsignal2 (Qwrong_type_argument,
+             list4 (Qor, Qtreesit_node_p, Qtreesit_parser_p, Qsymbolp),
+             obj);
+}
+
+/* Create and initialize QUERY.  When success, initialize TS_QUERY,
+   CURSOR, and NEED_FREE, and return true; if failed, initialize
+   SIGNAL_SYMBOL and SIGNAL_DATA, and return false.  If NEED_FREE is
+   initialized to true, the TS_QUERY and CURSOR needs to be freed
+   after use; otherwise they shouldn't be freed by hand.
+
+   Basically this function looks at QUERY and check its type, if QUERY
+   is a compiled query, this function takes out its query and cursor;
+   if QUERY is a string or a cons, this function creates a new query
+   and cursor (so they need to be manually freed).
+
+   This function assumes QUERY is either a compiled query, a string or
+   a cons, the caller should make sure QUERY is valid.
+
+   LANG is the language to use if we need to create the query and
+   cursor.  */
+static bool
+treesit_initialize_query (Lisp_Object query, const TSLanguage *lang,
+                         TSQuery **ts_query, TSQueryCursor **cursor,
+                         bool *need_free, Lisp_Object *signal_symbol,
+                         Lisp_Object *signal_data)
+{
+  if (TS_COMPILED_QUERY_P (query))
+    {
+      *ts_query = treesit_ensure_query_compiled (query, signal_symbol,
+                                                signal_data);
+      *cursor = XTS_COMPILED_QUERY (query)->cursor;
+      /* We don't need to free ts_query and cursor because they
+        are stored in a lisp object, which is tracked by gc.  */
+      *need_free = false;
+      return (*ts_query != NULL);
+    }
+  else
+    {
+      /* Since query is not TS_COMPILED_QUERY, it can only be a string
+        or a cons.  */
+      if (CONSP (query))
+       query = Ftreesit_query_expand (query);
+      char *query_string = SSDATA (query);
+      uint32_t error_offset;
+      TSQueryError error_type;
+      *ts_query = ts_query_new (lang, query_string, strlen (query_string),
+                               &error_offset, &error_type);
+      if (*ts_query == NULL)
+       {
+         *signal_symbol = Qtreesit_query_error;
+         *signal_data = treesit_compose_query_signal_data (error_offset,
+                                                           error_type, query);
+         return false;
+       }
+      else
+       {
+         *cursor = ts_query_cursor_new ();
+         *need_free = true;
+         return true;
+       }
+    }
+}
+
 DEFUN ("treesit-query-capture",
        Ftreesit_query_capture,
        Streesit_query_capture, 2, 5, 0,
@@ -2681,35 +2799,12 @@ the query.  */)
   treesit_initialize ();
 
   /* Resolve NODE into an actual node.  */
-  Lisp_Object lisp_node;
-  if (TS_NODEP (node))
-    {
-      treesit_check_node (node); /* Check if up-to-date.  */
-      lisp_node = node;
-    }
-  else if (TS_PARSERP (node))
-    {
-      treesit_check_parser (node); /* Check if deleted.  */
-      lisp_node = Ftreesit_parser_root_node (node);
-    }
-  else if (SYMBOLP (node))
-    {
-      Lisp_Object parser
-       = Ftreesit_parser_create (node, Fcurrent_buffer (), Qnil);
-      lisp_node = Ftreesit_parser_root_node (parser);
-    }
-  else
-    xsignal2 (Qwrong_type_argument,
-             list4 (Qor, Qtreesit_node_p, Qtreesit_parser_p, Qsymbolp),
-             node);
+  Lisp_Object lisp_node = treesit_resolve_node (node);
 
   /* Extract C values from Lisp objects.  */
-  TSNode treesit_node
-    = XTS_NODE (lisp_node)->node;
-  Lisp_Object lisp_parser
-    = XTS_NODE (lisp_node)->parser;
-  ptrdiff_t visible_beg
-    = XTS_PARSER (XTS_NODE (lisp_node)->parser)->visible_beg;
+  TSNode treesit_node = XTS_NODE (lisp_node)->node;
+  Lisp_Object lisp_parser = XTS_NODE (lisp_node)->parser;
+
   const TSLanguage *lang
     = ts_parser_language (XTS_PARSER (lisp_parser)->parser);
 
@@ -2725,44 +2820,21 @@ the query.  */)
   TSQuery *treesit_query;
   TSQueryCursor *cursor;
   bool needs_to_free_query_and_cursor;
-  if (TS_COMPILED_QUERY_P (query))
-    {
-      Lisp_Object signal_symbol = Qnil;
-      Lisp_Object signal_data = Qnil;
-      treesit_query = treesit_ensure_query_compiled (query, &signal_symbol,
-                                                    &signal_data);
-      cursor = XTS_COMPILED_QUERY (query)->cursor;
-      /* We don't need to free ts_query and cursor because they
-        are stored in a lisp object, which is tracked by gc.  */
-      needs_to_free_query_and_cursor = false;
-      if (treesit_query == NULL)
-       xsignal (signal_symbol, signal_data);
-    }
-  else
-    {
-      /* Since query is not TS_COMPILED_QUERY, it can only be a string
-        or a cons.  */
-      if (CONSP (query))
-       query = Ftreesit_query_expand (query);
-      char *query_string = SSDATA (query);
-      uint32_t error_offset;
-      TSQueryError error_type;
-      treesit_query = ts_query_new (lang, query_string, strlen (query_string),
-                                   &error_offset, &error_type);
-      if (treesit_query == NULL)
-       xsignal (Qtreesit_query_error,
-                treesit_compose_query_signal_data (error_offset,
-                                                   error_type, query));
-      cursor = ts_query_cursor_new ();
-      needs_to_free_query_and_cursor = true;
-    }
+  Lisp_Object signal_symbol;
+  Lisp_Object signal_data;
+  if (!treesit_initialize_query (query, lang, &treesit_query, &cursor,
+                                &needs_to_free_query_and_cursor,
+                                &signal_symbol, &signal_data))
+    xsignal (signal_symbol, signal_data);
 
-  /* WARN: After this point, free treesit_query and cursor before every
-     signal and return.  */
+  /* WARN: After this point, free TREESIT_QUERY and CURSOR before every
+     signal and return if NEEDS_TO_FREE_QUERY_AND_CURSOR is true.  */
 
   /* Set query range.  */
   if (!NILP (beg) && !NILP (end))
     {
+      ptrdiff_t visible_beg
+       = XTS_PARSER (XTS_NODE (lisp_node)->parser)->visible_beg;
       ptrdiff_t beg_byte = CHAR_TO_BYTE (XFIXNUM (beg));
       ptrdiff_t end_byte = CHAR_TO_BYTE (XFIXNUM (end));
       /* We never let tree-sitter run on buffers too large, so these
@@ -2791,11 +2863,16 @@ the query.  */)
   Lisp_Object result = Qnil;
   Lisp_Object prev_result = result;
   Lisp_Object predicates_table = make_vector (patterns_count, Qt);
+  Lisp_Object predicate_signal_data = Qnil;
+
+  struct buffer *old_buf = current_buffer;
+  set_buffer_internal (buf);
+
   while (ts_query_cursor_next_match (cursor, &match))
     {
       /* Record the checkpoint that we may roll back to.  */
       prev_result = result;
-      /* Get captured nodes.  */
+      /* 1. Get captured nodes.  */
       const TSQueryCapture *captures = match.captures;
       for (int idx = 0; idx < match.capture_count; idx++)
        {
@@ -2818,7 +2895,8 @@ the query.  */)
 
          result = Fcons (cap, result);
        }
-      /* Get predicates.  */
+      /* 2. Get predicates and check whether this match can be
+         included in the result list.  */
       Lisp_Object predicates = AREF (predicates_table, match.pattern_index);
       if (EQ (predicates, Qt))
        {
@@ -2829,15 +2907,28 @@ the query.  */)
 
       /* captures_lisp = Fnreverse (captures_lisp); */
       struct capture_range captures_range = { result, prev_result };
-      if (!treesit_eval_predicates (captures_range, predicates))
-       /* Predicates didn't pass, roll back.  */
+      bool match = treesit_eval_predicates (captures_range, predicates,
+                                           &predicate_signal_data);
+      if (!NILP (predicate_signal_data))
+       break;
+
+      /* Predicates didn't pass, roll back.  */
+      if (!match)
        result = prev_result;
     }
+
+  /* Final clean up.  */
   if (needs_to_free_query_and_cursor)
     {
       ts_query_delete (treesit_query);
       ts_query_cursor_delete (cursor);
     }
+  set_buffer_internal (old_buf);
+
+  /* Some capture predicate signaled an error.  */
+  if (!NILP (predicate_signal_data))
+    xsignal (Qtreesit_query_error, predicate_signal_data);
+
   return Fnreverse (result);
 }
 
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba
index 5b14384ceb3..520fcb7e15e 100644
--- a/test/infra/Dockerfile.emba
+++ b/test/infra/Dockerfile.emba
@@ -64,11 +64,17 @@ FROM emacs-base as emacs-eglot
 
 RUN apt-get update && \
     apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
-      wget \
+      snapd wget \
     && rm -rf /var/lib/apt/lists/*
 
-# We install a recent clangd for Eglot tests.
-RUN bash -c "$(wget -O - https://apt.llvm.org/llvm.sh)"
+# A recent clangd.  It must be at least clangd 14, which is in Debian
+# bookworm.
+RUN bash -c "$(wget --no-check-certificate -O - https://apt.llvm.org/llvm.sh)"
+
+# A recent pylsp.  Since Debian bookworm there is the package
+# python3-pylsp.
+RUN snap install core
+RUN snap install pylsp
 
 COPY . /checkout
 WORKDIR /checkout
diff --git a/test/lisp/emacs-lisp/shortdoc-tests.el 
b/test/lisp/emacs-lisp/shortdoc-tests.el
index d2dfbc66864..596b47d2543 100644
--- a/test/lisp/emacs-lisp/shortdoc-tests.el
+++ b/test/lisp/emacs-lisp/shortdoc-tests.el
@@ -65,30 +65,48 @@
         (when buf
           (kill-buffer buf))))))
 
+(defun shortdoc-tests--to-ascii (x)
+  "Translate Unicode arrows to ASCII for making the test work everywhere."
+  (cond ((consp x)
+         (cons (shortdoc-tests--to-ascii (car x))
+               (shortdoc-tests--to-ascii (cdr x))))
+        ((stringp x)
+         (thread-last x
+                      (string-replace "⇒" "=>")
+                      (string-replace "→" "->")))
+        (t x)))
+
 (ert-deftest shortdoc-function-examples-test ()
   "Test the extraction of usage examples of some Elisp functions."
   (should (equal '((list . "(delete 2 (list 1 2 3 4))\n    => (1 3 4)\n  
(delete \"a\" (list \"a\" \"b\" \"c\" \"d\"))\n    => (\"b\" \"c\" \"d\")"))
-                 (shortdoc-function-examples 'delete)))
+                 (shortdoc-tests--to-ascii
+                  (shortdoc-function-examples 'delete))))
   (should (equal '((alist . "(assq 'foo '((foo . bar) (zot . baz)))\n    => 
(foo . bar)")
                   (list . "(assq 'b '((a . 1) (b . 2)))\n    => (b . 2)"))
-                 (shortdoc-function-examples 'assq)))
+                 (shortdoc-tests--to-ascii
+                  (shortdoc-function-examples 'assq))))
   (should (equal '((regexp . "(string-match-p \"^[fo]+\" \"foobar\")\n    => 
0"))
-                 (shortdoc-function-examples 'string-match-p))))
+                 (shortdoc-tests--to-ascii
+                  (shortdoc-function-examples 'string-match-p)))))
 
 (ert-deftest shortdoc-help-fns-examples-function-test ()
   "Test that `shortdoc-help-fns-examples-function' correctly prints ELisp 
function examples."
   (with-temp-buffer
     (shortdoc-help-fns-examples-function 'string-fill)
     (should (equal "\n  Examples:\n\n  (string-fill \"Three short words\" 
12)\n    => \"Three short\\nwords\"\n  (string-fill \"Long-word\" 3)\n    => 
\"Long-word\"\n\n"
-                   (buffer-substring-no-properties (point-min) (point-max))))
+                   (shortdoc-tests--to-ascii
+                    (buffer-substring-no-properties (point-min) (point-max)))))
     (erase-buffer)
     (shortdoc-help-fns-examples-function 'assq)
     (should (equal "\n  Examples:\n\n  (assq 'foo '((foo . bar) (zot . 
baz)))\n    => (foo . bar)\n\n  (assq 'b '((a . 1) (b . 2)))\n    => (b . 
2)\n\n"
-                   (buffer-substring-no-properties (point-min) (point-max))))
+                   (shortdoc-tests--to-ascii
+                    (buffer-substring-no-properties (point-min) (point-max)))))
     (erase-buffer)
     (shortdoc-help-fns-examples-function 'string-trim)
     (should (equal "\n  Example:\n\n  (string-trim \" foo \")\n    => 
\"foo\"\n\n"
-                   (buffer-substring-no-properties (point-min) (point-max))))))
+                   (shortdoc-tests--to-ascii
+                    (buffer-substring-no-properties (point-min)
+                                                    (point-max)))))))
 
 (provide 'shortdoc-tests)
 
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 677dd35d796..835763e0237 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -6005,22 +6005,42 @@ INPUT, if non-nil, is a string sent to the process."
            (should (eq local-variable 'connect))
            (kill-buffer (current-buffer)))
 
-         ;; `local-variable' is dir-local due to existence of .dir-locals.el.
+         ;; `local-variable' is still connection-local due to Tramp.
+         ;; `find-file-hook' overrides dir-local settings.
          (write-region
           "((nil . ((local-variable . dir))))" nil
           (expand-file-name ".dir-locals.el" tmp-name1))
          (should (file-exists-p (expand-file-name ".dir-locals.el" tmp-name1)))
-         (with-current-buffer (find-file-noselect tmp-name2)
-           (should (eq local-variable 'dir))
-           (kill-buffer (current-buffer)))
-
-         ;; `local-variable' is file-local due to specifying as file variable.
+         (when (memq #'tramp-set-connection-local-variables-for-buffer
+                     find-file-hook)
+           (with-current-buffer (find-file-noselect tmp-name2)
+             (should (eq local-variable 'connect))
+             (kill-buffer (current-buffer))))
+         ;; `local-variable' is dir-local due to existence of .dir-locals.el.
+         (let ((find-file-hook
+                (remq #'tramp-set-connection-local-variables-for-buffer
+                      find-file-hook)))
+           (with-current-buffer (find-file-noselect tmp-name2)
+             (should (eq local-variable 'dir))
+             (kill-buffer (current-buffer))))
+
+         ;; `local-variable' is still connection-local due to Tramp.
+         ;; `find-file-hook' overrides dir-local settings.
          (write-region
           "-*- mode: comint; local-variable: file; -*-" nil tmp-name2)
           (should (file-exists-p tmp-name2))
-         (with-current-buffer (find-file-noselect tmp-name2)
-           (should (eq local-variable 'file))
-           (kill-buffer (current-buffer))))
+         (when (memq #'tramp-set-connection-local-variables-for-buffer
+                     find-file-hook)
+           (with-current-buffer (find-file-noselect tmp-name2)
+             (should (eq local-variable 'connect))
+             (kill-buffer (current-buffer))))
+         ;; `local-variable' is file-local due to specifying as file variable.
+         (let ((find-file-hook
+                (remq #'tramp-set-connection-local-variables-for-buffer
+                      find-file-hook)))
+           (with-current-buffer (find-file-noselect tmp-name2)
+             (should (eq local-variable 'file))
+             (kill-buffer (current-buffer)))))
 
       ;; Cleanup.
       (custom-set-variables



reply via email to

[Prev in Thread] Current Thread [Next in Thread]