[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
- feature/android updated (d7457e1ce4e -> 54d79f37ae5), Po Lu, 2023/03/27
- feature/android 54d79f37ae5 6/6: Merge remote-tracking branch 'origin/master' into feature/android, Po Lu, 2023/03/27
- feature/android a1c5461edab 2/6: Merge remote-tracking branch 'origin/master' into feature/android,
Po Lu <=
- feature/android c0873f2382f 1/6: Update Android port, Po Lu, 2023/03/27
- feature/android 67a325243c6 3/6: Refactor sfntfont.c, Po Lu, 2023/03/27
- feature/android dd4924ca90a 5/6: Update Android port, Po Lu, 2023/03/27
- feature/android 18b34e9ca01 4/6: Refactor sfntfont.c, Po Lu, 2023/03/27