diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2022-11-26 15:47:55 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2022-11-26 15:47:55 -0700 |
| commit | 7c41b8b5c40fc7859a0680774b972596950182b5 (patch) | |
| tree | 6ca4855d94b8b9752e682438be3da56073ed5ef3 | |
| parent | 6a12888cade6a88bc29be7e7616f2f8471025dfd (diff) | |
| parent | 14d54212ea46dbd8c950c9852318597e0e47908d (diff) | |
| download | emacs-7c41b8b5c40fc7859a0680774b972596950182b5.tar.gz | |
Merge remote-tracking branch 'origin/master' into athena/unstable
182 files changed, 20545 insertions, 1370 deletions
diff --git a/admin/notes/tree-sitter/build-module/README b/admin/notes/tree-sitter/build-module/README new file mode 100644 index 00000000000..2fcb9778dae --- /dev/null +++ b/admin/notes/tree-sitter/build-module/README @@ -0,0 +1,17 @@ +To build the language definition for a particular language, run + + ./build.sh <language> + +eg, + + ./build.sh html + +The dynamic module will be in /dist directory + +To build all modules at once, run + + ./batch.sh + +This gives you C, JSON, Go, HTML, Javascript, CSS, Python, Typescript +(tsx), C# (csharp), C++ (cpp), Rust. More can be added to batch.sh +unless it's directory structure is not standard.
\ No newline at end of file diff --git a/admin/notes/tree-sitter/build-module/batch.sh b/admin/notes/tree-sitter/build-module/batch.sh new file mode 100755 index 00000000000..deed18978a1 --- /dev/null +++ b/admin/notes/tree-sitter/build-module/batch.sh @@ -0,0 +1,20 @@ +#!/bin/bash + +languages=( + 'c' + 'cpp' + 'css' + 'c-sharp' + 'go' + 'html' + 'javascript' + 'json' + 'python' + 'rust' + 'typescript' +) + +for language in "${languages[@]}" +do + ./build.sh $language +done diff --git a/admin/notes/tree-sitter/build-module/build.sh b/admin/notes/tree-sitter/build-module/build.sh new file mode 100755 index 00000000000..102ab310fa0 --- /dev/null +++ b/admin/notes/tree-sitter/build-module/build.sh @@ -0,0 +1,62 @@ +#!/bin/bash + +lang=$1 + +if [ $(uname) == "Darwin" ] +then + soext="dylib" +else + soext="so" +fi + +echo "Building ${lang}" + +# Retrieve sources. +git clone "https://github.com/tree-sitter/tree-sitter-${lang}.git" \ + --depth 1 --quiet +if [ "${lang}" == "typescript" ] +then + lang="typescript/tsx" +fi +cp tree-sitter-lang.in "tree-sitter-${lang}/src" +cp emacs-module.h "tree-sitter-${lang}/src" +cp "tree-sitter-${lang}/grammar.js" "tree-sitter-${lang}/src" +cd "tree-sitter-${lang}/src" + +if [ "${lang}" == "typescript/tsx" ] +then + lang="tsx" +fi + +# Build. +cc -c -I. parser.c +# Compile scanner.c. +if test -f scanner.c +then + cc -fPIC -c -I. scanner.c +fi +# Compile scanner.cc. +if test -f scanner.cc +then + c++ -fPIC -I. -c scanner.cc +fi +# Link. +if test -f scanner.cc +then + c++ -fPIC -shared *.o -o "libtree-sitter-${lang}.${soext}" +else + cc -fPIC -shared *.o -o "libtree-sitter-${lang}.${soext}" +fi + +# Copy out. + +if [ "${lang}" == "typescript" ] +then + cp "libtree-sitter-${lang}.${soext}" .. + cd .. +fi + +mkdir -p ../../dist +cp "libtree-sitter-${lang}.${soext}" ../../dist +cd ../../ +rm -rf "tree-sitter-${lang}" diff --git a/admin/notes/tree-sitter/html-manual/Accessing-Node.html b/admin/notes/tree-sitter/html-manual/Accessing-Node.html new file mode 100644 index 00000000000..00ac63b8339 --- /dev/null +++ b/admin/notes/tree-sitter/html-manual/Accessing-Node.html @@ -0,0 +1,206 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> +<!-- This is the GNU Emacs Lisp Reference Manual +corresponding to Emacs version 29.0.50. + +Copyright © 1990-1996, 1998-2022 Free Software Foundation, +Inc. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with the +Invariant Sections being "GNU General Public License," with the +Front-Cover Texts being "A GNU Manual," and with the Back-Cover +Texts as in (a) below. A copy of the license is included in the +section entitled "GNU Free Documentation License." + +(a) The FSF's Back-Cover Text is: "You have the freedom to copy and +modify this GNU manual. Buying copies from the FSF supports it in +developing GNU and promoting software freedom." --> +<title>Accessing Node (GNU Emacs Lisp Reference Manual)</title> + +<meta name="description" content="Accessing Node (GNU Emacs Lisp Reference Manual)"> +<meta name="keywords" content="Accessing Node (GNU Emacs Lisp Reference Manual)"> +<meta name="resource-type" content="document"> +<meta name="distribution" content="global"> +<meta name="Generator" content="makeinfo"> +<meta name="viewport" content="width=device-width,initial-scale=1"> + +<link href="index.html" rel="start" title="Top"> +<link href="Index.html" rel="index" title="Index"> +<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> +<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> +<link href="Pattern-Matching.html" rel="next" title="Pattern Matching"> +<link href="Retrieving-Node.html" rel="prev" title="Retrieving Node"> +<style type="text/css"> +<!-- +a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} +a.summary-letter {text-decoration: none} +blockquote.indentedblock {margin-right: 0em} +div.display {margin-left: 3.2em} +div.example {margin-left: 3.2em} +kbd {font-style: oblique} +pre.display {font-family: inherit} +pre.format {font-family: inherit} +pre.menu-comment {font-family: serif} +pre.menu-preformatted {font-family: serif} +span.nolinebreak {white-space: nowrap} +span.roman {font-family: initial; font-weight: normal} +span.sansserif {font-family: sans-serif; font-weight: normal} +span:hover a.copiable-anchor {visibility: visible} +ul.no-bullet {list-style: none} +--> +</style> +<link rel="stylesheet" type="text/css" href="./manual.css"> + + +</head> + +<body lang="en"> +<div class="section" id="Accessing-Node"> +<div class="header"> +<p> +Next: <a href="Pattern-Matching.html" accesskey="n" rel="next">Pattern Matching Tree-sitter Nodes</a>, Previous: <a href="Retrieving-Node.html" accesskey="p" rel="prev">Retrieving Node</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> +<hr> +<span id="Accessing-Node-Information"></span><h3 class="section">37.4 Accessing Node Information</h3> + +<p>Before going further, make sure you have read the basic conventions +about tree-sitter nodes in the previous node. +</p> +<span id="Basic-information"></span><h3 class="heading">Basic information</h3> + +<p>Every node is associated with a parser, and that parser is associated +with a buffer. The following functions let you retrieve them. +</p> +<dl class="def"> +<dt id="index-treesit_002dnode_002dparser"><span class="category">Function: </span><span><strong>treesit-node-parser</strong> <em>node</em><a href='#index-treesit_002dnode_002dparser' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns <var>node</var>’s associated parser. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnode_002dbuffer"><span class="category">Function: </span><span><strong>treesit-node-buffer</strong> <em>node</em><a href='#index-treesit_002dnode_002dbuffer' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns <var>node</var>’s parser’s associated buffer. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnode_002dlanguage"><span class="category">Function: </span><span><strong>treesit-node-language</strong> <em>node</em><a href='#index-treesit_002dnode_002dlanguage' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns <var>node</var>’s parser’s associated language. +</p></dd></dl> + +<p>Each node represents a piece of text in the buffer. Functions below +finds relevant information about that text. +</p> +<dl class="def"> +<dt id="index-treesit_002dnode_002dstart"><span class="category">Function: </span><span><strong>treesit-node-start</strong> <em>node</em><a href='#index-treesit_002dnode_002dstart' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>Return the start position of <var>node</var>. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnode_002dend"><span class="category">Function: </span><span><strong>treesit-node-end</strong> <em>node</em><a href='#index-treesit_002dnode_002dend' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>Return the end position of <var>node</var>. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnode_002dtext"><span class="category">Function: </span><span><strong>treesit-node-text</strong> <em>node &optional object</em><a href='#index-treesit_002dnode_002dtext' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>Returns the buffer text that <var>node</var> represents. (If <var>node</var> is +retrieved from parsing a string, it will be text from that string.) +</p></dd></dl> + +<p>Here are some basic checks on tree-sitter nodes. +</p> +<dl class="def"> +<dt id="index-treesit_002dnode_002dp"><span class="category">Function: </span><span><strong>treesit-node-p</strong> <em>object</em><a href='#index-treesit_002dnode_002dp' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>Checks if <var>object</var> is a tree-sitter syntax node. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnode_002deq"><span class="category">Function: </span><span><strong>treesit-node-eq</strong> <em>node1 node2</em><a href='#index-treesit_002dnode_002deq' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>Checks if <var>node1</var> and <var>node2</var> are the same node in a syntax +tree. +</p></dd></dl> + +<span id="Property-information"></span><h3 class="heading">Property information</h3> + +<p>In general, nodes in a concrete syntax tree fall into two categories: +<em>named nodes</em> and <em>anonymous nodes</em>. Whether a node is named +or anonymous is determined by the language definition +(see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). +</p> +<span id="index-tree_002dsitter-missing-node"></span> +<p>Apart from being named/anonymous, a node can have other properties. A +node can be “missing”: missing nodes are inserted by the parser in +order to recover from certain kinds of syntax errors, i.e., something +should probably be there according to the grammar, but not there. +</p> +<span id="index-tree_002dsitter-extra-node"></span> +<p>A node can be “extra”: extra nodes represent things like comments, +which can appear anywhere in the text. +</p> +<span id="index-tree_002dsitter-node-that-has-changes"></span> +<p>A node “has changes” if the buffer changed since when the node is +retrieved, i.e., outdated. +</p> +<span id="index-tree_002dsitter-node-that-has-error"></span> +<p>A node “has error” if the text it spans contains a syntax error. It +can be the node itself has an error, or one of its +children/grandchildren... has an error. +</p> +<dl class="def"> +<dt id="index-treesit_002dnode_002dcheck"><span class="category">Function: </span><span><strong>treesit-node-check</strong> <em>node property</em><a href='#index-treesit_002dnode_002dcheck' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function checks if <var>node</var> has <var>property</var>. <var>property</var> +can be <code>'named</code>, <code>'missing</code>, <code>'extra</code>, +<code>'has-changes</code>, or <code>'has-error</code>. +</p></dd></dl> + + +<dl class="def"> +<dt id="index-treesit_002dnode_002dtype"><span class="category">Function: </span><span><strong>treesit-node-type</strong> <em>node</em><a href='#index-treesit_002dnode_002dtype' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>Named nodes have “types” (see <a href="Language-Definitions.html#tree_002dsitter-node-type">node type</a>). +For example, a named node can be a <code>string_literal</code> node, where +<code>string_literal</code> is its type. +</p> +<p>This function returns <var>node</var>’s type as a string. +</p></dd></dl> + +<span id="Information-as-a-child-or-parent"></span><h3 class="heading">Information as a child or parent</h3> + +<dl class="def"> +<dt id="index-treesit_002dnode_002dindex"><span class="category">Function: </span><span><strong>treesit-node-index</strong> <em>node &optional named</em><a href='#index-treesit_002dnode_002dindex' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the index of <var>node</var> as a child node of its +parent. If <var>named</var> is non-nil, it only count named nodes +(see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnode_002dfield_002dname"><span class="category">Function: </span><span><strong>treesit-node-field-name</strong> <em>node</em><a href='#index-treesit_002dnode_002dfield_002dname' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>A child of a parent node could have a field name (see <a href="Language-Definitions.html#tree_002dsitter-node-field-name">field name</a>). This function returns the field name +of <var>node</var> as a child of its parent. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnode_002dfield_002dname_002dfor_002dchild"><span class="category">Function: </span><span><strong>treesit-node-field-name-for-child</strong> <em>node n</em><a href='#index-treesit_002dnode_002dfield_002dname_002dfor_002dchild' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the field name of the <var>n</var>’th child of +<var>node</var>. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dchild_002dcount"><span class="category">Function: </span><span><strong>treesit-child-count</strong> <em>node &optional named</em><a href='#index-treesit_002dchild_002dcount' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function finds the number of children of <var>node</var>. If +<var>named</var> is non-nil, it only counts named child (see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). +</p></dd></dl> + +</div> +<hr> +<div class="header"> +<p> +Next: <a href="Pattern-Matching.html">Pattern Matching Tree-sitter Nodes</a>, Previous: <a href="Retrieving-Node.html">Retrieving Node</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> + + + +</body> +</html> diff --git a/admin/notes/tree-sitter/html-manual/Language-Definitions.html b/admin/notes/tree-sitter/html-manual/Language-Definitions.html new file mode 100644 index 00000000000..6dd589f8259 --- /dev/null +++ b/admin/notes/tree-sitter/html-manual/Language-Definitions.html @@ -0,0 +1,402 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> +<!-- This is the GNU Emacs Lisp Reference Manual +corresponding to Emacs version 29.0.50. + +Copyright © 1990-1996, 1998-2022 Free Software Foundation, +Inc. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with the +Invariant Sections being "GNU General Public License," with the +Front-Cover Texts being "A GNU Manual," and with the Back-Cover +Texts as in (a) below. A copy of the license is included in the +section entitled "GNU Free Documentation License." + +(a) The FSF's Back-Cover Text is: "You have the freedom to copy and +modify this GNU manual. Buying copies from the FSF supports it in +developing GNU and promoting software freedom." --> +<title>Language Definitions (GNU Emacs Lisp Reference Manual)</title> + +<meta name="description" content="Language Definitions (GNU Emacs Lisp Reference Manual)"> +<meta name="keywords" content="Language Definitions (GNU Emacs Lisp Reference Manual)"> +<meta name="resource-type" content="document"> +<meta name="distribution" content="global"> +<meta name="Generator" content="makeinfo"> +<meta name="viewport" content="width=device-width,initial-scale=1"> + +<link href="index.html" rel="start" title="Top"> +<link href="Index.html" rel="index" title="Index"> +<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> +<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> +<link href="Using-Parser.html" rel="next" title="Using Parser"> +<style type="text/css"> +<!-- +a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} +a.summary-letter {text-decoration: none} +blockquote.indentedblock {margin-right: 0em} +div.display {margin-left: 3.2em} +div.example {margin-left: 3.2em} +kbd {font-style: oblique} +pre.display {font-family: inherit} +pre.format {font-family: inherit} +pre.menu-comment {font-family: serif} +pre.menu-preformatted {font-family: serif} +span.nolinebreak {white-space: nowrap} +span.roman {font-family: initial; font-weight: normal} +span.sansserif {font-family: sans-serif; font-weight: normal} +span:hover a.copiable-anchor {visibility: visible} +ul.no-bullet {list-style: none} +--> +</style> +<link rel="stylesheet" type="text/css" href="./manual.css"> + + +</head> + +<body lang="en"> +<div class="section" id="Language-Definitions"> +<div class="header"> +<p> +Next: <a href="Using-Parser.html" accesskey="n" rel="next">Using Tree-sitter Parser</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> +<hr> +<span id="Tree_002dsitter-Language-Definitions"></span><h3 class="section">37.1 Tree-sitter Language Definitions</h3> +<span id="index-language-definitions_002c-for-tree_002dsitter"></span> + +<span id="Loading-a-language-definition"></span><h3 class="heading">Loading a language definition</h3> +<span id="index-loading-language-definition-for-tree_002dsitter"></span> + +<span id="index-language-argument_002c-for-tree_002dsitter"></span> +<p>Tree-sitter relies on language definitions to parse text in that +language. In Emacs, a language definition is represented by a symbol. +For example, the C language definition is represented as the symbol +<code>c</code>, and <code>c</code> can be passed to tree-sitter functions as the +<var>language</var> argument. +</p> +<span id="index-treesit_002dextra_002dload_002dpath"></span> +<span id="index-treesit_002dload_002dlanguage_002derror"></span> +<span id="index-treesit_002dload_002dsuffixes"></span> +<p>Tree-sitter language definitions are distributed as dynamic libraries. +In order to use a language definition in Emacs, you need to make sure +that the dynamic library is installed on the system. Emacs looks for +language definitions in several places, in the following order: +</p> +<ul> +<li> first, in the list of directories specified by the variable +<code>treesit-extra-load-path</code>; +</li><li> then, in the <samp>tree-sitter</samp> subdirectory of the directory +specified by <code>user-emacs-directory</code> (see <a href="Init-File.html">The Init File</a>); +</li><li> and finally, in the system’s default locations for dynamic libraries. +</li></ul> + +<p>In each of these directories, Emacs looks for a file with file-name +extensions specified by the variable <code>treesit-load-suffixes</code>. +</p> +<p>If Emacs cannot find the library or has problems loading it, Emacs +signals the <code>treesit-load-language-error</code> error. The data of +that signal could be one of the following: +</p> +<dl compact="compact"> +<dt><span><code>(not-found <var>error-msg</var> …)</code></span></dt> +<dd><p>This means that Emacs could not find the language definition library. +</p></dd> +<dt><span><code>(symbol-error <var>error-msg</var>)</code></span></dt> +<dd><p>This means that Emacs could not find in the library the expected function +that every language definition library should export. +</p></dd> +<dt><span><code>(version-mismatch <var>error-msg</var>)</code></span></dt> +<dd><p>This means that the version of language definition library is incompatible +with that of the tree-sitter library. +</p></dd> +</dl> + +<p>In all of these cases, <var>error-msg</var> might provide additional +details about the failure. +</p> +<dl class="def"> +<dt id="index-treesit_002dlanguage_002davailable_002dp"><span class="category">Function: </span><span><strong>treesit-language-available-p</strong> <em>language &optional detail</em><a href='#index-treesit_002dlanguage_002davailable_002dp' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns non-<code>nil</code> if the language definitions for +<var>language</var> exist and can be loaded. +</p> +<p>If <var>detail</var> is non-<code>nil</code>, return <code>(t . nil)</code> when +<var>language</var> is available, and <code>(nil . <var>data</var>)</code> when it’s +unavailable. <var>data</var> is the signal data of +<code>treesit-load-language-error</code>. +</p></dd></dl> + +<span id="index-treesit_002dload_002dname_002doverride_002dlist"></span> +<p>By convention, the file name of the dynamic library for <var>language</var> is +<samp>libtree-sitter-<var>language</var>.<var>ext</var></samp>, where <var>ext</var> is the +system-specific extension for dynamic libraries. Also by convention, +the function provided by that library is named +<code>tree_sitter_<var>language</var></code>. If a language definition library +doesn’t follow this convention, you should add an entry +</p> +<div class="example"> +<pre class="example">(<var>language</var> <var>library-base-name</var> <var>function-name</var>) +</pre></div> + +<p>to the list in the variable <code>treesit-load-name-override-list</code>, where +<var>library-base-name</var> is the basename of the dynamic library’s file name, +(usually, <samp>libtree-sitter-<var>language</var></samp>), and +<var>function-name</var> is the function provided by the library +(usually, <code>tree_sitter_<var>language</var></code>). For example, +</p> +<div class="example"> +<pre class="example">(cool-lang "libtree-sitter-coool" "tree_sitter_cooool") +</pre></div> + +<p>for a language that considers itself too “cool” to abide by +conventions. +</p> +<span id="index-language_002ddefinition-version_002c-compatibility"></span> +<dl class="def"> +<dt id="index-treesit_002dlanguage_002dversion"><span class="category">Function: </span><span><strong>treesit-language-version</strong> <em>&optional min-compatible</em><a href='#index-treesit_002dlanguage_002dversion' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the version of the language-definition +Application Binary Interface (<acronym>ABI</acronym>) supported by the +tree-sitter library. By default, it returns the latest ABI version +supported by the library, but if <var>min-compatible</var> is +non-<code>nil</code>, it returns the oldest ABI version which the library +still can support. Language definition libraries must be built for +ABI versions between the oldest and the latest versions supported by +the tree-sitter library, otherwise the library will be unable to load +them. +</p></dd></dl> + +<span id="Concrete-syntax-tree"></span><h3 class="heading">Concrete syntax tree</h3> +<span id="index-syntax-tree_002c-concrete"></span> + +<p>A syntax tree is what a parser generates. In a syntax tree, each node +represents a piece of text, and is connected to each other by a +parent-child relationship. For example, if the source text is +</p> +<div class="example"> +<pre class="example">1 + 2 +</pre></div> + +<p>its syntax tree could be +</p> +<div class="example"> +<pre class="example"> +--------------+ + | root "1 + 2" | + +--------------+ + | + +--------------------------------+ + | expression "1 + 2" | + +--------------------------------+ + | | | ++------------+ +--------------+ +------------+ +| number "1" | | operator "+" | | number "2" | ++------------+ +--------------+ +------------+ +</pre></div> + +<p>We can also represent it as an s-expression: +</p> +<div class="example"> +<pre class="example">(root (expression (number) (operator) (number))) +</pre></div> + +<span id="Node-types"></span><h4 class="subheading">Node types</h4> +<span id="index-node-types_002c-in-a-syntax-tree"></span> + +<span id="index-type-of-node_002c-tree_002dsitter"></span> +<span id="tree_002dsitter-node-type"></span><span id="index-named-node_002c-tree_002dsitter"></span> +<span id="tree_002dsitter-named-node"></span><span id="index-anonymous-node_002c-tree_002dsitter"></span> +<p>Names like <code>root</code>, <code>expression</code>, <code>number</code>, and +<code>operator</code> specify the <em>type</em> of the nodes. However, not all +nodes in a syntax tree have a type. Nodes that don’t have a type are +known as <em>anonymous nodes</em>, and nodes with a type are <em>named +nodes</em>. Anonymous nodes are tokens with fixed spellings, including +punctuation characters like bracket ‘<samp>]</samp>’, and keywords like +<code>return</code>. +</p> +<span id="Field-names"></span><h4 class="subheading">Field names</h4> + +<span id="index-field-name_002c-tree_002dsitter"></span> +<span id="index-tree_002dsitter-node-field-name"></span> +<span id="tree_002dsitter-node-field-name"></span><p>To make the syntax tree easier to analyze, many language definitions +assign <em>field names</em> to child nodes. For example, a +<code>function_definition</code> node could have a <code>declarator</code> and a +<code>body</code>: +</p> +<div class="example"> +<pre class="example">(function_definition + declarator: (declaration) + body: (compound_statement)) +</pre></div> + +<span id="Exploring-the-syntax-tree"></span><h3 class="heading">Exploring the syntax tree</h3> +<span id="index-explore-tree_002dsitter-syntax-tree"></span> +<span id="index-inspection-of-tree_002dsitter-parse-tree-nodes"></span> + +<p>To aid in understanding the syntax of a language and in debugging of +Lisp program that use the syntax tree, Emacs provides an “explore” +mode, which displays the syntax tree of the source in the current +buffer in real time. Emacs also comes with an “inspect mode”, which +displays information of the nodes at point in the mode-line. +</p> +<dl class="def"> +<dt id="index-treesit_002dexplore_002dmode"><span class="category">Command: </span><span><strong>treesit-explore-mode</strong><a href='#index-treesit_002dexplore_002dmode' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This mode pops up a window displaying the syntax tree of the source in +the current buffer. Selecting text in the source buffer highlights +the corresponding nodes in the syntax tree display. Clicking +on nodes in the syntax tree highlights the corresponding text in the +source buffer. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dinspect_002dmode"><span class="category">Command: </span><span><strong>treesit-inspect-mode</strong><a href='#index-treesit_002dinspect_002dmode' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This minor mode displays on the mode-line the node that <em>starts</em> +at point. For example, the mode-line can display +</p> +<div class="example"> +<pre class="example"><var>parent</var> <var>field</var>: (<var>node</var> (<var>child</var> (…))) +</pre></div> + +<p>where <var>node</var>, <var>child</var>, etc., are nodes which begin at point. +<var>parent</var> is the parent of <var>node</var>. <var>node</var> is displayed in +a bold typeface. <var>field-name</var>s are field names of <var>node</var> and +of <var>child</var>, etc. +</p> +<p>If no node starts at point, i.e., point is in the middle of a node, +then the mode line displays the earliest node that spans point, and +its immediate parent. +</p> +<p>This minor mode doesn’t create parsers on its own. It uses the first +parser in <code>(treesit-parser-list)</code> (see <a href="Using-Parser.html">Using Tree-sitter Parser</a>). +</p></dd></dl> + +<span id="Reading-the-grammar-definition"></span><h3 class="heading">Reading the grammar definition</h3> +<span id="index-reading-grammar-definition_002c-tree_002dsitter"></span> + +<p>Authors of language definitions define the <em>grammar</em> of a +programming language, which determines how a parser constructs a +concrete syntax tree out of the program text. In order to use the +syntax tree effectively, you need to consult the <em>grammar file</em>. +</p> +<p>The grammar file is usually <samp>grammar.js</samp> in a language +definition’s project repository. The link to a language definition’s +home page can be found on +<a href="https://tree-sitter.github.io/tree-sitter">tree-sitter’s +homepage</a>. +</p> +<p>The grammar definition is written in JavaScript. For example, the +rule matching a <code>function_definition</code> node looks like +</p> +<div class="example"> +<pre class="example">function_definition: $ => seq( + $.declaration_specifiers, + field('declarator', $.declaration), + field('body', $.compound_statement) +) +</pre></div> + +<p>The rules are represented by functions that take a single argument +<var>$</var>, representing the whole grammar. The function itself is +constructed by other functions: the <code>seq</code> function puts together +a sequence of children; the <code>field</code> function annotates a child +with a field name. If we write the above definition in the so-called +<em>Backus-Naur Form</em> (<acronym>BNF</acronym>) syntax, it would look like +</p> +<div class="example"> +<pre class="example">function_definition := + <declaration_specifiers> <declaration> <compound_statement> +</pre></div> + +<p>and the node returned by the parser would look like +</p> +<div class="example"> +<pre class="example">(function_definition + (declaration_specifier) + declarator: (declaration) + body: (compound_statement)) +</pre></div> + +<p>Below is a list of functions that one can see in a grammar definition. +Each function takes other rules as arguments and returns a new rule. +</p> +<dl compact="compact"> +<dt><span><code>seq(<var>rule1</var>, <var>rule2</var>, …)</code></span></dt> +<dd><p>matches each rule one after another. +</p></dd> +<dt><span><code>choice(<var>rule1</var>, <var>rule2</var>, …)</code></span></dt> +<dd><p>matches one of the rules in its arguments. +</p></dd> +<dt><span><code>repeat(<var>rule</var>)</code></span></dt> +<dd><p>matches <var>rule</var> for <em>zero or more</em> times. +This is like the ‘<samp>*</samp>’ operator in regular expressions. +</p></dd> +<dt><span><code>repeat1(<var>rule</var>)</code></span></dt> +<dd><p>matches <var>rule</var> for <em>one or more</em> times. +This is like the ‘<samp>+</samp>’ operator in regular expressions. +</p></dd> +<dt><span><code>optional(<var>rule</var>)</code></span></dt> +<dd><p>matches <var>rule</var> for <em>zero or one</em> time. +This is like the ‘<samp>?</samp>’ operator in regular expressions. +</p></dd> +<dt><span><code>field(<var>name</var>, <var>rule</var>)</code></span></dt> +<dd><p>assigns field name <var>name</var> to the child node matched by <var>rule</var>. +</p></dd> +<dt><span><code>alias(<var>rule</var>, <var>alias</var>)</code></span></dt> +<dd><p>makes nodes matched by <var>rule</var> appear as <var>alias</var> in the syntax +tree generated by the parser. For example, +</p> +<div class="example"> +<pre class="example">alias(preprocessor_call_exp, call_expression) +</pre></div> + +<p>makes any node matched by <code>preprocessor_call_exp</code> appear as +<code>call_expression</code>. +</p></dd> +</dl> + +<p>Below are grammar functions of lesser importance for reading a +language definition. +</p> +<dl compact="compact"> +<dt><span><code>token(<var>rule</var>)</code></span></dt> +<dd><p>marks <var>rule</var> to produce a single leaf node. That is, instead of +generating a parent node with individual child nodes under it, +everything is combined into a single leaf node. See <a href="Retrieving-Nodes.html">Retrieving Nodes</a>. +</p></dd> +<dt><span><code>token.immediate(<var>rule</var>)</code></span></dt> +<dd><p>Normally, grammar rules ignore preceding whitespace; this +changes <var>rule</var> to match only when there is no preceding +whitespaces. +</p></dd> +<dt><span><code>prec(<var>n</var>, <var>rule</var>)</code></span></dt> +<dd><p>gives <var>rule</var> the level-<var>n</var> precedence. +</p></dd> +<dt><span><code>prec.left([<var>n</var>,] <var>rule</var>)</code></span></dt> +<dd><p>marks <var>rule</var> as left-associative, optionally with level <var>n</var>. +</p></dd> +<dt><span><code>prec.right([<var>n</var>,] <var>rule</var>)</code></span></dt> +<dd><p>marks <var>rule</var> as right-associative, optionally with level <var>n</var>. +</p></dd> +<dt><span><code>prec.dynamic(<var>n</var>, <var>rule</var>)</code></span></dt> +<dd><p>this is like <code>prec</code>, but the precedence is applied at runtime +instead. +</p></dd> +</dl> + +<p>The documentation of the tree-sitter project has +<a href="https://tree-sitter.github.io/tree-sitter/creating-parsers">more +about writing a grammar</a>. Read especially “The Grammar DSL” +section. +</p> +</div> +<hr> +<div class="header"> +<p> +Next: <a href="Using-Parser.html">Using Tree-sitter Parser</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> + + + +</body> +</html> diff --git a/admin/notes/tree-sitter/html-manual/Multiple-Languages.html b/admin/notes/tree-sitter/html-manual/Multiple-Languages.html new file mode 100644 index 00000000000..46985649a82 --- /dev/null +++ b/admin/notes/tree-sitter/html-manual/Multiple-Languages.html @@ -0,0 +1,328 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> +<!-- This is the GNU Emacs Lisp Reference Manual +corresponding to Emacs version 29.0.50. + +Copyright © 1990-1996, 1998-2022 Free Software Foundation, +Inc. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with the +Invariant Sections being "GNU General Public License," with the +Front-Cover Texts being "A GNU Manual," and with the Back-Cover +Texts as in (a) below. A copy of the license is included in the +section entitled "GNU Free Documentation License." + +(a) The FSF's Back-Cover Text is: "You have the freedom to copy and +modify this GNU manual. Buying copies from the FSF supports it in +developing GNU and promoting software freedom." --> +<title>Multiple Languages (GNU Emacs Lisp Reference Manual)</title> + +<meta name="description" content="Multiple Languages (GNU Emacs Lisp Reference Manual)"> +<meta name="keywords" content="Multiple Languages (GNU Emacs Lisp Reference Manual)"> +<meta name="resource-type" content="document"> +<meta name="distribution" content="global"> +<meta name="Generator" content="makeinfo"> +<meta name="viewport" content="width=device-width,initial-scale=1"> + +<link href="index.html" rel="start" title="Top"> +<link href="Index.html" rel="index" title="Index"> +<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> +<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> +<link href="Tree_002dsitter-major-modes.html" rel="next" title="Tree-sitter major modes"> +<link href="Pattern-Matching.html" rel="prev" title="Pattern Matching"> +<style type="text/css"> +<!-- +a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} +a.summary-letter {text-decoration: none} +blockquote.indentedblock {margin-right: 0em} +div.display {margin-left: 3.2em} +div.example {margin-left: 3.2em} +kbd {font-style: oblique} +pre.display {font-family: inherit} +pre.format {font-family: inherit} +pre.menu-comment {font-family: serif} +pre.menu-preformatted {font-family: serif} +span.nolinebreak {white-space: nowrap} +span.roman {font-family: initial; font-weight: normal} +span.sansserif {font-family: sans-serif; font-weight: normal} +span:hover a.copiable-anchor {visibility: visible} +ul.no-bullet {list-style: none} +--> +</style> +<link rel="stylesheet" type="text/css" href="./manual.css"> + + +</head> + +<body lang="en"> +<div class="section" id="Multiple-Languages"> +<div class="header"> +<p> +Next: <a href="Tree_002dsitter-major-modes.html" accesskey="n" rel="next">Developing major modes with tree-sitter</a>, Previous: <a href="Pattern-Matching.html" accesskey="p" rel="prev">Pattern Matching Tree-sitter Nodes</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> +<hr> +<span id="Parsing-Text-in-Multiple-Languages"></span><h3 class="section">37.6 Parsing Text in Multiple Languages</h3> +<span id="index-multiple-languages_002c-parsing-with-tree_002dsitter"></span> +<span id="index-parsing-multiple-languages-with-tree_002dsitter"></span> +<p>Sometimes, the source of a programming language could contain snippets +of other languages; <acronym>HTML</acronym> + <acronym>CSS</acronym> + JavaScript is one +example. In that case, text segments written in different languages +need to be assigned different parsers. Traditionally, this is +achieved by using narrowing. While tree-sitter works with narrowing +(see <a href="Using-Parser.html#tree_002dsitter-narrowing">narrowing</a>), the recommended way is +instead to set regions of buffer text (i.e., ranges) in which a parser +will operate. This section describes functions for setting and +getting ranges for a parser. +</p> +<p>Lisp programs should call <code>treesit-update-ranges</code> to make sure +the ranges for each parser are correct before using parsers in a +buffer, and call <code>treesit-language-at</code> to figure out the language +responsible for the text at some position. These two functions don’t +work by themselves, they need major modes to set +<code>treesit-range-settings</code> and +<code>treesit-language-at-point-function</code>, which do the actual work. +These functions and variables are explained in more detail towards the +end of the section. +</p> +<span id="Getting-and-setting-ranges"></span><h3 class="heading">Getting and setting ranges</h3> + +<dl class="def"> +<dt id="index-treesit_002dparser_002dset_002dincluded_002dranges"><span class="category">Function: </span><span><strong>treesit-parser-set-included-ranges</strong> <em>parser ranges</em><a href='#index-treesit_002dparser_002dset_002dincluded_002dranges' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function sets up <var>parser</var> to operate on <var>ranges</var>. The +<var>parser</var> will only read the text of the specified ranges. Each +range in <var>ranges</var> is a list of the form <code>(<var>beg</var> . <var>end</var>)</code><!-- /@w -->. +</p> +<p>The ranges in <var>ranges</var> must come in order and must not overlap. +That is, in pseudo code: +</p> +<div class="example"> +<pre class="example">(cl-loop for idx from 1 to (1- (length ranges)) + for prev = (nth (1- idx) ranges) + for next = (nth idx ranges) + should (<= (car prev) (cdr prev) + (car next) (cdr next))) +</pre></div> + +<span id="index-treesit_002drange_002dinvalid"></span> +<p>If <var>ranges</var> violates this constraint, or something else went +wrong, this function signals the <code>treesit-range-invalid</code> error. +The signal data contains a specific error message and the ranges we +are trying to set. +</p> +<p>This function can also be used for disabling ranges. If <var>ranges</var> +is <code>nil</code>, the parser is set to parse the whole buffer. +</p> +<p>Example: +</p> +<div class="example"> +<pre class="example">(treesit-parser-set-included-ranges + parser '((1 . 9) (16 . 24) (24 . 25))) +</pre></div> +</dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dparser_002dincluded_002dranges"><span class="category">Function: </span><span><strong>treesit-parser-included-ranges</strong> <em>parser</em><a href='#index-treesit_002dparser_002dincluded_002dranges' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the ranges set for <var>parser</var>. The return +value is the same as the <var>ranges</var> argument of +<code>treesit-parser-included-ranges</code>: a list of cons cells of the form +<code>(<var>beg</var> . <var>end</var>)</code><!-- /@w -->. If <var>parser</var> doesn’t have any +ranges, the return value is <code>nil</code>. +</p> +<div class="example"> +<pre class="example">(treesit-parser-included-ranges parser) + ⇒ ((1 . 9) (16 . 24) (24 . 25)) +</pre></div> +</dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dquery_002drange"><span class="category">Function: </span><span><strong>treesit-query-range</strong> <em>source query &optional beg end</em><a href='#index-treesit_002dquery_002drange' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function matches <var>source</var> with <var>query</var> and returns the +ranges of captured nodes. The return value is a list of cons cells of +the form <code>(<var>beg</var> . <var>end</var>)</code><!-- /@w -->, where <var>beg</var> and +<var>end</var> specify the beginning and the end of a region of text. +</p> +<p>For convenience, <var>source</var> can be a language symbol, a parser, or a +node. If it’s a language symbol, this function matches in the root +node of the first parser using that language; if a parser, this +function matches in the root node of that parser; if a node, this +function matches in that node. +</p> +<p>The argument <var>query</var> is the query used to capture nodes +(see <a href="Pattern-Matching.html">Pattern Matching Tree-sitter Nodes</a>). The capture names don’t matter. The +arguments <var>beg</var> and <var>end</var>, if both non-<code>nil</code>, limit the +range in which this function queries. +</p> +<p>Like other query functions, this function raises the +<code>treesit-query-error</code> error if <var>query</var> is malformed. +</p></dd></dl> + +<span id="Supporting-multiple-languages-in-Lisp-programs"></span><h3 class="heading">Supporting multiple languages in Lisp programs</h3> + +<p>It should suffice for general Lisp programs to call the following two +functions in order to support program sources that mixes multiple +languages. +</p> +<dl class="def"> +<dt id="index-treesit_002dupdate_002dranges"><span class="category">Function: </span><span><strong>treesit-update-ranges</strong> <em>&optional beg end</em><a href='#index-treesit_002dupdate_002dranges' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function updates ranges for parsers in the buffer. It makes sure +the parsers’ ranges are set correctly between <var>beg</var> and <var>end</var>, +according to <code>treesit-range-settings</code>. If omitted, <var>beg</var> +defaults to the beginning of the buffer, and <var>end</var> defaults to the +end of the buffer. +</p> +<p>For example, fontification functions use this function before querying +for nodes in a region. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dlanguage_002dat"><span class="category">Function: </span><span><strong>treesit-language-at</strong> <em>pos</em><a href='#index-treesit_002dlanguage_002dat' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the language of the text at buffer position +<var>pos</var>. Under the hood it calls +<code>treesit-language-at-point-function</code> and returns its return +value. If <code>treesit-language-at-point-function</code> is <code>nil</code>, +this function returns the language of the first parser in the returned +value of <code>treesit-parser-list</code>. If there is no parser in the +buffer, it returns <code>nil</code>. +</p></dd></dl> + +<span id="Supporting-multiple-languages-in-major-modes"></span><h3 class="heading">Supporting multiple languages in major modes</h3> + +<span id="index-host-language_002c-tree_002dsitter"></span> +<span id="index-tree_002dsitter-host-and-embedded-languages"></span> +<span id="index-embedded-language_002c-tree_002dsitter"></span> +<p>Normally, in a set of languages that can be mixed together, there is a +<em>host language</em> and one or more <em>embedded languages</em>. A Lisp +program usually first parses the whole document with the host +language’s parser, retrieves some information, sets ranges for the +embedded languages with that information, and then parses the embedded +languages. +</p> +<p>Take a buffer containing <acronym>HTML</acronym>, <acronym>CSS</acronym> and JavaScript +as an example. A Lisp program will first parse the whole buffer with +an <acronym>HTML</acronym> parser, then query the parser for +<code>style_element</code> and <code>script_element</code> nodes, which +correspond to <acronym>CSS</acronym> and JavaScript text, respectively. Then +it sets the range of the <acronym>CSS</acronym> and JavaScript parser to the +ranges in which their corresponding nodes span. +</p> +<p>Given a simple <acronym>HTML</acronym> document: +</p> +<div class="example"> +<pre class="example"><html> + <script>1 + 2</script> + <style>body { color: "blue"; }</style> +</html> +</pre></div> + +<p>a Lisp program will first parse with a <acronym>HTML</acronym> parser, then set +ranges for <acronym>CSS</acronym> and JavaScript parsers: +</p> +<div class="example"> +<pre class="example">;; Create parsers. +(setq html (treesit-get-parser-create 'html)) +(setq css (treesit-get-parser-create 'css)) +(setq js (treesit-get-parser-create 'javascript)) +</pre><pre class="example"> + +</pre><pre class="example">;; Set CSS ranges. +(setq css-range + (treesit-query-range + 'html + "(style_element (raw_text) @capture)")) +(treesit-parser-set-included-ranges css css-range) +</pre><pre class="example"> + +</pre><pre class="example">;; Set JavaScript ranges. +(setq js-range + (treesit-query-range + 'html + "(script_element (raw_text) @capture)")) +(treesit-parser-set-included-ranges js js-range) +</pre></div> + +<p>Emacs automates this process in <code>treesit-update-ranges</code>. A +multi-language major mode should set <code>treesit-range-settings</code> so +that <code>treesit-update-ranges</code> knows how to perform this process +automatically. Major modes should use the helper function +<code>treesit-range-rules</code> to generate a value that can be assigned to +<code>treesit-range-settings</code>. The settings in the following example +directly translate into operations shown above. +</p> +<div class="example"> +<pre class="example">(setq-local treesit-range-settings + (treesit-range-rules + :embed 'javascript + :host 'html + '((script_element (raw_text) @capture)) +</pre><pre class="example"> + +</pre><pre class="example"> :embed 'css + :host 'html + '((style_element (raw_text) @capture)))) +</pre></div> + +<dl class="def"> +<dt id="index-treesit_002drange_002drules"><span class="category">Function: </span><span><strong>treesit-range-rules</strong> <em>&rest query-specs</em><a href='#index-treesit_002drange_002drules' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function is used to set <var>treesit-range-settings</var>. It +takes care of compiling queries and other post-processing, and outputs +a value that <var>treesit-range-settings</var> can have. +</p> +<p>It takes a series of <var>query-spec</var>s, where each <var>query-spec</var> is +a <var>query</var> preceded by zero or more <var>keyword</var>/<var>value</var> +pairs. Each <var>query</var> is a tree-sitter query in either the +string, s-expression or compiled form, or a function. +</p> +<p>If <var>query</var> is a tree-sitter query, it should be preceded by two +<var>:keyword</var>/<var>value</var> pairs, where the <code>:embed</code> keyword +specifies the embedded language, and the <code>:host</code> keyword +specified the host language. +</p> +<p><code>treesit-update-ranges</code> uses <var>query</var> to figure out how to set +the ranges for parsers for the embedded language. It queries +<var>query</var> in a host language parser, computes the ranges in which +the captured nodes span, and applies these ranges to embedded +language parsers. +</p> +<p>If <var>query</var> is a function, it doesn’t need any <var>:keyword</var> and +<var>value</var> pair. It should be a function that takes 2 arguments, +<var>start</var> and <var>end</var>, and sets the ranges for parsers in the +current buffer in the region between <var>start</var> and <var>end</var>. It is +fine for this function to set ranges in a larger region that +encompasses the region between <var>start</var> and <var>end</var>. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002drange_002dsettings"><span class="category">Variable: </span><span><strong>treesit-range-settings</strong><a href='#index-treesit_002drange_002dsettings' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This variable helps <code>treesit-update-ranges</code> in updating the +ranges for parsers in the buffer. It is a list of <var>setting</var>s +where the exact format of a <var>setting</var> is considered internal. You +should use <code>treesit-range-rules</code> to generate a value that this +variable can have. +</p> +</dd></dl> + + +<dl class="def"> +<dt id="index-treesit_002dlanguage_002dat_002dpoint_002dfunction"><span class="category">Variable: </span><span><strong>treesit-language-at-point-function</strong><a href='#index-treesit_002dlanguage_002dat_002dpoint_002dfunction' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This variable’s value should be a function that takes a single +argument, <var>pos</var>, which is a buffer position, and returns the +language of the buffer text at <var>pos</var>. This variable is used by +<code>treesit-language-at</code>. +</p></dd></dl> + +</div> +<hr> +<div class="header"> +<p> +Next: <a href="Tree_002dsitter-major-modes.html">Developing major modes with tree-sitter</a>, Previous: <a href="Pattern-Matching.html">Pattern Matching Tree-sitter Nodes</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> + + + +</body> +</html> diff --git a/admin/notes/tree-sitter/html-manual/Parser_002dbased-Font-Lock.html b/admin/notes/tree-sitter/html-manual/Parser_002dbased-Font-Lock.html new file mode 100644 index 00000000000..e04a730b05c --- /dev/null +++ b/admin/notes/tree-sitter/html-manual/Parser_002dbased-Font-Lock.html @@ -0,0 +1,248 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> +<!-- This is the GNU Emacs Lisp Reference Manual +corresponding to Emacs version 29.0.50. + +Copyright © 1990-1996, 1998-2022 Free Software Foundation, +Inc. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with the +Invariant Sections being "GNU General Public License," with the +Front-Cover Texts being "A GNU Manual," and with the Back-Cover +Texts as in (a) below. A copy of the license is included in the +section entitled "GNU Free Documentation License." + +(a) The FSF's Back-Cover Text is: "You have the freedom to copy and +modify this GNU manual. Buying copies from the FSF supports it in +developing GNU and promoting software freedom." --> +<title>Parser-based Font Lock (GNU Emacs Lisp Reference Manual)</title> + +<meta name="description" content="Parser-based Font Lock (GNU Emacs Lisp Reference Manual)"> +<meta name="keywords" content="Parser-based Font Lock (GNU Emacs Lisp Reference Manual)"> +<meta name="resource-type" content="document"> +<meta name="distribution" content="global"> +<meta name="Generator" content="makeinfo"> +<meta name="viewport" content="width=device-width,initial-scale=1"> + +<link href="index.html" rel="start" title="Top"> +<link href="Index.html" rel="index" title="Index"> +<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> +<link href="Font-Lock-Mode.html" rel="up" title="Font Lock Mode"> +<link href="Multiline-Font-Lock.html" rel="prev" title="Multiline Font Lock"> +<style type="text/css"> +<!-- +a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} +a.summary-letter {text-decoration: none} +blockquote.indentedblock {margin-right: 0em} +div.display {margin-left: 3.2em} +div.example {margin-left: 3.2em} +kbd {font-style: oblique} +pre.display {font-family: inherit} +pre.format {font-family: inherit} +pre.menu-comment {font-family: serif} +pre.menu-preformatted {font-family: serif} +span.nolinebreak {white-space: nowrap} +span.roman {font-family: initial; font-weight: normal} +span.sansserif {font-family: sans-serif; font-weight: normal} +span:hover a.copiable-anchor {visibility: visible} +ul.no-bullet {list-style: none} +--> +</style> +<link rel="stylesheet" type="text/css" href="./manual.css"> + + +</head> + +<body lang="en"> +<div class="subsection" id="Parser_002dbased-Font-Lock"> +<div class="header"> +<p> +Previous: <a href="Multiline-Font-Lock.html" accesskey="p" rel="prev">Multiline Font Lock Constructs</a>, Up: <a href="Font-Lock-Mode.html" accesskey="u" rel="up">Font Lock Mode</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> +<hr> +<span id="Parser_002dbased-Font-Lock-1"></span><h4 class="subsection">24.6.10 Parser-based Font Lock</h4> +<span id="index-parser_002dbased-font_002dlock"></span> + + +<p>Besides simple syntactic font lock and regexp-based font lock, Emacs +also provides complete syntactic font lock with the help of a parser. +Currently, Emacs uses the tree-sitter library (see <a href="Parsing-Program-Source.html">Parsing Program Source</a>) for this purpose. +</p> +<p>Parser-based font lock and other font lock mechanisms are not mutually +exclusive. By default, if enabled, parser-based font lock runs first, +replacing syntactic font lock, then the regexp-based font lock. +</p> +<p>Although parser-based font lock doesn’t share the same customization +variables with regexp-based font lock, it uses similar customization +schemes. The tree-sitter counterpart of <var>font-lock-keywords</var> is +<var>treesit-font-lock-settings</var>. +</p> +<span id="index-tree_002dsitter-fontifications_002c-overview"></span> +<span id="index-fontifications-with-tree_002dsitter_002c-overview"></span> +<p>In general, tree-sitter fontification works as follows: +</p> +<ul> +<li> A Lisp program (usually, part of a major mode) provides a <em>query</em> +consisting of <em>patterns</em>, each pattern associated with a +<em>capture name</em>. + +</li><li> The tree-sitter library finds the nodes in the parse tree +that match these patterns, tags the nodes with the corresponding +capture names, and returns them to the Lisp program. + +</li><li> The Lisp program uses the returned nodes to highlight the portions of +buffer text corresponding to each node as appropriate, using the +tagged capture names of the nodes to determine the correct +fontification. For example, a node tagged <code>font-lock-keyword</code> +would be highlighted in <code>font-lock-keyword</code> face. +</li></ul> + +<p>For more information about queries, patterns, and capture names, see +<a href="Pattern-Matching.html">Pattern Matching Tree-sitter Nodes</a>. +</p> +<p>To setup tree-sitter fontification, a major mode should first set +<code>treesit-font-lock-settings</code> with the output of +<code>treesit-font-lock-rules</code>, then call +<code>treesit-major-mode-setup</code>. +</p> +<dl class="def"> +<dt id="index-treesit_002dfont_002dlock_002drules"><span class="category">Function: </span><span><strong>treesit-font-lock-rules</strong> <em>&rest query-specs</em><a href='#index-treesit_002dfont_002dlock_002drules' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function is used to set <var>treesit-font-lock-settings</var>. It +takes care of compiling queries and other post-processing, and outputs +a value that <var>treesit-font-lock-settings</var> accepts. Here’s an +example: +</p> +<div class="example"> +<pre class="example">(treesit-font-lock-rules + :language 'javascript + :feature 'constant + :override t + '((true) @font-lock-constant-face + (false) @font-lock-constant-face) + :language 'html + :feature 'script + "(script_element) @font-lock-builtin-face") +</pre></div> + +<p>This function takes a series of <var>query-spec</var>s, where each +<var>query-spec</var> is a <var>query</var> preceded by one or more +<var>:keyword</var>/<var>value</var> pairs. Each <var>query</var> is a +tree-sitter query in either the string, s-expression or compiled form. +</p> +<p>For each <var>query</var>, the <var>:keyword</var>/<var>value</var> pairs that +precede it add meta information to it. The <code>:lang</code> keyword +declares <var>query</var>’s language. The <code>:feature</code> keyword sets the +feature name of <var>query</var>. Users can control which features are +enabled with <code>font-lock-maximum-decoration</code> and +<code>treesit-font-lock-feature-list</code> (described below). These two +keywords are mandatory. +</p> +<p>Other keywords are optional: +</p> +<table> +<thead><tr><th width="15%">Keyword</th><th width="15%">Value</th><th width="60%">Description</th></tr></thead> +<tr><td width="15%"><code>:override</code></td><td width="15%">nil</td><td width="60%">If the region already has a face, discard the new face</td></tr> +<tr><td width="15%"></td><td width="15%">t</td><td width="60%">Always apply the new face</td></tr> +<tr><td width="15%"></td><td width="15%"><code>append</code></td><td width="60%">Append the new face to existing ones</td></tr> +<tr><td width="15%"></td><td width="15%"><code>prepend</code></td><td width="60%">Prepend the new face to existing ones</td></tr> +<tr><td width="15%"></td><td width="15%"><code>keep</code></td><td width="60%">Fill-in regions without an existing face</td></tr> +</table> + +<p>Lisp programs mark patterns in <var>query</var> with capture names (names +that starts with <code>@</code>), and tree-sitter will return matched nodes +tagged with those same capture names. For the purpose of +fontification, capture names in <var>query</var> should be face names like +<code>font-lock-keyword-face</code>. The captured node will be fontified +with that face. +</p> +<span id="index-treesit_002dfontify_002dwith_002doverride"></span> +<p>Capture names can also be function names, in which case the function +is called with 4 arguments: <var>node</var> and <var>override</var>, <var>start</var> +and <var>end</var>, where <var>node</var> is the node itself, <var>override</var> is +the override property of the rule which captured this node, and +<var>start</var> and <var>end</var> limits the region in which this function +should fontify. (If this function wants to respect the <var>override</var> +argument, it can use <code>treesit-fontify-with-override</code>.) +</p> +<p>Beyond the 4 arguments presented, this function should accept more +arguments as optional arguments for future extensibility. +</p> +<p>If a capture name is both a face and a function, the face takes +priority. If a capture name is neither a face nor a function, it is +ignored. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dfont_002dlock_002dfeature_002dlist"><span class="category">Variable: </span><span><strong>treesit-font-lock-feature-list</strong><a href='#index-treesit_002dfont_002dlock_002dfeature_002dlist' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This is a list of lists of feature symbols. Each element of the list +is a list that represents a decoration level. +<code>font-lock-maximum-decoration</code> controls which levels are +activated. +</p> +<p>Each element of the list is a list of the form <code>(<var>feature</var> …)</code><!-- /@w -->, where each <var>feature</var> corresponds to the +<code>:feature</code> value of a query defined in +<code>treesit-font-lock-rules</code>. Removing a feature symbol from this +list disables the corresponding query during font-lock. +</p> +<p>Common feature names, for many programming languages, include +<code>definition</code>, <code>type</code>, <code>assignment</code>, <code>builtin</code>, +<code>constant</code>, <code>keyword</code>, <code>string-interpolation</code>, +<code>comment</code>, <code>doc</code>, <code>string</code>, <code>operator</code>, +<code>preprocessor</code>, <code>escape-sequence</code>, and <code>key</code>. Major +modes are free to subdivide or extend these common features. +</p> +<p>Some of these features warrant some explanation: <code>definition</code> +highlights whatever is being defined, e.g., the function name in a +function definition, the struct name in a struct definition, the +variable name in a variable definition; <code>assignment</code> highlights +the whatever is being assigned to, e.g., the variable or field in an +assignment statement; <code>key</code> highlights keys in key-value pairs, +e.g., keys in a JSON object, or a Python dictionary; <code>doc</code> +highlights docstrings or doc-comments. +</p> +<p>For example, the value of this variable could be: +</p><div class="example"> +<pre class="example">((comment string doc) ; level 1 + (function-name keyword type builtin constant) ; level 2 + (variable-name string-interpolation key)) ; level 3 +</pre></div> + +<p>Major modes should set this variable before calling +<code>treesit-major-mode-setup</code>. +</p> +<span id="index-treesit_002dfont_002dlock_002drecompute_002dfeatures"></span> +<p>For this variable to take effect, a Lisp program should call +<code>treesit-font-lock-recompute-features</code> (which resets +<code>treesit-font-lock-settings</code> accordingly), or +<code>treesit-major-mode-setup</code> (which calls +<code>treesit-font-lock-recompute-features</code>). +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dfont_002dlock_002dsettings"><span class="category">Variable: </span><span><strong>treesit-font-lock-settings</strong><a href='#index-treesit_002dfont_002dlock_002dsettings' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>A list of settings for tree-sitter based font lock. The exact format +of each setting is considered internal. One should always use +<code>treesit-font-lock-rules</code> to set this variable. +</p> +</dd></dl> + +<p>Multi-language major modes should provide range functions in +<code>treesit-range-functions</code>, and Emacs will set the ranges +accordingly before fontifing a region (see <a href="Multiple-Languages.html">Parsing Text in Multiple Languages</a>). +</p> +</div> +<hr> +<div class="header"> +<p> +Previous: <a href="Multiline-Font-Lock.html">Multiline Font Lock Constructs</a>, Up: <a href="Font-Lock-Mode.html">Font Lock Mode</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> + + + +</body> +</html> diff --git a/admin/notes/tree-sitter/html-manual/Parser_002dbased-Indentation.html b/admin/notes/tree-sitter/html-manual/Parser_002dbased-Indentation.html new file mode 100644 index 00000000000..95005de6d11 --- /dev/null +++ b/admin/notes/tree-sitter/html-manual/Parser_002dbased-Indentation.html @@ -0,0 +1,281 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> +<!-- This is the GNU Emacs Lisp Reference Manual +corresponding to Emacs version 29.0.50. + +Copyright © 1990-1996, 1998-2022 Free Software Foundation, +Inc. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with the +Invariant Sections being "GNU General Public License," with the +Front-Cover Texts being "A GNU Manual," and with the Back-Cover +Texts as in (a) below. A copy of the license is included in the +section entitled "GNU Free Documentation License." + +(a) The FSF's Back-Cover Text is: "You have the freedom to copy and +modify this GNU manual. Buying copies from the FSF supports it in +developing GNU and promoting software freedom." --> +<title>Parser-based Indentation (GNU Emacs Lisp Reference Manual)</title> + +<meta name="description" content="Parser-based Indentation (GNU Emacs Lisp Reference Manual)"> +<meta name="keywords" content="Parser-based Indentation (GNU Emacs Lisp Reference Manual)"> +<meta name="resource-type" content="document"> +<meta name="distribution" content="global"> +<meta name="Generator" content="makeinfo"> +<meta name="viewport" content="width=device-width,initial-scale=1"> + +<link href="index.html" rel="start" title="Top"> +<link href="Index.html" rel="index" title="Index"> +<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> +<link href="Auto_002dIndentation.html" rel="up" title="Auto-Indentation"> +<link href="SMIE.html" rel="prev" title="SMIE"> +<style type="text/css"> +<!-- +a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} +a.summary-letter {text-decoration: none} +blockquote.indentedblock {margin-right: 0em} +div.display {margin-left: 3.2em} +div.example {margin-left: 3.2em} +kbd {font-style: oblique} +pre.display {font-family: inherit} +pre.format {font-family: inherit} +pre.menu-comment {font-family: serif} +pre.menu-preformatted {font-family: serif} +span.nolinebreak {white-space: nowrap} +span.roman {font-family: initial; font-weight: normal} +span.sansserif {font-family: sans-serif; font-weight: normal} +span:hover a.copiable-anchor {visibility: visible} +ul.no-bullet {list-style: none} +--> +</style> +<link rel="stylesheet" type="text/css" href="./manual.css"> + + +</head> + +<body lang="en"> +<div class="subsection" id="Parser_002dbased-Indentation"> +<div class="header"> +<p> +Previous: <a href="SMIE.html" accesskey="p" rel="prev">Simple Minded Indentation Engine</a>, Up: <a href="Auto_002dIndentation.html" accesskey="u" rel="up">Automatic Indentation of code</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> +<hr> +<span id="Parser_002dbased-Indentation-1"></span><h4 class="subsection">24.7.2 Parser-based Indentation</h4> +<span id="index-parser_002dbased-indentation"></span> + + +<p>When built with the tree-sitter library (see <a href="Parsing-Program-Source.html">Parsing Program Source</a>), Emacs is capable of parsing the program source and producing +a syntax tree. This syntax tree can be used for guiding the program +source indentation commands. For maximum flexibility, it is possible +to write a custom indentation function that queries the syntax tree +and indents accordingly for each language, but that is a lot of work. +It is more convenient to use the simple indentation engine described +below: then the major mode needs only to write some indentation rules +and the engine takes care of the rest. +</p> +<p>To enable the parser-based indentation engine, either set +<var>treesit-simple-indent-rules</var> and call +<code>treesit-major-mode-setup</code>, or equivalently, set the value of +<code>indent-line-function</code> to <code>treesit-indent</code>. +</p> +<dl class="def"> +<dt id="index-treesit_002dindent_002dfunction"><span class="category">Variable: </span><span><strong>treesit-indent-function</strong><a href='#index-treesit_002dindent_002dfunction' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This variable stores the actual function called by +<code>treesit-indent</code>. By default, its value is +<code>treesit-simple-indent</code>. In the future we might add other, +more complex indentation engines. +</p></dd></dl> + +<span id="Writing-indentation-rules"></span><h3 class="heading">Writing indentation rules</h3> +<span id="index-indentation-rules_002c-for-parser_002dbased-indentation"></span> + +<dl class="def"> +<dt id="index-treesit_002dsimple_002dindent_002drules"><span class="category">Variable: </span><span><strong>treesit-simple-indent-rules</strong><a href='#index-treesit_002dsimple_002dindent_002drules' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This local variable stores indentation rules for every language. It is +a list of the form: <code>(<var>language</var> . <var>rules</var>)</code><!-- /@w -->, where +<var>language</var> is a language symbol, and <var>rules</var> is a list of the +form <code>(<var>matcher</var> <var>anchor</var> <var>offset</var>)</code><!-- /@w -->. +</p> +<p>First, Emacs passes the smallest tree-sitter node at the beginning of +the current line to <var>matcher</var>; if it returns non-<code>nil</code>, this +rule is applicable. Then Emacs passes the node to <var>anchor</var>, which +returns a buffer position. Emacs takes the column number of that +position, adds <var>offset</var> to it, and the result is the indentation +column for the current line. <var>offset</var> can be an integer or a +variable whose value is an integer. +</p> +<p>The <var>matcher</var> and <var>anchor</var> are functions, and Emacs provides +convenient defaults for them. +</p> +<p>Each <var>matcher</var> or <var>anchor</var> is a function that takes three +arguments: <var>node</var>, <var>parent</var>, and <var>bol</var>. The argument +<var>bol</var> is the buffer position whose indentation is required: the +position of the first non-whitespace character after the beginning of +the line. The argument <var>node</var> is the largest (highest-in-tree) +node that starts at that position; and <var>parent</var> is the parent of +<var>node</var>. However, when that position is in a whitespace or inside +a multi-line string, no node can start at that position, so +<var>node</var> is <code>nil</code>. In that case, <var>parent</var> would be the +smallest node that spans that position. +</p> +<p>Emacs finds <var>bol</var>, <var>node</var> and <var>parent</var> and +passes them to each <var>matcher</var> and <var>anchor</var>. <var>matcher</var> +should return non-<code>nil</code> if the rule is applicable, and +<var>anchor</var> should return a buffer position. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dsimple_002dindent_002dpresets"><span class="category">Variable: </span><span><strong>treesit-simple-indent-presets</strong><a href='#index-treesit_002dsimple_002dindent_002dpresets' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This is a list of defaults for <var>matcher</var>s and <var>anchor</var>s in +<code>treesit-simple-indent-rules</code>. Each of them represents a function +that takes 3 arguments: <var>node</var>, <var>parent</var> and <var>bol</var>. The +available default functions are: +</p> +<dl compact="compact"> +<dt id='index-no_002dnode'><span><code>no-node</code><a href='#index-no_002dnode' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This matcher is a function that is called with 3 arguments: +<var>node</var>, <var>parent</var>, and <var>bol</var>, and returns non-<code>nil</code>, +indicating a match, if <var>node</var> is <code>nil</code>, i.e., there is no +node that starts at <var>bol</var>. This is the case when <var>bol</var> is on +an empty line or inside a multi-line string, etc. +</p> +</dd> +<dt id='index-parent_002dis'><span><code>parent-is</code><a href='#index-parent_002dis' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This matcher is a function of one argument, <var>type</var>; it returns a +function that is called with 3 arguments: <var>node</var>, <var>parent</var>, +and <var>bol</var>, and returns non-<code>nil</code> (i.e., a match) if +<var>parent</var>’s type matches regexp <var>type</var>. +</p> +</dd> +<dt id='index-node_002dis'><span><code>node-is</code><a href='#index-node_002dis' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This matcher is a function of one argument, <var>type</var>; it returns a +function that is called with 3 arguments: <var>node</var>, <var>parent</var>, +and <var>bol</var>, and returns non-<code>nil</code> if <var>node</var>’s type matches +regexp <var>type</var>. +</p> +</dd> +<dt id='index-query'><span><code>query</code><a href='#index-query' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This matcher is a function of one argument, <var>query</var>; it returns a +function that is called with 3 arguments: <var>node</var>, <var>parent</var>, +and <var>bol</var>, and returns non-<code>nil</code> if querying <var>parent</var> +with <var>query</var> captures <var>node</var> (see <a href="Pattern-Matching.html">Pattern Matching Tree-sitter Nodes</a>). +</p> +</dd> +<dt id='index-match'><span><code>match</code><a href='#index-match' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This matcher is a function of 5 arguments: <var>node-type</var>, +<var>parent-type</var>, <var>node-field</var>, <var>node-index-min</var>, and +<var>node-index-max</var>). It returns a function that is called with 3 +arguments: <var>node</var>, <var>parent</var>, and <var>bol</var>, and returns +non-<code>nil</code> if <var>node</var>’s type matches regexp <var>node-type</var>, +<var>parent</var>’s type matches regexp <var>parent-type</var>, <var>node</var>’s +field name in <var>parent</var> matches regexp <var>node-field</var>, and +<var>node</var>’s index among its siblings is between <var>node-index-min</var> +and <var>node-index-max</var>. If the value of an argument is <code>nil</code>, +this matcher doesn’t check that argument. For example, to match the +first child where parent is <code>argument_list</code>, use +</p> +<div class="example"> +<pre class="example">(match nil "argument_list" nil nil 0 0) +</pre></div> + +</dd> +<dt id='index-comment_002dend'><span><code>comment-end</code><a href='#index-comment_002dend' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This matcher is a function that is called with 3 arguments: +<var>node</var>, <var>parent</var>, and <var>bol</var>, and returns non-<code>nil</code> if +point is before a comment ending token. Comment ending tokens are +defined by regular expression <code>treesit-comment-end</code> +(see <a href="Tree_002dsitter-major-modes.html">treesit-comment-end</a>). +</p> +</dd> +<dt id='index-first_002dsibling'><span><code>first-sibling</code><a href='#index-first_002dsibling' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, +<var>parent</var>, and <var>bol</var>, and returns the start of the first child +of <var>parent</var>. +</p> +</dd> +<dt id='index-parent'><span><code>parent</code><a href='#index-parent' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, +<var>parent</var>, and <var>bol</var>, and returns the start of <var>parent</var>. +</p> +</dd> +<dt id='index-parent_002dbol'><span><code>parent-bol</code><a href='#index-parent_002dbol' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, +<var>parent</var>, and <var>bol</var>, and returns the first non-space character +on the line of <var>parent</var>. +</p> +</dd> +<dt id='index-prev_002dsibling'><span><code>prev-sibling</code><a href='#index-prev_002dsibling' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, +<var>parent</var>, and <var>bol</var>, and returns the start of the previous +sibling of <var>node</var>. +</p> +</dd> +<dt id='index-no_002dindent'><span><code>no-indent</code><a href='#index-no_002dindent' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, +<var>parent</var>, and <var>bol</var>, and returns the start of <var>node</var>. +</p> +</dd> +<dt id='index-prev_002dline'><span><code>prev-line</code><a href='#index-prev_002dline' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, +<var>parent</var>, and <var>bol</var>, and returns the first non-whitespace +character on the previous line. +</p> +</dd> +<dt id='index-point_002dmin'><span><code>point-min</code><a href='#index-point_002dmin' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, +<var>parent</var>, and <var>bol</var>, and returns the beginning of the buffer. +This is useful as the beginning of the buffer is always at column 0. +</p> +</dd> +<dt id='index-comment_002dstart'><span><code>comment-start</code><a href='#index-comment_002dstart' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, +<var>parent</var>, and <var>bol</var>, and returns the position right after the +comment-start token. Comment-start tokens are defined by regular +expression <code>treesit-comment-start</code> (see <a href="Tree_002dsitter-major-modes.html">treesit-comment-start</a>). This function assumes <var>parent</var> is +the comment node. +</p> +</dd> +<dt id='index-coment_002dstart_002dskip'><span><code>coment-start-skip</code><a href='#index-coment_002dstart_002dskip' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This anchor is a function that is called with 3 arguments: <var>node</var>, +<var>parent</var>, and <var>bol</var>, and returns the position after the +comment-start token and any whitespace characters following that +token. Comment-start tokens are defined by regular expression +<code>treesit-comment-start</code>. This function assumes <var>parent</var> is +the comment node. +</p></dd> +</dl> +</dd></dl> + +<span id="Indentation-utilities"></span><h3 class="heading">Indentation utilities</h3> +<span id="index-utility-functions-for-parser_002dbased-indentation"></span> + +<p>Here are some utility functions that can help writing parser-based +indentation rules. +</p> +<dl class="def"> +<dt id="index-treesit_002dcheck_002dindent"><span class="category">Function: </span><span><strong>treesit-check-indent</strong> <em>mode</em><a href='#index-treesit_002dcheck_002dindent' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function checks the current buffer’s indentation against major +mode <var>mode</var>. It indents the current buffer according to +<var>mode</var> and compares the results with the current indentation. +Then it pops up a buffer showing the differences. Correct +indentation (target) is shown in green color, current indentation is +shown in red color. </p></dd></dl> + +<p>It is also helpful to use <code>treesit-inspect-mode</code> (see <a href="Language-Definitions.html">Tree-sitter Language Definitions</a>) when writing indentation rules. +</p> +</div> +<hr> +<div class="header"> +<p> +Previous: <a href="SMIE.html">Simple Minded Indentation Engine</a>, Up: <a href="Auto_002dIndentation.html">Automatic Indentation of code</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> + + + +</body> +</html> diff --git a/admin/notes/tree-sitter/html-manual/Parsing-Program-Source.html b/admin/notes/tree-sitter/html-manual/Parsing-Program-Source.html new file mode 100644 index 00000000000..a0b5775f11f --- /dev/null +++ b/admin/notes/tree-sitter/html-manual/Parsing-Program-Source.html @@ -0,0 +1,126 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> +<!-- This is the GNU Emacs Lisp Reference Manual +corresponding to Emacs version 29.0.50. + +Copyright © 1990-1996, 1998-2022 Free Software Foundation, +Inc. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with the +Invariant Sections being "GNU General Public License," with the +Front-Cover Texts being "A GNU Manual," and with the Back-Cover +Texts as in (a) below. A copy of the license is included in the +section entitled "GNU Free Documentation License." + +(a) The FSF's Back-Cover Text is: "You have the freedom to copy and +modify this GNU manual. Buying copies from the FSF supports it in +developing GNU and promoting software freedom." --> +<title>Parsing Program Source (GNU Emacs Lisp Reference Manual)</title> + +<meta name="description" content="Parsing Program Source (GNU Emacs Lisp Reference Manual)"> +<meta name="keywords" content="Parsing Program Source (GNU Emacs Lisp Reference Manual)"> +<meta name="resource-type" content="document"> +<meta name="distribution" content="global"> +<meta name="Generator" content="makeinfo"> +<meta name="viewport" content="width=device-width,initial-scale=1"> + +<link href="index.html" rel="start" title="Top"> +<link href="Index.html" rel="index" title="Index"> +<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> +<link href="index.html" rel="up" title="Top"> +<link href="Abbrevs.html" rel="next" title="Abbrevs"> +<link href="Syntax-Tables.html" rel="prev" title="Syntax Tables"> +<style type="text/css"> +<!-- +a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} +a.summary-letter {text-decoration: none} +blockquote.indentedblock {margin-right: 0em} +div.display {margin-left: 3.2em} +div.example {margin-left: 3.2em} +kbd {font-style: oblique} +pre.display {font-family: inherit} +pre.format {font-family: inherit} +pre.menu-comment {font-family: serif} +pre.menu-preformatted {font-family: serif} +span.nolinebreak {white-space: nowrap} +span.roman {font-family: initial; font-weight: normal} +span.sansserif {font-family: sans-serif; font-weight: normal} +span:hover a.copiable-anchor {visibility: visible} +ul.no-bullet {list-style: none} +--> +</style> +<link rel="stylesheet" type="text/css" href="./manual.css"> + + +</head> + +<body lang="en"> +<div class="chapter" id="Parsing-Program-Source"> +<div class="header"> +<p> +Next: <a href="Abbrevs.html" accesskey="n" rel="next">Abbrevs and Abbrev Expansion</a>, Previous: <a href="Syntax-Tables.html" accesskey="p" rel="prev">Syntax Tables</a>, Up: <a href="index.html" accesskey="u" rel="up">Emacs Lisp</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> +<hr> +<span id="Parsing-Program-Source-1"></span><h2 class="chapter">37 Parsing Program Source</h2> + +<span id="index-syntax-tree_002c-from-parsing-program-source"></span> +<p>Emacs provides various ways to parse program source text and produce a +<em>syntax tree</em>. In a syntax tree, text is no longer considered a +one-dimensional stream of characters, but a structured tree of nodes, +where each node representing a piece of text. Thus, a syntax tree can +enable interesting features like precise fontification, indentation, +navigation, structured editing, etc. +</p> +<p>Emacs has a simple facility for parsing balanced expressions +(see <a href="Parsing-Expressions.html">Parsing Expressions</a>). There is also the SMIE library for +generic navigation and indentation (see <a href="SMIE.html">Simple Minded Indentation Engine</a>). +</p> +<p>In addition to those, Emacs also provides integration with +<a href="https://tree-sitter.github.io/tree-sitter">the tree-sitter +library</a>) if support for it was compiled in. The tree-sitter library +implements an incremental parser and has support from a wide range of +programming languages. +</p> +<dl class="def"> +<dt id="index-treesit_002davailable_002dp"><span class="category">Function: </span><span><strong>treesit-available-p</strong><a href='#index-treesit_002davailable_002dp' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns non-<code>nil</code> if tree-sitter features are +available for the current Emacs session. +</p></dd></dl> + +<p>To be able to parse the program source using the tree-sitter library +and access the syntax tree of the program, a Lisp program needs to +load a language definition library, and create a parser for that +language and the current buffer. After that, the Lisp program can +query the parser about specific nodes of the syntax tree. Then, it +can access various kinds of information about each node, and search +for nodes using a powerful pattern-matching syntax. This chapter +explains how to do all this, and also how a Lisp program can work with +source files that mix multiple programming languages. +</p> + +<ul class="section-toc"> +<li><a href="Language-Definitions.html" accesskey="1">Tree-sitter Language Definitions</a></li> +<li><a href="Using-Parser.html" accesskey="2">Using Tree-sitter Parser</a></li> +<li><a href="Retrieving-Nodes.html" accesskey="3">Retrieving Nodes</a></li> +<li><a href="Accessing-Node-Information.html" accesskey="4">Accessing Node Information</a></li> +<li><a href="Pattern-Matching.html" accesskey="5">Pattern Matching Tree-sitter Nodes</a></li> +<li><a href="Multiple-Languages.html" accesskey="6">Parsing Text in Multiple Languages</a></li> +<li><a href="Tree_002dsitter-major-modes.html" accesskey="7">Developing major modes with tree-sitter</a></li> +<li><a href="Tree_002dsitter-C-API.html" accesskey="8">Tree-sitter C API Correspondence</a></li> +</ul> +</div> +<hr> +<div class="header"> +<p> +Next: <a href="Abbrevs.html">Abbrevs and Abbrev Expansion</a>, Previous: <a href="Syntax-Tables.html">Syntax Tables</a>, Up: <a href="index.html">Emacs Lisp</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> + + + +</body> +</html> diff --git a/admin/notes/tree-sitter/html-manual/Pattern-Matching.html b/admin/notes/tree-sitter/html-manual/Pattern-Matching.html new file mode 100644 index 00000000000..21eb4702b12 --- /dev/null +++ b/admin/notes/tree-sitter/html-manual/Pattern-Matching.html @@ -0,0 +1,451 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> +<!-- This is the GNU Emacs Lisp Reference Manual +corresponding to Emacs version 29.0.50. + +Copyright © 1990-1996, 1998-2022 Free Software Foundation, +Inc. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with the +Invariant Sections being "GNU General Public License," with the +Front-Cover Texts being "A GNU Manual," and with the Back-Cover +Texts as in (a) below. A copy of the license is included in the +section entitled "GNU Free Documentation License." + +(a) The FSF's Back-Cover Text is: "You have the freedom to copy and +modify this GNU manual. Buying copies from the FSF supports it in +developing GNU and promoting software freedom." --> +<title>Pattern Matching (GNU Emacs Lisp Reference Manual)</title> + +<meta name="description" content="Pattern Matching (GNU Emacs Lisp Reference Manual)"> +<meta name="keywords" content="Pattern Matching (GNU Emacs Lisp Reference Manual)"> +<meta name="resource-type" content="document"> +<meta name="distribution" content="global"> +<meta name="Generator" content="makeinfo"> +<meta name="viewport" content="width=device-width,initial-scale=1"> + +<link href="index.html" rel="start" title="Top"> +<link href="Index.html" rel="index" title="Index"> +<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> +<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> +<link href="Multiple-Languages.html" rel="next" title="Multiple Languages"> +<link href="Accessing-Node-Information.html" rel="prev" title="Accessing Node Information"> +<style type="text/css"> +<!-- +a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} +a.summary-letter {text-decoration: none} +blockquote.indentedblock {margin-right: 0em} +div.display {margin-left: 3.2em} +div.example {margin-left: 3.2em} +kbd {font-style: oblique} +pre.display {font-family: inherit} +pre.format {font-family: inherit} +pre.menu-comment {font-family: serif} +pre.menu-preformatted {font-family: serif} +span.nolinebreak {white-space: nowrap} +span.roman {font-family: initial; font-weight: normal} +span.sansserif {font-family: sans-serif; font-weight: normal} +span:hover a.copiable-anchor {visibility: visible} +ul.no-bullet {list-style: none} +--> +</style> +<link rel="stylesheet" type="text/css" href="./manual.css"> + + +</head> + +<body lang="en"> +<div class="section" id="Pattern-Matching"> +<div class="header"> +<p> +Next: <a href="Multiple-Languages.html" accesskey="n" rel="next">Parsing Text in Multiple Languages</a>, Previous: <a href="Accessing-Node-Information.html" accesskey="p" rel="prev">Accessing Node Information</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> +<hr> +<span id="Pattern-Matching-Tree_002dsitter-Nodes"></span><h3 class="section">37.5 Pattern Matching Tree-sitter Nodes</h3> +<span id="index-pattern-matching-with-tree_002dsitter-nodes"></span> + +<span id="index-capturing_002c-tree_002dsitter-node"></span> +<p>Tree-sitter lets Lisp programs match patterns using a small +declarative language. This pattern matching consists of two steps: +first tree-sitter matches a <em>pattern</em> against nodes in the syntax +tree, then it <em>captures</em> specific nodes that matched the pattern +and returns the captured nodes. +</p> +<p>We describe first how to write the most basic query pattern and how to +capture nodes in a pattern, then the pattern-matching function, and +finally the more advanced pattern syntax. +</p> +<span id="Basic-query-syntax"></span><h3 class="heading">Basic query syntax</h3> + +<span id="index-tree_002dsitter-query-pattern-syntax"></span> +<span id="index-pattern-syntax_002c-tree_002dsitter-query"></span> +<span id="index-query_002c-tree_002dsitter"></span> +<p>A <em>query</em> consists of multiple <em>patterns</em>. Each pattern is an +s-expression that matches a certain node in the syntax node. A +pattern has the form <code>(<var>type</var> (<var>child</var>…))</code><!-- /@w --> +</p> +<p>For example, a pattern that matches a <code>binary_expression</code> node that +contains <code>number_literal</code> child nodes would look like +</p> +<div class="example"> +<pre class="example">(binary_expression (number_literal)) +</pre></div> + +<p>To <em>capture</em> a node using the query pattern above, append +<code>@<var>capture-name</var></code> after the node pattern you want to +capture. For example, +</p> +<div class="example"> +<pre class="example">(binary_expression (number_literal) @number-in-exp) +</pre></div> + +<p>captures <code>number_literal</code> nodes that are inside a +<code>binary_expression</code> node with the capture name +<code>number-in-exp</code>. +</p> +<p>We can capture the <code>binary_expression</code> node as well, with, for +example, the capture name <code>biexp</code>: +</p> +<div class="example"> +<pre class="example">(binary_expression + (number_literal) @number-in-exp) @biexp +</pre></div> + +<span id="Query-function"></span><h3 class="heading">Query function</h3> + +<span id="index-query-functions_002c-tree_002dsitter"></span> +<p>Now we can introduce the <em>query functions</em>. +</p> +<dl class="def"> +<dt id="index-treesit_002dquery_002dcapture"><span class="category">Function: </span><span><strong>treesit-query-capture</strong> <em>node query &optional beg end node-only</em><a href='#index-treesit_002dquery_002dcapture' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function matches patterns in <var>query</var> within <var>node</var>. +The argument <var>query</var> can be either a string, a s-expression, or a +compiled query object. For now, we focus on the string syntax; +s-expression syntax and compiled query are described at the end of the +section. +</p> +<p>The argument <var>node</var> can also be a parser or a language symbol. A +parser means using its root node, a language symbol means find or +create a parser for that language in the current buffer, and use the +root node. +</p> +<p>The function returns all the captured nodes in a list of the form +<code>(<var><span class="nolinebreak">capture_name</span></var> . <var>node</var>)</code><!-- /@w -->. If <var>node-only</var> is +non-<code>nil</code>, it returns the list of nodes instead. By default the +entire text of <var>node</var> is searched, but if <var>beg</var> and <var>end</var> +are both non-<code>nil</code>, they specify the region of buffer text where +this function should match nodes. Any matching node whose span +overlaps with the region between <var>beg</var> and <var>end</var> are captured, +it doesn’t have to be completely in the region. +</p> +<span id="index-treesit_002dquery_002derror"></span> +<span id="index-treesit_002dquery_002dvalidate"></span> +<p>This function raises the <code>treesit-query-error</code> error if +<var>query</var> is malformed. The signal data contains a description of +the specific error. You can use <code>treesit-query-validate</code> to +validate and debug the query. +</p></dd></dl> + +<p>For example, suppose <var>node</var>’s text is <code>1 + 2</code>, and +<var>query</var> is +</p> +<div class="example"> +<pre class="example">(setq query + "(binary_expression + (number_literal) @number-in-exp) @biexp") +</pre></div> + +<p>Matching that query would return +</p> +<div class="example"> +<pre class="example">(treesit-query-capture node query) + ⇒ ((biexp . <var><node for "1 + 2"></var>) + (number-in-exp . <var><node for "1"></var>) + (number-in-exp . <var><node for "2"></var>)) +</pre></div> + +<p>As mentioned earlier, <var>query</var> could contain multiple patterns. +For example, it could have two top-level patterns: +</p> +<div class="example"> +<pre class="example">(setq query + "(binary_expression) @biexp + (number_literal) @number @biexp") +</pre></div> + +<dl class="def"> +<dt id="index-treesit_002dquery_002dstring"><span class="category">Function: </span><span><strong>treesit-query-string</strong> <em>string query language</em><a href='#index-treesit_002dquery_002dstring' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function parses <var>string</var> with <var>language</var>, matches its +root node with <var>query</var>, and returns the result. +</p></dd></dl> + +<span id="More-query-syntax"></span><h3 class="heading">More query syntax</h3> + +<p>Besides node type and capture, tree-sitter’s pattern syntax can +express anonymous node, field name, wildcard, quantification, +grouping, alternation, anchor, and predicate. +</p> +<span id="Anonymous-node"></span><h4 class="subheading">Anonymous node</h4> + +<p>An anonymous node is written verbatim, surrounded by quotes. A +pattern matching (and capturing) keyword <code>return</code> would be +</p> +<div class="example"> +<pre class="example">"return" @keyword +</pre></div> + +<span id="Wild-card"></span><h4 class="subheading">Wild card</h4> + +<p>In a pattern, ‘<samp>(_)</samp>’ matches any named node, and ‘<samp>_</samp>’ matches +any named and anonymous node. For example, to capture any named child +of a <code>binary_expression</code> node, the pattern would be +</p> +<div class="example"> +<pre class="example">(binary_expression (_) @in_biexp) +</pre></div> + +<span id="Field-name"></span><h4 class="subheading">Field name</h4> + +<p>It is possible to capture child nodes that have specific field names. +In the pattern below, <code>declarator</code> and <code>body</code> are field +names, indicated by the colon following them. +</p> +<div class="example"> +<pre class="example">(function_definition + declarator: (_) @func-declarator + body: (_) @func-body) +</pre></div> + +<p>It is also possible to capture a node that doesn’t have a certain +field, say, a <code>function_definition</code> without a <code>body</code> field. +</p> +<div class="example"> +<pre class="example">(function_definition !body) @func-no-body +</pre></div> + +<span id="Quantify-node"></span><h4 class="subheading">Quantify node</h4> + +<span id="index-quantify-node_002c-tree_002dsitter"></span> +<p>Tree-sitter recognizes quantification operators ‘<samp>*</samp>’, ‘<samp>+</samp>’ and +‘<samp>?</samp>’. Their meanings are the same as in regular expressions: +‘<samp>*</samp>’ matches the preceding pattern zero or more times, ‘<samp>+</samp>’ +matches one or more times, and ‘<samp>?</samp>’ matches zero or one time. +</p> +<p>For example, the following pattern matches <code>type_declaration</code> +nodes that has <em>zero or more</em> <code>long</code> keyword. +</p> +<div class="example"> +<pre class="example">(type_declaration "long"*) @long-type +</pre></div> + +<p>The following pattern matches a type declaration that has zero or one +<code>long</code> keyword: +</p> +<div class="example"> +<pre class="example">(type_declaration "long"?) @long-type +</pre></div> + +<span id="Grouping"></span><h4 class="subheading">Grouping</h4> + +<p>Similar to groups in regular expression, we can bundle patterns into +groups and apply quantification operators to them. For example, to +express a comma separated list of identifiers, one could write +</p> +<div class="example"> +<pre class="example">(identifier) ("," (identifier))* +</pre></div> + +<span id="Alternation"></span><h4 class="subheading">Alternation</h4> + +<p>Again, similar to regular expressions, we can express “match anyone +from this group of patterns” in a pattern. The syntax is a list of +patterns enclosed in square brackets. For example, to capture some +keywords in C, the pattern would be +</p> +<div class="example"> +<pre class="example">[ + "return" + "break" + "if" + "else" +] @keyword +</pre></div> + +<span id="Anchor"></span><h4 class="subheading">Anchor</h4> + +<p>The anchor operator ‘<samp>.</samp>’ can be used to enforce juxtaposition, +i.e., to enforce two things to be directly next to each other. The +two “things” can be two nodes, or a child and the end of its parent. +For example, to capture the first child, the last child, or two +adjacent children: +</p> +<div class="example"> +<pre class="example">;; Anchor the child with the end of its parent. +(compound_expression (_) @last-child .) +</pre><pre class="example"> + +</pre><pre class="example">;; Anchor the child with the beginning of its parent. +(compound_expression . (_) @first-child) +</pre><pre class="example"> + +</pre><pre class="example">;; Anchor two adjacent children. +(compound_expression + (_) @prev-child + . + (_) @next-child) +</pre></div> + +<p>Note that the enforcement of juxtaposition ignores any anonymous +nodes. +</p> +<span id="Predicate"></span><h4 class="subheading">Predicate</h4> + +<p>It is possible to add predicate constraints to a pattern. For +example, with the following pattern: +</p> +<div class="example"> +<pre class="example">( + (array . (_) @first (_) @last .) + (#equal @first @last) +) +</pre></div> + +<p>tree-sitter only matches arrays where the first element equals to +the last element. To attach a predicate to a pattern, we need to +group them together. A predicate always starts with a ‘<samp>#</samp>’. +Currently there are two predicates, <code>#equal</code> and <code>#match</code>. +</p> +<dl class="def"> +<dt id="index-equal-1"><span class="category">Predicate: </span><span><strong>equal</strong> <em>arg1 arg2</em><a href='#index-equal-1' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>Matches if <var>arg1</var> equals to <var>arg2</var>. Arguments can be either +strings or capture names. Capture names represent the text that the +captured node spans in the buffer. +</p></dd></dl> + +<dl class="def"> +<dt id="index-match-1"><span class="category">Predicate: </span><span><strong>match</strong> <em>regexp capture-name</em><a href='#index-match-1' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>Matches if the text that <var>capture-name</var>’s node spans in the buffer +matches regular expression <var>regexp</var>. Matching is case-sensitive. +</p></dd></dl> + +<p>Note that a predicate can only refer to capture names that appear in +the same pattern. Indeed, it makes little sense to refer to capture +names in other patterns. +</p> +<span id="S_002dexpression-patterns"></span><h3 class="heading">S-expression patterns</h3> + +<span id="index-tree_002dsitter-patterns-as-sexps"></span> +<span id="index-patterns_002c-tree_002dsitter_002c-in-sexp-form"></span> +<p>Besides strings, Emacs provides a s-expression based syntax for +tree-sitter patterns. It largely resembles the string-based syntax. +For example, the following query +</p> +<div class="example"> +<pre class="example">(treesit-query-capture + node "(addition_expression + left: (_) @left + \"+\" @plus-sign + right: (_) @right) @addition + + [\"return\" \"break\"] @keyword") +</pre></div> + +<p>is equivalent to +</p> +<div class="example"> +<pre class="example">(treesit-query-capture + node '((addition_expression + left: (_) @left + "+" @plus-sign + right: (_) @right) @addition + + ["return" "break"] @keyword)) +</pre></div> + +<p>Most patterns can be written directly as strange but nevertheless +valid s-expressions. Only a few of them needs modification: +</p> +<ul> +<li> Anchor ‘<samp>.</samp>’ is written as <code>:anchor</code>. +</li><li> ‘<samp>?</samp>’ is written as ‘<samp>:?</samp>’. +</li><li> ‘<samp>*</samp>’ is written as ‘<samp>:*</samp>’. +</li><li> ‘<samp>+</samp>’ is written as ‘<samp>:+</samp>’. +</li><li> <code>#equal</code> is written as <code>:equal</code>. In general, predicates +change their ‘<samp>#</samp>’ to ‘<samp>:</samp>’. +</li></ul> + +<p>For example, +</p> +<div class="example"> +<pre class="example">"( + (compound_expression . (_) @first (_)* @rest) + (#match \"love\" @first) + )" +</pre></div> + +<p>is written in s-expression as +</p> +<div class="example"> +<pre class="example">'(( + (compound_expression :anchor (_) @first (_) :* @rest) + (:match "love" @first) + )) +</pre></div> + +<span id="Compiling-queries"></span><h3 class="heading">Compiling queries</h3> + +<span id="index-compiling-tree_002dsitter-queries"></span> +<span id="index-queries_002c-compiling"></span> +<p>If a query is intended to be used repeatedly, especially in tight +loops, it is important to compile that query, because a compiled query +is much faster than an uncompiled one. A compiled query can be used +anywhere a query is accepted. +</p> +<dl class="def"> +<dt id="index-treesit_002dquery_002dcompile"><span class="category">Function: </span><span><strong>treesit-query-compile</strong> <em>language query</em><a href='#index-treesit_002dquery_002dcompile' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function compiles <var>query</var> for <var>language</var> into a compiled +query object and returns it. +</p> +<p>This function raises the <code>treesit-query-error</code> error if +<var>query</var> is malformed. The signal data contains a description of +the specific error. You can use <code>treesit-query-validate</code> to +validate and debug the query. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dquery_002dlanguage"><span class="category">Function: </span><span><strong>treesit-query-language</strong> <em>query</em><a href='#index-treesit_002dquery_002dlanguage' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function return the language of <var>query</var>. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dquery_002dexpand"><span class="category">Function: </span><span><strong>treesit-query-expand</strong> <em>query</em><a href='#index-treesit_002dquery_002dexpand' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function converts the s-expression <var>query</var> into the string +format. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dpattern_002dexpand"><span class="category">Function: </span><span><strong>treesit-pattern-expand</strong> <em>pattern</em><a href='#index-treesit_002dpattern_002dexpand' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function converts the s-expression <var>pattern</var> into the string +format. +</p></dd></dl> + +<p>For more details, read the tree-sitter project’s documentation about +pattern-matching, which can be found at +<a href="https://tree-sitter.github.io/tree-sitter/using-parsers#pattern-matching-with-queries">https://tree-sitter.github.io/tree-sitter/using-parsers#pattern-matching-with-queries</a>. +</p> +</div> +<hr> +<div class="header"> +<p> +Next: <a href="Multiple-Languages.html">Parsing Text in Multiple Languages</a>, Previous: <a href="Accessing-Node-Information.html">Accessing Node Information</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> + + + +</body> +</html> diff --git a/admin/notes/tree-sitter/html-manual/Retrieving-Node.html b/admin/notes/tree-sitter/html-manual/Retrieving-Node.html new file mode 100644 index 00000000000..0c086dab91d --- /dev/null +++ b/admin/notes/tree-sitter/html-manual/Retrieving-Node.html @@ -0,0 +1,421 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> +<!-- This is the GNU Emacs Lisp Reference Manual +corresponding to Emacs version 29.0.50. + +Copyright © 1990-1996, 1998-2022 Free Software Foundation, +Inc. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with the +Invariant Sections being "GNU General Public License," with the +Front-Cover Texts being "A GNU Manual," and with the Back-Cover +Texts as in (a) below. A copy of the license is included in the +section entitled "GNU Free Documentation License." + +(a) The FSF's Back-Cover Text is: "You have the freedom to copy and +modify this GNU manual. Buying copies from the FSF supports it in +developing GNU and promoting software freedom." --> +<title>Retrieving Node (GNU Emacs Lisp Reference Manual)</title> + +<meta name="description" content="Retrieving Node (GNU Emacs Lisp Reference Manual)"> +<meta name="keywords" content="Retrieving Node (GNU Emacs Lisp Reference Manual)"> +<meta name="resource-type" content="document"> +<meta name="distribution" content="global"> +<meta name="Generator" content="makeinfo"> +<meta name="viewport" content="width=device-width,initial-scale=1"> + +<link href="index.html" rel="start" title="Top"> +<link href="Index.html" rel="index" title="Index"> +<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> +<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> +<link href="Accessing-Node-Information.html" rel="next" title="Accessing Node Information"> +<link href="Using-Parser.html" rel="prev" title="Using Parser"> +<style type="text/css"> +<!-- +a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} +a.summary-letter {text-decoration: none} +blockquote.indentedblock {margin-right: 0em} +div.display {margin-left: 3.2em} +div.example {margin-left: 3.2em} +kbd {font-style: oblique} +pre.display {font-family: inherit} +pre.format {font-family: inherit} +pre.menu-comment {font-family: serif} +pre.menu-preformatted {font-family: serif} +span.nolinebreak {white-space: nowrap} +span.roman {font-family: initial; font-weight: normal} +span.sansserif {font-family: sans-serif; font-weight: normal} +span:hover a.copiable-anchor {visibility: visible} +ul.no-bullet {list-style: none} +--> +</style> +<link rel="stylesheet" type="text/css" href="./manual.css"> + + +</head> + +<body lang="en"> +<div class="section" id="Retrieving-Node"> +<div class="header"> +<p> +Next: <a href="Accessing-Node-Information.html" accesskey="n" rel="next">Accessing Node Information</a>, Previous: <a href="Using-Parser.html" accesskey="p" rel="prev">Using Tree-sitter Parser</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> +<hr> +<span id="Retrieving-Node-1"></span><h3 class="section">37.3 Retrieving Node</h3> +<span id="index-retrieve-node_002c-tree_002dsitter"></span> +<span id="index-tree_002dsitter_002c-find-node"></span> +<span id="index-get-node_002c-tree_002dsitter"></span> + +<span id="index-terminology_002c-for-tree_002dsitter-functions"></span> +<p>Here’s some terminology and conventions we use when documenting +tree-sitter functions. +</p> +<p>We talk about a node being “smaller” or “larger”, and “lower” or +“higher”. A smaller and lower node is lower in the syntax tree and +therefore spans a smaller portion of buffer text; a larger and higher +node is higher up in the syntax tree, it contains many smaller nodes +as its children, and therefore spans a larger portion of text. +</p> +<p>When a function cannot find a node, it returns <code>nil</code>. For +convenience, all functions that take a node as argument and return +a node, also accept the node argument of <code>nil</code> and in that case +just return <code>nil</code>. +</p> +<span id="index-treesit_002dnode_002doutdated"></span> +<p>Nodes are not automatically updated when the associated buffer is +modified, and there is no way to update a node once it is retrieved. +Using an outdated node signals the <code>treesit-node-outdated</code> error. +</p> +<span id="Retrieving-node-from-syntax-tree"></span><h3 class="heading">Retrieving node from syntax tree</h3> +<span id="index-retrieving-tree_002dsitter-nodes"></span> +<span id="index-syntax-tree_002c-retrieving-nodes"></span> + +<dl class="def"> +<dt id="index-treesit_002dnode_002dat"><span class="category">Function: </span><span><strong>treesit-node-at</strong> <em>pos &optional parser-or-lang named</em><a href='#index-treesit_002dnode_002dat' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the <em>smallest</em> node that starts at or after +the buffer position <var>pos</var>. In other words, the start of the node +is greater or equal to <var>pos</var>. +</p> +<p>When <var>parser-or-lang</var> is <code>nil</code> or omitted, this function uses +the first parser in <code>(treesit-parser-list)</code> of the current +buffer. If <var>parser-or-lang</var> is a parser object, it uses that +parser; if <var>parser-or-lang</var> is a language, it finds the first +parser using that language in <code>(treesit-parser-list)</code>, and uses +that. +</p> +<p>If <var>named</var> is non-<code>nil</code>, this function looks for a named node +only (see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). +</p> +<p>When <var>pos</var> is after all the text in the buffer, technically there +is no node after <var>pos</var>. But for convenience, this function will +return the last leaf node in the parse tree. If <var>strict</var> is +non-<code>nil</code>, this function will strictly comply to the semantics and +return <var>nil</var>. +</p> +<p>Example: +</p> +<div class="example"> +<pre class="example">;; Find the node at point in a C parser's syntax tree. +(treesit-node-at (point) 'c) + ⇒ #<treesit-node (primitive_type) in 23-27> +</pre></div> +</dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnode_002don"><span class="category">Function: </span><span><strong>treesit-node-on</strong> <em>beg end &optional parser-or-lang named</em><a href='#index-treesit_002dnode_002don' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the <em>smallest</em> node that covers the region +of buffer text between <var>beg</var> and <var>end</var>. In other words, the +start of the node is before or at <var>beg</var>, and the end of the node +is at or after <var>end</var>. +</p> +<p><em>Beware:</em> calling this function on an empty line that is not +inside any top-level construct (function definition, etc.) most +probably will give you the root node, because the root node is the +smallest node that covers that empty line. Most of the time, you want +to use <code>treesit-node-at</code>, described above, instead. +</p> +<p>When <var>parser-or-lang</var> is <code>nil</code>, this function uses the first +parser in <code>(treesit-parser-list)</code> of the current buffer. If +<var>parser-or-lang</var> is a parser object, it uses that parser; if +<var>parser-or-lang</var> is a language, it finds the first parser using +that language in <code>(treesit-parser-list)</code>, and uses that. +</p> +<p>If <var>named</var> is non-<code>nil</code>, this function looks for a named node +only (see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dparser_002droot_002dnode"><span class="category">Function: </span><span><strong>treesit-parser-root-node</strong> <em>parser</em><a href='#index-treesit_002dparser_002droot_002dnode' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the root node of the syntax tree generated by +<var>parser</var>. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dbuffer_002droot_002dnode"><span class="category">Function: </span><span><strong>treesit-buffer-root-node</strong> <em>&optional language</em><a href='#index-treesit_002dbuffer_002droot_002dnode' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function finds the first parser that uses <var>language</var> in +<code>(treesit-parser-list)</code> of the current buffer, and returns the +root node generated by that parser. If it cannot find an appropriate +parser, it returns <code>nil</code>. +</p></dd></dl> + +<p>Given a node, a Lisp program can retrieve other nodes starting from +it, or query for information about this node. +</p> +<span id="Retrieving-node-from-other-nodes"></span><h3 class="heading">Retrieving node from other nodes</h3> +<span id="index-syntax-tree-nodes_002c-retrieving-from-other-nodes"></span> + +<span id="By-kinship"></span><h4 class="subheading">By kinship</h4> +<span id="index-kinship_002c-syntax-tree-nodes"></span> +<span id="index-nodes_002c-by-kinship"></span> +<span id="index-syntax-tree-nodes_002c-by-kinship"></span> + +<dl class="def"> +<dt id="index-treesit_002dnode_002dparent"><span class="category">Function: </span><span><strong>treesit-node-parent</strong> <em>node</em><a href='#index-treesit_002dnode_002dparent' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the immediate parent of <var>node</var>. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnode_002dchild"><span class="category">Function: </span><span><strong>treesit-node-child</strong> <em>node n &optional named</em><a href='#index-treesit_002dnode_002dchild' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the <var>n</var>’th child of <var>node</var>. If +<var>named</var> is non-<code>nil</code>, it counts only named nodes +(see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). +</p> +<p>For example, in a node that represents a string <code>"text"</code>, there +are three children nodes: the opening quote <code>"</code>, the string text +<code>text</code>, and the closing quote <code>"</code>. Among these nodes, the +first child is the opening quote <code>"</code>, and the first named child +is the string text. +</p> +<p>This function returns <code>nil</code> if there is no <var>n</var>’th child. +<var>n</var> could be negative, e.g., <code>-1</code> represents the last child. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnode_002dchildren"><span class="category">Function: </span><span><strong>treesit-node-children</strong> <em>node &optional named</em><a href='#index-treesit_002dnode_002dchildren' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns all of <var>node</var>’s children as a list. If +<var>named</var> is non-<code>nil</code>, it retrieves only named nodes. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnext_002dsibling"><span class="category">Function: </span><span><strong>treesit-next-sibling</strong> <em>node &optional named</em><a href='#index-treesit_002dnext_002dsibling' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function finds the next sibling of <var>node</var>. If <var>named</var> is +non-<code>nil</code>, it finds the next named sibling. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dprev_002dsibling"><span class="category">Function: </span><span><strong>treesit-prev-sibling</strong> <em>node &optional named</em><a href='#index-treesit_002dprev_002dsibling' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function finds the previous sibling of <var>node</var>. If +<var>named</var> is non-<code>nil</code>, it finds the previous named sibling. +</p></dd></dl> + +<span id="By-field-name"></span><h4 class="subheading">By field name</h4> +<span id="index-nodes_002c-by-field-name"></span> +<span id="index-syntax-tree-nodes_002c-by-field-name"></span> + +<p>To make the syntax tree easier to analyze, many language definitions +assign <em>field names</em> to child nodes (see <a href="Language-Definitions.html#tree_002dsitter-node-field-name">field name</a>). For example, a <code>function_definition</code> node +could have a <code>declarator</code> node and a <code>body</code> node. +</p> +<dl class="def"> +<dt id="index-treesit_002dchild_002dby_002dfield_002dname"><span class="category">Function: </span><span><strong>treesit-child-by-field-name</strong> <em>node field-name</em><a href='#index-treesit_002dchild_002dby_002dfield_002dname' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function finds the child of <var>node</var> whose field name is +<var>field-name</var>, a string. +</p> +<div class="example"> +<pre class="example">;; Get the child that has "body" as its field name. +(treesit-child-by-field-name node "body") + ⇒ #<treesit-node (compound_statement) in 45-89> +</pre></div> +</dd></dl> + +<span id="By-position"></span><h4 class="subheading">By position</h4> +<span id="index-nodes_002c-by-position"></span> +<span id="index-syntax-tree-nodes_002c-by-position"></span> + +<dl class="def"> +<dt id="index-treesit_002dfirst_002dchild_002dfor_002dpos"><span class="category">Function: </span><span><strong>treesit-first-child-for-pos</strong> <em>node pos &optional named</em><a href='#index-treesit_002dfirst_002dchild_002dfor_002dpos' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function finds the first child of <var>node</var> that extends beyond +buffer position <var>pos</var>. “Extends beyond” means the end of the +child node is greater or equal to <var>pos</var>. This function only looks +for immediate children of <var>node</var>, and doesn’t look in its +grandchildren. If <var>named</var> is non-<code>nil</code>, it looks for the +first named child (see <a href="Language-Definitions.html#tree_002dsitter-named-node">named node</a>). +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnode_002ddescendant_002dfor_002drange"><span class="category">Function: </span><span><strong>treesit-node-descendant-for-range</strong> <em>node beg end &optional named</em><a href='#index-treesit_002dnode_002ddescendant_002dfor_002drange' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function finds the <em>smallest</em> descendant node of <var>node</var> +that spans the region of text between positions <var>beg</var> and +<var>end</var>. It is similar to <code>treesit-node-at</code>. If <var>named</var> +is non-<code>nil</code>, it looks for smallest named child. +</p></dd></dl> + +<span id="Searching-for-node"></span><h3 class="heading">Searching for node</h3> + +<dl class="def"> +<dt id="index-treesit_002dsearch_002dsubtree"><span class="category">Function: </span><span><strong>treesit-search-subtree</strong> <em>node predicate &optional backward all limit</em><a href='#index-treesit_002dsearch_002dsubtree' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function traverses the subtree of <var>node</var> (including +<var>node</var> itself), looking for a node for which <var>predicate</var> +returns non-<code>nil</code>. <var>predicate</var> is a regexp that is matched +against each node’s type, or a predicate function that takes a node +and returns non-<code>nil</code> if the node matches. The function returns +the first node that matches, or <code>nil</code> if none does. +</p> +<p>By default, this function only traverses named nodes, but if <var>all</var> +is non-<code>nil</code>, it traverses all the nodes. If <var>backward</var> is +non-<code>nil</code>, it traverses backwards (i.e., it visits the last child first +when traversing down the tree). If <var>limit</var> is non-<code>nil</code>, it +must be a number that limits the tree traversal to that many levels +down the tree. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dsearch_002dforward"><span class="category">Function: </span><span><strong>treesit-search-forward</strong> <em>start predicate &optional backward all</em><a href='#index-treesit_002dsearch_002dforward' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>Like <code>treesit-search-subtree</code>, this function also traverses the +parse tree and matches each node with <var>predicate</var> (except for +<var>start</var>), where <var>predicate</var> can be a regexp or a function. +For a tree like the below where <var>start</var> is marked S, this function +traverses as numbered from 1 to 12: +</p> +<div class="example"> +<pre class="example"> 12 + | + S--------3----------11 + | | | +o--o-+--o 1--+--2 6--+-----10 +| | | | +o o +-+-+ +--+--+ + | | | | | + 4 5 7 8 9 +</pre></div> + +<p>Note that this function doesn’t traverse the subtree of <var>start</var>, +and it always traverse leaf nodes first, then upwards. +</p> +<p>Like <code>treesit-search-subtree</code>, this function only searches for +named nodes by default, but if <var>all</var> is non-<code>nil</code>, it +searches for all nodes. If <var>backward</var> is non-<code>nil</code>, it +searches backwards. +</p> +<p>While <code>treesit-search-subtree</code> traverses the subtree of a node, +this function starts with node <var>start</var> and traverses every node +that comes after it in the buffer position order, i.e., nodes with +start positions greater than the end position of <var>start</var>. +</p> +<p>In the tree shown above, <code>treesit-search-subtree</code> traverses node +S (<var>start</var>) and nodes marked with <code>o</code>, where this function +traverses the nodes marked with numbers. This function is useful for +answering questions like “what is the first node after <var>start</var> in +the buffer that satisfies some condition?” +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dsearch_002dforward_002dgoto"><span class="category">Function: </span><span><strong>treesit-search-forward-goto</strong> <em>node predicate &optional start backward all</em><a href='#index-treesit_002dsearch_002dforward_002dgoto' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function moves point to the start or end of the next node after +<var>node</var> in the buffer that matches <var>predicate</var>. If <var>start</var> +is non-<code>nil</code>, stop at the beginning rather than the end of a node. +</p> +<p>This function guarantees that the matched node it returns makes +progress in terms of buffer position: the start/end position of the +returned node is always greater than that of <var>node</var>. +</p> +<p>Arguments <var>predicate</var>, <var>backward</var> and <var>all</var> are the same +as in <code>treesit-search-forward</code>. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dinduce_002dsparse_002dtree"><span class="category">Function: </span><span><strong>treesit-induce-sparse-tree</strong> <em>root predicate &optional process-fn limit</em><a href='#index-treesit_002dinduce_002dsparse_002dtree' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function creates a sparse tree from <var>root</var>’s subtree. +</p> +<p>It takes the subtree under <var>root</var>, and combs it so only the nodes +that match <var>predicate</var> are left. Like previous functions, the +<var>predicate</var> can be a regexp string that matches against each +node’s type, or a function that takes a node and return non-<code>nil</code> +if it matches. +</p> +<p>For example, for a subtree on the left that consist of both numbers +and letters, if <var>predicate</var> is “letter only”, the returned tree +is the one on the right. +</p> +<div class="example"> +<pre class="example"> a a a + | | | ++---+---+ +---+---+ +---+---+ +| | | | | | | | | +b 1 2 b | | b c d + | | => | | => | + c +--+ c + e + | | | | | + +--+ d 4 +--+ d + | | | + e 5 e +</pre></div> + +<p>If <var>process-fn</var> is non-<code>nil</code>, instead of returning the matched +nodes, this function passes each node to <var>process-fn</var> and uses the +returned value instead. If non-<code>nil</code>, <var>limit</var> is the number of +levels to go down from <var>root</var>. +</p> +<p>Each node in the returned tree looks like +<code>(<var><span class="nolinebreak">tree-sitter-node</span></var> . (<var>child</var> …))</code><!-- /@w -->. The +<var>tree-sitter-node</var> of the root of this tree will be nil if +<var>root</var> doesn’t match <var>predicate</var>. If no node matches +<var>predicate</var>, the function returns <code>nil</code>. +</p></dd></dl> + +<span id="More-convenience-functions"></span><h3 class="heading">More convenience functions</h3> + +<dl class="def"> +<dt id="index-treesit_002dfilter_002dchild"><span class="category">Function: </span><span><strong>treesit-filter-child</strong> <em>node predicate &optional named</em><a href='#index-treesit_002dfilter_002dchild' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function finds immediate children of <var>node</var> that satisfy +<var>predicate</var>. +</p> +<p>The <var>predicate</var> function takes a node as the argument and should +return non-<code>nil</code> to indicate that the node should be kept. If +<var>named</var> is non-<code>nil</code>, this function only examines the named +nodes. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dparent_002duntil"><span class="category">Function: </span><span><strong>treesit-parent-until</strong> <em>node predicate</em><a href='#index-treesit_002dparent_002duntil' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function repeatedly finds the parents of <var>node</var>, and returns +the parent that satisfies <var>predicate</var>, a function that takes a +node as the argument. If no parent satisfies <var>predicate</var>, this +function returns <code>nil</code>. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dparent_002dwhile"><span class="category">Function: </span><span><strong>treesit-parent-while</strong> <em>node predicate</em><a href='#index-treesit_002dparent_002dwhile' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function repeatedly finds the parent of <var>node</var>, and keeps +doing so as long as the nodes satisfy <var>predicate</var>, a function that +takes a node as the argument. That is, this function returns the +farthest parent that still satisfies <var>predicate</var>. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dnode_002dtop_002dlevel"><span class="category">Function: </span><span><strong>treesit-node-top-level</strong> <em>node &optional type</em><a href='#index-treesit_002dnode_002dtop_002dlevel' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the highest parent of <var>node</var> that has the +same type as <var>node</var>. If no such parent exists, it returns +<code>nil</code>. Therefore this function is also useful for testing +whether <var>node</var> is top-level. +</p> +<p>If <var>type</var> is non-<code>nil</code>, this function matches each parent’s +type with <var>type</var> as a regexp, rather than using <var>node</var>’s type. +</p></dd></dl> + +</div> +<hr> +<div class="header"> +<p> +Next: <a href="Accessing-Node-Information.html">Accessing Node Information</a>, Previous: <a href="Using-Parser.html">Using Tree-sitter Parser</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> + + + +</body> +</html> diff --git a/admin/notes/tree-sitter/html-manual/Tree_002dsitter-C-API.html b/admin/notes/tree-sitter/html-manual/Tree_002dsitter-C-API.html new file mode 100644 index 00000000000..29d51eecf73 --- /dev/null +++ b/admin/notes/tree-sitter/html-manual/Tree_002dsitter-C-API.html @@ -0,0 +1,212 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> +<!-- This is the GNU Emacs Lisp Reference Manual +corresponding to Emacs version 29.0.50. + +Copyright © 1990-1996, 1998-2022 Free Software Foundation, +Inc. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with the +Invariant Sections being "GNU General Public License," with the +Front-Cover Texts being "A GNU Manual," and with the Back-Cover +Texts as in (a) below. A copy of the license is included in the +section entitled "GNU Free Documentation License." + +(a) The FSF's Back-Cover Text is: "You have the freedom to copy and +modify this GNU manual. Buying copies from the FSF supports it in +developing GNU and promoting software freedom." --> +<title>Tree-sitter C API (GNU Emacs Lisp Reference Manual)</title> + +<meta name="description" content="Tree-sitter C API (GNU Emacs Lisp Reference Manual)"> +<meta name="keywords" content="Tree-sitter C API (GNU Emacs Lisp Reference Manual)"> +<meta name="resource-type" content="document"> +<meta name="distribution" content="global"> +<meta name="Generator" content="makeinfo"> +<meta name="viewport" content="width=device-width,initial-scale=1"> + +<link href="index.html" rel="start" title="Top"> +<link href="Index.html" rel="index" title="Index"> +<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> +<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> +<link href="Tree_002dsitter-major-modes.html" rel="prev" title="Tree-sitter major modes"> +<style type="text/css"> +<!-- +a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} +a.summary-letter {text-decoration: none} +blockquote.indentedblock {margin-right: 0em} +div.display {margin-left: 3.2em} +div.example {margin-left: 3.2em} +kbd {font-style: oblique} +pre.display {font-family: inherit} +pre.format {font-family: inherit} +pre.menu-comment {font-family: serif} +pre.menu-preformatted {font-family: serif} +span.nolinebreak {white-space: nowrap} +span.roman {font-family: initial; font-weight: normal} +span.sansserif {font-family: sans-serif; font-weight: normal} +span:hover a.copiable-anchor {visibility: visible} +ul.no-bullet {list-style: none} +--> +</style> +<link rel="stylesheet" type="text/css" href="./manual.css"> + + +</head> + +<body lang="en"> +<div class="section" id="Tree_002dsitter-C-API"> +<div class="header"> +<p> +Previous: <a href="Tree_002dsitter-major-modes.html" accesskey="p" rel="prev">Developing major modes with tree-sitter</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> +<hr> +<span id="Tree_002dsitter-C-API-Correspondence"></span><h3 class="section">37.8 Tree-sitter C API Correspondence</h3> + +<p>Emacs’ tree-sitter integration doesn’t expose every feature +provided by tree-sitter’s C API. Missing features include: +</p> +<ul> +<li> Creating a tree cursor and navigating the syntax tree with it. +</li><li> Setting timeout and cancellation flag for a parser. +</li><li> Setting the logger for a parser. +</li><li> Printing a <acronym>DOT</acronym> graph of the syntax tree to a file. +</li><li> Copying and modifying a syntax tree. (Emacs doesn’t expose a tree +object.) +</li><li> Using (row, column) coordinates as position. +</li><li> Updating a node with changes. (In Emacs, retrieve a new node instead +of updating the existing one.) +</li><li> Querying statics of a language definition. +</li></ul> + +<p>In addition, Emacs makes some changes to the C API to make the API more +convenient and idiomatic: +</p> +<ul> +<li> Instead of using byte positions, the Emacs Lisp API uses character +positions. +</li><li> Null nodes are converted to nil. +</li></ul> + +<p>Below is the correspondence between all C API functions and their +ELisp counterparts. Sometimes one ELisp function corresponds to +multiple C functions, and many C functions don’t have an ELisp +counterpart. +</p> +<div class="example"> +<pre class="example">ts_parser_new treesit-parser-create +ts_parser_delete +ts_parser_set_language +ts_parser_language treesit-parser-language +ts_parser_set_included_ranges treesit-parser-set-included-ranges +ts_parser_included_ranges treesit-parser-included-ranges +ts_parser_parse +ts_parser_parse_string treesit-parse-string +ts_parser_parse_string_encoding +ts_parser_reset +ts_parser_set_timeout_micros +ts_parser_timeout_micros +ts_parser_set_cancellation_flag +ts_parser_cancellation_flag +ts_parser_set_logger +ts_parser_logger +ts_parser_print_dot_graphs +ts_tree_copy +ts_tree_delete +ts_tree_root_node +ts_tree_language +ts_tree_edit +ts_tree_get_changed_ranges +ts_tree_print_dot_graph +ts_node_type treesit-node-type +ts_node_symbol +ts_node_start_byte treesit-node-start +ts_node_start_point +ts_node_end_byte treesit-node-end +ts_node_end_point +ts_node_string treesit-node-string +ts_node_is_null +ts_node_is_named treesit-node-check +ts_node_is_missing treesit-node-check +ts_node_is_extra treesit-node-check +ts_node_has_changes +ts_node_has_error treesit-node-check +ts_node_parent treesit-node-parent +ts_node_child treesit-node-child +ts_node_field_name_for_child treesit-node-field-name-for-child +ts_node_child_count treesit-node-child-count +ts_node_named_child treesit-node-child +ts_node_named_child_count treesit-node-child-count +ts_node_child_by_field_name treesit-node-by-field-name +ts_node_child_by_field_id +ts_node_next_sibling treesit-next-sibling +ts_node_prev_sibling treesit-prev-sibling +ts_node_next_named_sibling treesit-next-sibling +ts_node_prev_named_sibling treesit-prev-sibling +ts_node_first_child_for_byte treesit-first-child-for-pos +ts_node_first_named_child_for_byte treesit-first-child-for-pos +ts_node_descendant_for_byte_range treesit-descendant-for-range +ts_node_descendant_for_point_range +ts_node_named_descendant_for_byte_range treesit-descendant-for-range +ts_node_named_descendant_for_point_range +ts_node_edit +ts_node_eq treesit-node-eq +ts_tree_cursor_new +ts_tree_cursor_delete +ts_tree_cursor_reset +ts_tree_cursor_current_node +ts_tree_cursor_current_field_name +ts_tree_cursor_current_field_id +ts_tree_cursor_goto_parent +ts_tree_cursor_goto_next_sibling +ts_tree_cursor_goto_first_child +ts_tree_cursor_goto_first_child_for_byte +ts_tree_cursor_goto_first_child_for_point +ts_tree_cursor_copy +ts_query_new +ts_query_delete +ts_query_pattern_count +ts_query_capture_count +ts_query_string_count +ts_query_start_byte_for_pattern +ts_query_predicates_for_pattern +ts_query_step_is_definite +ts_query_capture_name_for_id +ts_query_string_value_for_id +ts_query_disable_capture +ts_query_disable_pattern +ts_query_cursor_new +ts_query_cursor_delete +ts_query_cursor_exec treesit-query-capture +ts_query_cursor_did_exceed_match_limit +ts_query_cursor_match_limit +ts_query_cursor_set_match_limit +ts_query_cursor_set_byte_range +ts_query_cursor_set_point_range +ts_query_cursor_next_match +ts_query_cursor_remove_match +ts_query_cursor_next_capture +ts_language_symbol_count +ts_language_symbol_name +ts_language_symbol_for_name +ts_language_field_count +ts_language_field_name_for_id +ts_language_field_id_for_name +ts_language_symbol_type +ts_language_version +</pre></div> +</div> +<hr> +<div class="header"> +<p> +Previous: <a href="Tree_002dsitter-major-modes.html">Developing major modes with tree-sitter</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> + + + +</body> +</html> diff --git a/admin/notes/tree-sitter/html-manual/Using-Parser.html b/admin/notes/tree-sitter/html-manual/Using-Parser.html new file mode 100644 index 00000000000..a4f31f90897 --- /dev/null +++ b/admin/notes/tree-sitter/html-manual/Using-Parser.html @@ -0,0 +1,231 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<!-- Created by GNU Texinfo 6.8, https://www.gnu.org/software/texinfo/ --> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=utf-8"> +<!-- This is the GNU Emacs Lisp Reference Manual +corresponding to Emacs version 29.0.50. + +Copyright © 1990-1996, 1998-2022 Free Software Foundation, +Inc. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with the +Invariant Sections being "GNU General Public License," with the +Front-Cover Texts being "A GNU Manual," and with the Back-Cover +Texts as in (a) below. A copy of the license is included in the +section entitled "GNU Free Documentation License." + +(a) The FSF's Back-Cover Text is: "You have the freedom to copy and +modify this GNU manual. Buying copies from the FSF supports it in +developing GNU and promoting software freedom." --> +<title>Using Parser (GNU Emacs Lisp Reference Manual)</title> + +<meta name="description" content="Using Parser (GNU Emacs Lisp Reference Manual)"> +<meta name="keywords" content="Using Parser (GNU Emacs Lisp Reference Manual)"> +<meta name="resource-type" content="document"> +<meta name="distribution" content="global"> +<meta name="Generator" content="makeinfo"> +<meta name="viewport" content="width=device-width,initial-scale=1"> + +<link href="index.html" rel="start" title="Top"> +<link href="Index.html" rel="index" title="Index"> +<link href="index.html#SEC_Contents" rel="contents" title="Table of Contents"> +<link href="Parsing-Program-Source.html" rel="up" title="Parsing Program Source"> +<link href="Retrieving-Nodes.html" rel="next" title="Retrieving Nodes"> +<link href="Language-Definitions.html" rel="prev" title="Language Definitions"> +<style type="text/css"> +<!-- +a.copiable-anchor {visibility: hidden; text-decoration: none; line-height: 0em} +a.summary-letter {text-decoration: none} +blockquote.indentedblock {margin-right: 0em} +div.display {margin-left: 3.2em} +div.example {margin-left: 3.2em} +kbd {font-style: oblique} +pre.display {font-family: inherit} +pre.format {font-family: inherit} +pre.menu-comment {font-family: serif} +pre.menu-preformatted {font-family: serif} +span.nolinebreak {white-space: nowrap} +span.roman {font-family: initial; font-weight: normal} +span.sansserif {font-family: sans-serif; font-weight: normal} +span:hover a.copiable-anchor {visibility: visible} +ul.no-bullet {list-style: none} +--> +</style> +<link rel="stylesheet" type="text/css" href="./manual.css"> + + +</head> + +<body lang="en"> +<div class="section" id="Using-Parser"> +<div class="header"> +<p> +Next: <a href="Retrieving-Nodes.html" accesskey="n" rel="next">Retrieving Nodes</a>, Previous: <a href="Language-Definitions.html" accesskey="p" rel="prev">Tree-sitter Language Definitions</a>, Up: <a href="Parsing-Program-Source.html" accesskey="u" rel="up">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> +<hr> +<span id="Using-Tree_002dsitter-Parser"></span><h3 class="section">37.2 Using Tree-sitter Parser</h3> +<span id="index-tree_002dsitter-parser_002c-using"></span> + +<p>This section describes how to create and configure a tree-sitter +parser. In Emacs, each tree-sitter parser is associated with a +buffer. As the user edits the buffer, the associated parser and +syntax tree are automatically kept up-to-date. +</p> +<dl class="def"> +<dt id="index-treesit_002dmax_002dbuffer_002dsize"><span class="category">Variable: </span><span><strong>treesit-max-buffer-size</strong><a href='#index-treesit_002dmax_002dbuffer_002dsize' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This variable contains the maximum size of buffers in which +tree-sitter can be activated. Major modes should check this value +when deciding whether to enable tree-sitter features. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dcan_002denable_002dp"><span class="category">Function: </span><span><strong>treesit-can-enable-p</strong><a href='#index-treesit_002dcan_002denable_002dp' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function checks whether the current buffer is suitable for +activating tree-sitter features. It basically checks +<code>treesit-available-p</code> and <code>treesit-max-buffer-size</code>. +</p></dd></dl> + +<span id="index-creating-tree_002dsitter-parsers"></span> +<span id="index-tree_002dsitter-parser_002c-creating"></span> +<dl class="def"> +<dt id="index-treesit_002dparser_002dcreate"><span class="category">Function: </span><span><strong>treesit-parser-create</strong> <em>language &optional buffer no-reuse</em><a href='#index-treesit_002dparser_002dcreate' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>Create a parser for the specified <var>buffer</var> and <var>language</var> +(see <a href="Language-Definitions.html">Tree-sitter Language Definitions</a>). If <var>buffer</var> is omitted or +<code>nil</code>, it stands for the current buffer. +</p> +<p>By default, this function reuses a parser if one already exists for +<var>language</var> in <var>buffer</var>, but if <var>no-reuse</var> is +non-<code>nil</code>, this function always creates a new parser. +</p></dd></dl> + +<p>Given a parser, we can query information about it. +</p> +<dl class="def"> +<dt id="index-treesit_002dparser_002dbuffer"><span class="category">Function: </span><span><strong>treesit-parser-buffer</strong> <em>parser</em><a href='#index-treesit_002dparser_002dbuffer' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the buffer associated with <var>parser</var>. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dparser_002dlanguage"><span class="category">Function: </span><span><strong>treesit-parser-language</strong> <em>parser</em><a href='#index-treesit_002dparser_002dlanguage' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the language used by <var>parser</var>. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dparser_002dp"><span class="category">Function: </span><span><strong>treesit-parser-p</strong> <em>object</em><a href='#index-treesit_002dparser_002dp' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function checks if <var>object</var> is a tree-sitter parser, and +returns non-<code>nil</code> if it is, and <code>nil</code> otherwise. +</p></dd></dl> + +<p>There is no need to explicitly parse a buffer, because parsing is done +automatically and lazily. A parser only parses when a Lisp program +queries for a node in its syntax tree. Therefore, when a parser is +first created, it doesn’t parse the buffer; it waits until the Lisp +program queries for a node for the first time. Similarly, when some +change is made in the buffer, a parser doesn’t re-parse immediately. +</p> +<span id="index-treesit_002dbuffer_002dtoo_002dlarge"></span> +<p>When a parser does parse, it checks for the size of the buffer. +Tree-sitter can only handle buffer no larger than about 4GB. If the +size exceeds that, Emacs signals the <code>treesit-buffer-too-large</code> +error with signal data being the buffer size. +</p> +<p>Once a parser is created, Emacs automatically adds it to the +internal parser list. Every time a change is made to the buffer, +Emacs updates parsers in this list so they can update their syntax +tree incrementally. +</p> +<dl class="def"> +<dt id="index-treesit_002dparser_002dlist"><span class="category">Function: </span><span><strong>treesit-parser-list</strong> <em>&optional buffer</em><a href='#index-treesit_002dparser_002dlist' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the parser list of <var>buffer</var>. If +<var>buffer</var> is <code>nil</code> or omitted, it defaults to the current +buffer. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dparser_002ddelete"><span class="category">Function: </span><span><strong>treesit-parser-delete</strong> <em>parser</em><a href='#index-treesit_002dparser_002ddelete' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function deletes <var>parser</var>. +</p></dd></dl> + +<span id="index-tree_002dsitter-narrowing"></span> +<span id="tree_002dsitter-narrowing"></span><p>Normally, a parser “sees” the whole buffer, but when the buffer is +narrowed (see <a href="Narrowing.html">Narrowing</a>), the parser will only see the accessible +portion of the buffer. As far as the parser can tell, the hidden +region was deleted. When the buffer is later widened, the parser +thinks text is inserted at the beginning and at the end. Although +parsers respect narrowing, modes should not use narrowing as a means +to handle a multi-language buffer; instead, set the ranges in which the +parser should operate. See <a href="Multiple-Languages.html">Parsing Text in Multiple Languages</a>. +</p> +<p>Because a parser parses lazily, when the user or a Lisp program +narrows the buffer, the parser is not affected immediately; as long as +the mode doesn’t query for a node while the buffer is narrowed, the +parser is oblivious of the narrowing. +</p> +<span id="index-tree_002dsitter-parse-string"></span> +<span id="index-parse-string_002c-tree_002dsitter"></span> +<p>Besides creating a parser for a buffer, a Lisp program can also parse a +string. Unlike a buffer, parsing a string is a one-off operation, and +there is no way to update the result. +</p> +<dl class="def"> +<dt id="index-treesit_002dparse_002dstring"><span class="category">Function: </span><span><strong>treesit-parse-string</strong> <em>string language</em><a href='#index-treesit_002dparse_002dstring' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function parses <var>string</var> using <var>language</var>, and returns +the root node of the generated syntax tree. +</p></dd></dl> + +<span id="Be-notified-by-changes-to-the-parse-tree"></span><h3 class="heading">Be notified by changes to the parse tree</h3> +<span id="index-update-callback_002c-for-tree_002dsitter-parse_002dtree"></span> +<span id="index-after_002dchange-notifier_002c-for-tree_002dsitter-parse_002dtree"></span> +<span id="index-tree_002dsitter-parse_002dtree_002c-update-and-after_002dchange-callback"></span> +<span id="index-notifiers_002c-tree_002dsitter"></span> + +<p>A Lisp program might want to be notified of text affected by +incremental parsing. For example, inserting a comment-closing token +converts text before that token into a comment. Even +though the text is not directly edited, it is deemed to be “changed” +nevertheless. +</p> +<p>Emacs lets a Lisp program to register callback functions +(a.k.a. <em>notifiers</em>) for this kind of changes. A notifier +function takes two arguments: <var>ranges</var> and <var>parser</var>. +<var>ranges</var> is a list of cons cells of the form <code>(<var>start</var> . <var>end</var>)</code><!-- /@w -->, where <var>start</var> and <var>end</var> mark the start and the +end positions of a range. <var>parser</var> is the parser issuing the +notification. +</p> +<p>Every time a parser reparses a buffer, it compares the old and new +parse-tree, computes the ranges in which nodes have changed, and +passes the ranges to notifier functions. +</p> +<dl class="def"> +<dt id="index-treesit_002dparser_002dadd_002dnotifier"><span class="category">Function: </span><span><strong>treesit-parser-add-notifier</strong> <em>parser function</em><a href='#index-treesit_002dparser_002dadd_002dnotifier' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function adds <var>function</var> to <var>parser</var>’s list of +after-change notifier functions. <var>function</var> must be a function +symbol, not a lambda function (see <a href="Anonymous-Functions.html">Anonymous Functions</a>). +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dparser_002dremove_002dnotifier"><span class="category">Function: </span><span><strong>treesit-parser-remove-notifier</strong> <em>parser function</em><a href='#index-treesit_002dparser_002dremove_002dnotifier' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function removes <var>function</var> from the list of <var>parser</var>’s +after-change notifier functions. <var>function</var> must be a function +symbol, rather than a lambda function. +</p></dd></dl> + +<dl class="def"> +<dt id="index-treesit_002dparser_002dnotifiers"><span class="category">Function: </span><span><strong>treesit-parser-notifiers</strong> <em>parser</em><a href='#index-treesit_002dparser_002dnotifiers' class='copiable-anchor'> ¶</a></span></dt> +<dd><p>This function returns the list of <var>parser</var>’s notifier functions. +</p></dd></dl> + +</div> +<hr> +<div class="header"> +<p> +Next: <a href="Retrieving-Nodes.html">Retrieving Nodes</a>, Previous: <a href="Language-Definitions.html">Tree-sitter Language Definitions</a>, Up: <a href="Parsing-Program-Source.html">Parsing Program Source</a> [<a href="index.html#SEC_Contents" title="Table of contents" rel="contents">Contents</a>][<a href="Index.html" title="Index" rel="index">Index</a>]</p> +</div> + + + +</body> +</html> diff --git a/admin/notes/tree-sitter/html-manual/build-manual.sh b/admin/notes/tree-sitter/html-manual/build-manual.sh new file mode 100755 index 00000000000..8d931b143b2 --- /dev/null +++ b/admin/notes/tree-sitter/html-manual/build-manual.sh @@ -0,0 +1,23 @@ +#!/bin/bash + +MANUAL_DIR="../../../../doc/lispref" +THIS_DIR=$(pwd) + +echo "Build manual" +cd "${MANUAL_DIR}" +make elisp.html HTML_OPTS="--html --css-ref=./manual.css" + +cd "${THIS_DIR}" + +echo "Copy manual" +cp -f "${MANUAL_DIR}/elisp.html/Parsing-Program-Source.html" . +cp -f "${MANUAL_DIR}/elisp.html/Language-Definitions.html" . +cp -f "${MANUAL_DIR}/elisp.html/Using-Parser.html" . +cp -f "${MANUAL_DIR}/elisp.html/Retrieving-Node.html" . +cp -f "${MANUAL_DIR}/elisp.html/Accessing-Node.html" . +cp -f "${MANUAL_DIR}/elisp.html/Pattern-Matching.html" . +cp -f "${MANUAL_DIR}/elisp.html/Multiple-Languages.html" . +cp -f "${MANUAL_DIR}/elisp.html/Tree_002dsitter-C-API.html" . + +cp -f "${MANUAL_DIR}/elisp.html/Parser_002dbased-Font-Lock.html" . +cp -f "${MANUAL_DIR}/elisp.html/Parser_002dbased-Indentation.html" . diff --git a/admin/notes/tree-sitter/html-manual/manual.css b/admin/notes/tree-sitter/html-manual/manual.css new file mode 100644 index 00000000000..5a6790a3458 --- /dev/null +++ b/admin/notes/tree-sitter/html-manual/manual.css @@ -0,0 +1,374 @@ +/* Style-sheet to use for Emacs manuals */ + +/* Copyright (C) 2013-2014 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. This file is offered as-is, +without any warranty. +*/ + +/* style.css begins here */ + +/* This stylesheet is used by manuals and a few older resources. */ + +/* reset.css begins here */ + +/* +Software License Agreement (BSD License) + +Copyright (c) 2006, Yahoo! Inc. +All rights reserved. + +Redistribution and use of this software in source and +binary forms, with or without modification, arepermitted +provided that the following conditions are met: + +* Redistributions of source code must retain the above +copyright notice, this list of conditions and the +following disclaimer. + +* Redistributions in binary form must reproduce the above +copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other +materials provided with the distribution. + +* Neither the name of Yahoo! Inc. nor the names of its +contributors may be used to endorse or promote products +derived from this software without specific prior +written permission of Yahoo! Inc. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND +CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR +CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER +IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. +*/ + +html { + color: #000; + background: #FFF; +} + +body, div, dl, dt, dd, ul, ol, li, h1, h2, h3, h4, +h5, h6, pre, code, form, fieldset, legend, input, +button, textarea, p, blockquote, th, td { + margin: 0; + padding: 0; +} + +table { + border-collapse: collapse; + border-spacing: 0; +} + +fieldset, img { + border: 0; +} + +address, caption, cite, code, dfn, em, strong, +th, var, optgroup { + font-style: inherit; + font-weight: inherit; +} + +del, ins { + text-decoration: none; +} + +li { + list-style:none; +} + +caption, th { + text-align: left; +} + +h1, h2, h3, h4, h5, h6 { + font-size: 100%; + font-weight: normal; +} + +q:before, q:after { + content:''; +} + +abbr, acronym { + border: 0; + font-variant: normal; +} + +sup { + vertical-align: baseline; +} +sub { + vertical-align: baseline; +} + +legend { + color: #000; +} + +input, button, textarea, select, optgroup, option { + font-family: inherit; + font-size: inherit; + font-style: inherit; + font-weight: inherit; +} + +input, button, textarea, select { + *font-size: 100%; +} + + +/* reset.css ends here */ + +/*** PAGE LAYOUT ***/ + +html, body { + font-size: 1em; + text-align: left; + text-decoration: none; +} +html { background-color: #e7e7e7; } + +body { + max-width: 74.92em; + margin: 0 auto; + padding: .5em 1em 1em 1em; + background-color: white; + border: .1em solid #c0c0c0; +} + + +/*** BASIC ELEMENTS ***/ + +/* Size and positioning */ + +p, pre, li, dt, dd, table, code, address { line-height: 1.3em; } + +h1 { font-size: 2em; margin: 1em 0 } +h2 { font-size: 1.50em; margin: 1.0em 0 0.87em 0; } +h3 { font-size: 1.30em; margin: 1.0em 0 0.87em 0; } +h4 { font-size: 1.13em; margin: 1.0em 0 0.88em 0; } +h5 { font-size: 1.00em; margin: 1.0em 0 1.00em 0; } + +p, pre { margin: 1em 0; } +pre { overflow: auto; padding-bottom: .3em; } + +ul, ol, blockquote { margin-left: 1.5%; margin-right: 1.5%; } +hr { margin: 1em 0; } +/* Lists of underlined links are difficult to read. The top margin + gives a little more spacing between entries. */ +ul li { margin: .5em 1em; } +ol li { margin: 1em; } +ol ul li { margin: .5em 1em; } +ul li p, ul ul li { margin-top: .3em; margin-bottom: .3em; } +ul ul, ol ul { margin-top: 0; margin-bottom: 0; } + +/* Separate description lists from preceding text */ +dl { margin: 1em 0 0 0; } +/* separate the "term" from subsequent "description" */ +dt { margin: .5em 0; } +/* separate the "description" from subsequent list item + when the final <dd> child is an anonymous box */ +dd { margin: .5em 3% 1em 3%; } +/* separate anonymous box (used to be the first element in <dd>) + from subsequent <p> */ +dd p { margin: .5em 0; } + +table { + display: block; overflow: auto; + margin-top: 1.5em; margin-bottom: 1.5em; +} +th { padding: .3em .5em; text-align: center; } +td { padding: .2em .5em; } + +address { margin-bottom: 1em; } +caption { margin-bottom: .5em; text-align: center; } +sup { vertical-align: super; } +sub { vertical-align: sub; } + +/* Style */ + +h1, h2, h3, h4, h5, h6, strong, dt, th { font-weight: bold; } + +/* The default color (black) is too dark for large text in + bold font. */ +h1, h2, h3, h4 { color: #333; } +h5, h6, dt { color: #222; } + +a[href] { color: #005090; } +a[href]:visited { color: #100070; } +a[href]:active, a[href]:hover { + color: #100070; + text-decoration: none; +} + +h1 a[href]:visited, h2 a[href]:visited, h3 a[href]:visited, +h4 a[href]:visited { color: #005090; } +h1 a[href]:hover, h2 a[href]:hover, h3 a[href]:hover, +h4 a[href]:hover { color: #100070; } + +ol { list-style: decimal outside;} +ul { list-style: square outside; } +ul ul, ol ul { list-style: circle; } +li { list-style: inherit; } + +hr { background-color: #ede6d5; } +table { border: 0; } + +abbr,acronym { + border-bottom:1px dotted #000; + text-decoration: none; + cursor:help; +} +del { text-decoration: line-through; } +em { font-style: italic; } +small { font-size: .9em; } + +img { max-width: 100%} + + +/*** SIMPLE CLASSES ***/ + +.center, .c { text-align: center; } +.nocenter{ text-align: left; } + +.underline { text-decoration: underline; } +.nounderline { text-decoration: none; } + +.no-bullet { list-style: none; } +.inline-list li { display: inline } + +.netscape4, .no-display { display: none; } + + +/*** MANUAL PAGES ***/ + +/* This makes the very long tables of contents in Gnulib and other + manuals easier to read. */ +.contents ul, .shortcontents ul { font-weight: bold; } +.contents ul ul, .shortcontents ul ul { font-weight: normal; } +.contents ul { list-style: none; } + +/* For colored navigation bars (Emacs manual): make the bar extend + across the whole width of the page and give it a decent height. */ +.header, .node { margin: 0 -1em; padding: 0 1em; } +.header p, .node p { line-height: 2em; } + +/* For navigation links */ +.node a, .header a { display: inline-block; line-height: 2em; } +.node a:hover, .header a:hover { background: #f2efe4; } + +/* Inserts */ +table.cartouche td { padding: 1.5em; } + +div.display, div.lisp, div.smalldisplay, +div.smallexample, div.smalllisp { margin-left: 3%; } + +div.example { padding: .8em 1.2em .4em; } +pre.example { padding: .8em 1.2em; } +div.example, pre.example { + margin: 1em 0 1em 3% ; + -webkit-border-radius: .3em; + -moz-border-radius: .3em; + border-radius: .3em; + border: 1px solid #d4cbb6; + background-color: #f2efe4; +} +div.example > pre.example { + padding: 0 0 .4em; + margin: 0; + border: none; +} + +pre.menu-comment { padding-top: 1.3em; margin: 0; } + + +/*** FOR WIDE SCREENS ***/ + +@media (min-width: 40em) { + body { padding: .5em 3em 1em 3em; } + div.header, div.node { margin: 0 -3em; padding: 0 3em; } +} + +/* style.css ends here */ + +/* makeinfo convert @deffn and similar functions to something inside + <blockquote>. style.css uses italic for blockquote. This looks poor + in the Emacs manuals, which make extensive use of @defun (etc). + In particular, references to function arguments appear as <var> + inside <blockquote>. Since <var> is also italic, it makes it + impossible to distinguish variables. We could change <var> to + e.g. bold-italic, or normal, or a different color, but that does + not look as good IMO. So we just override blockquote to be non-italic. + */ +blockquote { font-style: normal; } + +var { font-style: italic; } + +div.header { + background-color: #DDDDFF; + padding-top: 0.2em; +} + + +/*** Customization ***/ + +body { + font-family: Charter, serif; + font-size: 14pt; + line-height: 1.4; + background-color: #fefefc; + color: #202010; +} + +pre.menu-comment { + font-family: Charter, serif; + font-size: 14pt; +} + +body > *, body > div.display, body > div.lisp, body > div.smalldisplay, +body > div.example, body > div.smallexample, body > div.smalllisp { + width: 700px; + margin-left: auto; + margin-right: auto; +} + +div.header { + width: 100%; + min-height: 3em; + font-size: 13pt; +} + +/* Documentation block for functions and variables. Make then + narrower*/ +dd { + margin: .5em 6% 1em 6% +} + +code, pre, kbd, samp, tt { + font-size: 12pt; + font-family: monospace; +} + +/* In each node we have index table to all sub-nodes. Make more space + for the first column, which is the name to each sub-node. */ +table.menu tbody tr td:nth-child(1) { + white-space: nowrap; +} + +div.header p { + text-align: center; + margin: 0.5em auto 0.5em auto; +} diff --git a/admin/notes/tree-sitter/starter-guide b/admin/notes/tree-sitter/starter-guide new file mode 100644 index 00000000000..123dabd9f29 --- /dev/null +++ b/admin/notes/tree-sitter/starter-guide @@ -0,0 +1,455 @@ +STARTER GUIDE ON WRITING MAJOR MODE WITH TREE-SITTER -*- org -*- + +This document guides you on adding tree-sitter support to a major +mode. + +TOC: + +- Building Emacs with tree-sitter +- Install language definitions +- Setup +- Naming convention +- Font-lock +- Indent +- Imenu +- Navigation +- Which-func +- More features? +- Common tasks (code snippets) +- Manual + +* Building Emacs with tree-sitter + +You can either install tree-sitter by your package manager, or from +source: + + git clone https://github.com/tree-sitter/tree-sitter.git + cd tree-sitter + make + make install + +Then pull the tree-sitter branch (or the master branch, if it has +merged) and rebuild Emacs. + +* Install language definitions + +Tree-sitter by itself doesn’t know how to parse any particular +language. We need to install language definitions (or “grammars”) for +a language to be able to parse it. There are a couple of ways to get +them. + +You can use this script that I put together here: + + https://github.com/casouri/tree-sitter-module + +You can also find them under this directory in /build-modules. + +This script automatically pulls and builds language definitions for C, +C++, Rust, JSON, Go, HTML, Javascript, CSS, Python, Typescript, +and C#. Better yet, I pre-built these language definitions for +GNU/Linux and macOS, they can be downloaded here: + + https://github.com/casouri/tree-sitter-module/releases/tag/v2.1 + +To build them yourself, run + + git clone git@github.com:casouri/tree-sitter-module.git + cd tree-sitter-module + ./batch.sh + +and language definitions will be in the /dist directory. You can +either copy them to standard dynamic library locations of your system, +eg, /usr/local/lib, or leave them in /dist and later tell Emacs where +to find language definitions by setting ‘treesit-extra-load-path’. + +Language definition sources can be found on GitHub under +tree-sitter/xxx, like tree-sitter/tree-sitter-python. The tree-sitter +organization has all the "official" language definitions: + + https://github.com/tree-sitter + +* Setting up for adding major mode features + +Start Emacs and load tree-sitter with + + (require 'treesit) + +Now check if Emacs is built with tree-sitter library + + (treesit-available-p) + +* Tree-sitter major modes + +Tree-sitter modes should be separate major modes, so other modes +inheriting from the original mode don't break if tree-sitter is +enabled. For example js2-mode inherits js-mode, we can't enable +tree-sitter in js-mode, lest js-mode would not setup things that +js2-mode expects to inherit from. So it's best to use separate major +modes. + +If the tree-sitter variant and the "native" variant could share some +setup, you can create a "base mode", which only contains the common +setup. For example, there is python-base-mode (shared), python-mode +(native), and python-ts-mode (tree-sitter). + +In the tree-sitter mode, check if we can use tree-sitter with +treesit-ready-p, it will error out if tree-sitter is not ready. + +* Naming convention + +Use tree-sitter for text (documentation, comment), use treesit for +symbol (variable, function). + +* Font-lock + +Tree-sitter works like this: You provide a query made of patterns and +capture names, tree-sitter finds the nodes that match these patterns, +tag the corresponding capture names onto the nodes and return them to +you. The query function returns a list of (capture-name . node). For +font-lock, we use face names as capture names. And the captured node +will be fontified in their capture name. + +The capture name could also be a function, in which case (NODE +OVERRIDE START END) is passed to the function for fontification. START +and END are the start and end of the region to be fontified. The +function should only fontify within that region. The function should +also allow more optional arguments with (&rest _), for future +extensibility. For OVERRIDE check out the docstring of +treesit-font-lock-rules. + +** Query syntax + +There are two types of nodes, named, like (identifier), +(function_definition), and anonymous, like "return", "def", "(", +"}". Parent-child relationship is expressed as + + (parent (child) (child) (child (grand_child))) + +Eg, an argument list (1, "3", 1) could be: + + (argument_list "(" (number) (string) (number) ")") + +Children could have field names in its parent: + + (function_definition name: (identifier) type: (identifier)) + +Match any of the list: + + ["true" "false" "none"] + +Capture names can come after any node in the pattern: + + (parent (child) @child) @parent + +The query above captures both parent and child. + + ["return" "continue" "break"] @keyword + +The query above captures all the keywords with capture name +"keyword". + +These are the common syntax, see all of them in the manual +("Parsing Program Source" section). + +** Query references + +But how do one come up with the queries? Take python for an example, +open any python source file, type M-x treesit-explore-mode RET. Now +you should see the parse-tree in a separate window, automatically +updated as you select text or edit the buffer. Besides this, you can +consult the grammar of the language definition. For example, Python’s +grammar file is at + + https://github.com/tree-sitter/tree-sitter-python/blob/master/grammar.js + +Neovim also has a bunch of queries to reference: + + https://github.com/nvim-treesitter/nvim-treesitter/tree/master/queries + +The manual explains how to read grammar files in the bottom of section +"Tree-sitter Language Definitions". + +** Debugging queries + +If your query has problems, use ‘treesit-query-validate’ to debug the +query. It will pop a buffer containing the query (in text format) and +mark the offending part in red. + +** Code + +To enable tree-sitter font-lock, set ‘treesit-font-lock-settings’ and +‘treesit-font-lock-feature-list’ buffer-locally and call +‘treesit-major-mode-setup’. For example, see +‘python--treesit-settings’ in python.el. Below I paste a snippet of +it. + +Note that like the current font-lock, if the to-be-fontified region +already has a face (ie, an earlier match fontified part/all of the +region), the new face is discarded rather than applied. If you want +later matches always override earlier matches, use the :override +keyword. + +Each rule should have a :feature, like function-name, +string-interpolation, builtin, etc. Users can then enable/disable each +feature individually. + +#+begin_src elisp +(defvar python--treesit-settings + (treesit-font-lock-rules + :feature 'comment + :language 'python + '((comment) @font-lock-comment-face) + + :feature 'string + :language 'python + '((string) @font-lock-string-face + (string) @contextual) ; Contextual special treatment. + + :feature 'function-name + :language 'python + '((function_definition + name: (identifier) @font-lock-function-name-face)) + + :feature 'class-name + :language 'python + '((class_definition + name: (identifier) @font-lock-type-face)) + + ...)) +#+end_src + +Then in ‘python-mode’, enable tree-sitter font-lock: + +#+begin_src elisp +(treesit-parser-create 'python) +(setq-local treesit-font-lock-settings python--treesit-settings) +(setq-local treesit-font-lock-feature-list + '((comment string function-name) + (class-name keyword builtin) + (string-interpolation decorator))) +... +(treesit-major-mode-setup) +#+end_src + +Concretely, something like this: + +#+begin_src elisp +(define-derived-mode python-mode prog-mode "Python" + ... + (cond + ;; Tree-sitter. + ((treesit-ready-p 'python-mode 'python) + (treesit-parser-create 'python) + (setq-local treesit-font-lock-settings python--treesit-settings) + (setq-local treesit-font-lock-feature-list + '((comment string function-name) + (class-name keyword builtin) + (string-interpolation decorator))) + (treesit-major-mode-setup)) + (t + ;; No tree-sitter + (setq-local font-lock-defaults ...) + ...))) +#+end_src + +* Indent + +Indent works like this: We have a bunch of rules that look like + + (MATCHER ANCHOR OFFSET) + +When the indentation process starts, point is at the BOL of a line, we +want to know which column to indent this line to. Let NODE be the node +at point, we pass this node to the MATCHER of each rule, one of them +will match the node (eg, "this node is a closing bracket!"). Then we +pass the node to the ANCHOR, which returns a point, eg, the BOL of the +previous line. We find the column number of that point (eg, 4), add +OFFSET to it (eg, 0), and that is the column we want to indent the +current line to (4 + 0 = 4). + +Matchers and anchors are functions that takes (NODE PARENT BOL &rest +_). Matches return nil/non-nil for no match/match, and anchors return +the anchor point. Below are some convenient builtin matchers and anchors. + +For MATHCER we have + + (parent-is TYPE) => matches if PARENT’s type matches TYPE as regexp + (node-is TYPE) => matches NODE’s type + (query QUERY) => matches if querying PARENT with QUERY + captures NODE. + + (match NODE-TYPE PARENT-TYPE NODE-FIELD + NODE-INDEX-MIN NODE-INDEX-MAX) + + => checks everything. If an argument is nil, don’t match that. Eg, + (match nil nil TYPE) is the same as (parent-is TYPE) + +For ANCHOR we have + + first-sibling => start of the first sibling + parent => start of parent + parent-bol => BOL of the line parent is on. + prev-sibling => start of previous sibling + no-indent => current position (don’t indent) + prev-line => start of previous line + +There is also a manual section for indent: "Parser-based Indentation". + +When writing indent rules, you can use ‘treesit-check-indent’ to +check if your indentation is correct. To debug what went wrong, set +‘treesit--indent-verbose’ to non-nil. Then when you indent, Emacs +tells you which rule is applied in the echo area. + +#+begin_src elisp +(defvar typescript-mode-indent-rules + (let ((offset typescript-indent-offset)) + `((typescript + ;; This rule matches if node at point is "}", ANCHOR is the + ;; parent node’s BOL, and offset is 0. + ((node-is "}") parent-bol 0) + ((node-is ")") parent-bol 0) + ((node-is "]") parent-bol 0) + ((node-is ">") parent-bol 0) + ((node-is "\\.") parent-bol ,offset) + ((parent-is "ternary_expression") parent-bol ,offset) + ((parent-is "named_imports") parent-bol ,offset) + ((parent-is "statement_block") parent-bol ,offset) + ((parent-is "type_arguments") parent-bol ,offset) + ((parent-is "variable_declarator") parent-bol ,offset) + ((parent-is "arguments") parent-bol ,offset) + ((parent-is "array") parent-bol ,offset) + ((parent-is "formal_parameters") parent-bol ,offset) + ((parent-is "template_substitution") parent-bol ,offset) + ((parent-is "object_pattern") parent-bol ,offset) + ((parent-is "object") parent-bol ,offset) + ((parent-is "object_type") parent-bol ,offset) + ((parent-is "enum_body") parent-bol ,offset) + ((parent-is "arrow_function") parent-bol ,offset) + ((parent-is "parenthesized_expression") parent-bol ,offset) + ...)))) +#+end_src + +Then you set ‘treesit-simple-indent-rules’ to your rules, and call +‘treesit-major-mode-setup’: + +#+begin_src elisp +(setq-local treesit-simple-indent-rules typescript-mode-indent-rules) +(treesit-major-mode-setup) +#+end_src + +* Imenu + +Not much to say except for utilizing ‘treesit-induce-sparse-tree’ (and +explicitly pass a LIMIT argument: most of the time you don't need more +than 10). See ‘js--treesit-imenu-1’ in js.el for an example. + +Once you have the index builder, set ‘imenu-create-index-function’ to +it. + +* Navigation + +Mainly ‘beginning-of-defun-function’ and ‘end-of-defun-function’. +You can find the end of a defun with something like + +(treesit-search-forward-goto "function_definition" 'end) + +where "function_definition" matches the node type of a function +definition node, and ’end means we want to go to the end of that node. + +Tree-sitter has default implementations for +‘beginning-of-defun-function’ and ‘end-of-defun-function’. So for +ordinary languages, it is enough to set ‘treesit-defun-type-regexp’ +to something that matches all the defun struct types in the language, +and call ‘treesit-major-mode-setup’. For example, + +#+begin_src emacs-lisp +(setq-local treesit-defun-type-regexp (rx bol + (or "function" "class") + "_definition" + eol)) +(treesit-major-mode-setup) +#+end_src> + +* Which-func + +If you have an imenu implementation, set ‘which-func-functions’ to +nil, and which-func will automatically use imenu’s data. + +If you want an independent implementation for which-func, you can +find the current function by going up the tree and looking for the +function_definition node. See the function below for an example. +Since Python allows nested function definitions, that function keeps +going until it reaches the root node, and records all the function +names along the way. + +#+begin_src elisp +(defun python-info-treesit-current-defun (&optional include-type) + "Identical to `python-info-current-defun' but use tree-sitter. +For INCLUDE-TYPE see `python-info-current-defun'." + (let ((node (treesit-node-at (point))) + (name-list ()) + (type nil)) + (cl-loop while node + if (pcase (treesit-node-type node) + ("function_definition" + (setq type 'def)) + ("class_definition" + (setq type 'class)) + (_ nil)) + do (push (treesit-node-text + (treesit-node-child-by-field-name node "name") + t) + name-list) + do (setq node (treesit-node-parent node)) + finally return (concat (if include-type + (format "%s " type) + "") + (string-join name-list "."))))) +#+end_src + +* More features? + +Obviously this list is just a starting point, if there are features in +the major mode that would benefit from a parse tree, adding tree-sitter +support for that would be great. But in the minimal case, just adding +font-lock is awesome. + +* Common tasks + +How to... + +** Get the buffer text corresponding to a node? + +(treesit-node-text node) + +BTW ‘treesit-node-string’ does different things. + +** Scan the whole tree for stuff? + +(treesit-search-subtree) +(treesit-search-forward) +(treesit-induce-sparse-tree) + +** Move to next node that...? + +(treesit-search-forward-goto) + +** Get the root node? + +(treesit-buffer-root-node) + +** Get the node at point? + +(treesit-node-at (point)) + +* Manual + +I suggest you read the manual section for tree-sitter in Info. The +section is Parsing Program Source. Typing + + C-h i d m elisp RET g Parsing Program Source RET + +will bring you to that section. You can also read the HTML version +under /html-manual in this directory. I find the HTML version easier +to read. You don’t need to read through every sentence, just read the +text paragraphs and glance over function names. diff --git a/build-aux/config.guess b/build-aux/config.guess index a419d8643b6..980b0208381 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -4,7 +4,7 @@ # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2022-08-01' +timestamp='2022-09-17' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -966,6 +966,12 @@ EOF GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` GUESS=$UNAME_MACHINE-unknown-$GNU_SYS$GNU_REL-$LIBC ;; + x86_64:[Mm]anagarm:*:*|i?86:[Mm]anagarm:*:*) + GUESS="$UNAME_MACHINE-pc-managarm-mlibc" + ;; + *:[Mm]anagarm:*:*) + GUESS="$UNAME_MACHINE-unknown-managarm-mlibc" + ;; *:Minix:*:*) GUESS=$UNAME_MACHINE-unknown-minix ;; diff --git a/build-aux/config.sub b/build-aux/config.sub index fbaa37f2352..baf1512b3c0 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -4,7 +4,7 @@ # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2022-08-01' +timestamp='2022-09-17' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -145,7 +145,7 @@ case $1 in nto-qnx* | linux-* | uclinux-uclibc* \ | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \ | netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \ - | storm-chaos* | os2-emx* | rtmk-nova*) + | storm-chaos* | os2-emx* | rtmk-nova* | managarm-*) basic_machine=$field1 basic_os=$maybe_os ;; @@ -1341,6 +1341,10 @@ EOF kernel=linux os=`echo "$basic_os" | sed -e 's|linux|gnu|'` ;; + managarm*) + kernel=managarm + os=`echo "$basic_os" | sed -e 's|managarm|mlibc|'` + ;; *) kernel= os=$basic_os @@ -1754,7 +1758,7 @@ case $os in | onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \ | midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \ | nsk* | powerunix* | genode* | zvmoe* | qnx* | emx* | zephyr* \ - | fiwix* ) + | fiwix* | mlibc* ) ;; # This one is extra strict with allowed versions sco3.2v2 | sco3.2v[4-9]* | sco5v6*) @@ -1762,6 +1766,9 @@ case $os in ;; none) ;; + kernel* ) + # Restricted further below + ;; *) echo Invalid configuration \`"$1"\': OS \`"$os"\' not recognized 1>&2 exit 1 @@ -1772,16 +1779,26 @@ esac # (given a valid OS), if there is a kernel. case $kernel-$os in linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* \ - | linux-musl* | linux-relibc* | linux-uclibc* ) + | linux-musl* | linux-relibc* | linux-uclibc* | linux-mlibc* ) ;; uclinux-uclibc* ) ;; - -dietlibc* | -newlib* | -musl* | -relibc* | -uclibc* ) + managarm-mlibc* | managarm-kernel* ) + ;; + -dietlibc* | -newlib* | -musl* | -relibc* | -uclibc* | -mlibc* ) # These are just libc implementations, not actual OSes, and thus # require a kernel. echo "Invalid configuration \`$1': libc \`$os' needs explicit kernel." 1>&2 exit 1 ;; + -kernel* ) + echo "Invalid configuration \`$1': \`$os' needs explicit kernel." 1>&2 + exit 1 + ;; + *-kernel* ) + echo "Invalid configuration \`$1': \`$kernel' does not support \`$os'." 1>&2 + exit 1 + ;; kfreebsd*-gnu* | kopensolaris*-gnu*) ;; vxworks-simlinux | vxworks-simwindows | vxworks-spe) diff --git a/configure.ac b/configure.ac index b656dba4d99..cc4e59ee5ac 100644 --- a/configure.ac +++ b/configure.ac @@ -463,6 +463,7 @@ OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support]) OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support]) OPTION_DEFAULT_ON([native-image-api], [don't use native image APIs (GDI+ on Windows)]) OPTION_DEFAULT_IFAVAILABLE([json], [compile with native JSON support]) +OPTION_DEFAULT_IFAVAILABLE([tree-sitter], [compile with tree-sitter]) OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts]) OPTION_DEFAULT_ON([harfbuzz],[don't use HarfBuzz for text shaping]) @@ -3217,6 +3218,50 @@ AC_SUBST([JSON_LIBS]) AC_SUBST([JSON_CFLAGS]) AC_SUBST([JSON_OBJ]) +HAVE_TREE_SITTER=no +TREE_SITTER_OBJ= + +if test "${with_tree_sitter}" != "no"; then + dnl Tree-sitter 0.20.2 added support to change the malloc it uses + dnl at runtime, we need that feature. However, tree-sitter's + dnl Makefile has problems, until that's fixed, all tree-sitter + dnl libraries distributed are versioned 0.6.3. We try to + dnl accept a tree-sitter library that has incorrect version as long + dnl as it supports changing malloc. + EMACS_CHECK_MODULES([TREE_SITTER], [tree-sitter >= 0.20.2], + [HAVE_TREE_SITTER=yes], [HAVE_TREE_SITTER=no]) + if test "${HAVE_TREE_SITTER}" = yes; then + AC_DEFINE(HAVE_TREE_SITTER, 1, [Define if using tree-sitter.]) + else + EMACS_CHECK_MODULES([TREE_SITTER], [tree-sitter >= 0.6.3], + [HAVE_TREE_SITTER=yes], [HAVE_TREE_SITTER=no]) + if test "${HAVE_TREE_SITTER}" = yes; then + OLD_CFLAGS=$CFLAGS + OLD_LIBS=$LIBS + CFLAGS="$CFLAGS $TREE_SITTER_CFLAGS" + LIBS="$TREE_SITTER_LIBS $LIBS" + AC_CHECK_FUNCS([ts_set_allocator]) + CFLAGS=$OLD_CFLAGS + LIBS=$OLD_LIBS + if test "$ac_cv_func_ts_set_allocator" = yes; then + AC_DEFINE(HAVE_TREE_SITTER, 1, [Define if using tree-sitter.]) + else + AC_MSG_ERROR([Tree-sitter library exists but its version is too old]); + TREE_SITTER_CFLAGS= + TREE_SITTER_LIBS= + fi + fi + fi + + # Windows loads tree-sitter dynamically + if test "${opsys}" = "mingw32"; then + TREE_SITTER_LIBS= + fi +fi + +AC_SUBST(TREE_SITTER_LIBS) +AC_SUBST(TREE_SITTER_CFLAGS) + NOTIFY_OBJ= NOTIFY_SUMMARY=no @@ -4087,20 +4132,31 @@ if test "${HAVE_ZLIB}" = "yes"; then fi AC_SUBST([LIBZ]) +### Dynamic library support +case $opsys in + cygwin|mingw32) DYNAMIC_LIB_SUFFIX=".dll" ;; + darwin) DYNAMIC_LIB_SUFFIX=".dylib" ;; + *) DYNAMIC_LIB_SUFFIX=".so" ;; +esac +case "${opsys}" in + darwin) DYNAMIC_LIB_SECONDARY_SUFFIX='.so' ;; + *) DYNAMIC_LIB_SECONDARY_SUFFIX='' ;; +esac +AC_DEFINE_UNQUOTED(DYNAMIC_LIB_SUFFIX, "$DYNAMIC_LIB_SUFFIX", + [System extension for dynamic libraries]) +AC_DEFINE_UNQUOTED(DYNAMIC_LIB_SECONDARY_SUFFIX, "$DYNAMIC_LIB_SECONDARY_SUFFIX", + [Alternative system extension for dynamic libraries.]) + +AC_SUBST(DYNAMIC_LIB_SUFFIX) +AC_SUBST(DYNAMIC_LIB_SECONDARY_SUFFIX) + ### Dynamic modules support LIBMODULES= HAVE_MODULES=no MODULES_OBJ= NEED_DYNLIB=no -case $opsys in - cygwin|mingw32) MODULES_SUFFIX=".dll" ;; - darwin) MODULES_SUFFIX=".dylib" ;; - *) MODULES_SUFFIX=".so" ;; -esac -case "${opsys}" in - darwin) MODULES_SECONDARY_SUFFIX='.so' ;; - *) MODULES_SECONDARY_SUFFIX='' ;; -esac +MODULES_SUFFIX="${DYNAMIC_LIB_SUFFIX}" +MODULES_SECONDARY_SUFFIX="${DYNAMIC_LIB_SECONDARY_SUFFIX}" # pgtkterm.c uses dlsym if test $window_system = pgtk; then @@ -4517,6 +4573,12 @@ case $with_json,$HAVE_JSON in *) MISSING="$MISSING json" WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-json=ifavailable";; esac +case $with_tree_sitter,$HAVE_TREE_SITTER in + no,* | ifavailable,* | *,yes) ;; + *) MISSING="$MISSING tree-sitter" + WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-tree-sitter=ifavailable";; +esac + if test "X${MISSING}" != X; then # If we have a missing library, and we don't have pkg-config installed, # the missing pkg-config may be the reason. Give the user a hint. @@ -6559,7 +6621,7 @@ emacs_config_features= for opt in ACL BE_APP CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \ HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \ M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PGTK PNG RSVG SECCOMP \ - SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS \ + SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS TREE_SITTER \ UNEXEC WEBP X11 XAW3D XDBE XFT XIM XINPUT2 XPM XWIDGETS X_TOOLKIT \ ZLIB; do @@ -6628,6 +6690,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs use -lxft? ${HAVE_XFT} Does Emacs use -lsystemd? ${HAVE_LIBSYSTEMD} Does Emacs use -ljansson? ${HAVE_JSON} + Does Emacs use -ltree-sitter? ${HAVE_TREE_SITTER} Does Emacs use the GMP library? ${HAVE_GMP} Does Emacs directly use zlib? ${HAVE_ZLIB} Does Emacs have dynamic modules support? ${HAVE_MODULES} diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi index dd0787cd38d..d55c751210f 100644 --- a/doc/emacs/msdos.texi +++ b/doc/emacs/msdos.texi @@ -206,40 +206,40 @@ format, that effectively converts the file to Unix EOL style, like the @code{dos2unix} program. @cindex untranslated file system -@findex add-untranslated-filesystem +@findex w32-add-untranslated-filesystem When you use NFS, Samba, or some other similar method to access file systems that reside on computers using GNU or Unix systems, Emacs should not perform end-of-line translation on any files in these file systems---not even when you create a new file. To request this, designate these file systems as @dfn{untranslated} file systems by -calling the function @code{add-untranslated-filesystem}. It takes one -argument: the file system name, including a drive letter and +calling the function @code{w32-add-untranslated-filesystem}. It takes +one argument: the file system name, including a drive letter and optionally a directory. For example, @example -(add-untranslated-filesystem "Z:") +(w32-add-untranslated-filesystem "Z:") @end example @noindent designates drive Z as an untranslated file system, and @example -(add-untranslated-filesystem "Z:\\foo") +(w32-add-untranslated-filesystem "Z:\\foo") @end example @noindent designates directory @file{\foo} on drive Z as an untranslated file system. - Most often you would use @code{add-untranslated-filesystem} in your + Most often you would use @code{w32-add-untranslated-filesystem} in your @file{.emacs} or @file{init.el} init file, or in @file{site-start.el} so that all the users at your site get the benefit of it. -@findex remove-untranslated-filesystem - To countermand the effect of @code{add-untranslated-filesystem}, use -the function @code{remove-untranslated-filesystem}. This function takes -one argument, which should be a string just like the one that was used -previously with @code{add-untranslated-filesystem}. +@findex w32-remove-untranslated-filesystem + To countermand the effect of @code{w32-add-untranslated-filesystem}, +use the function @code{w32-remove-untranslated-filesystem}. This +function takes one argument, which should be a string just like the +one that was used previously with @code{w32-add-untranslated-filesystem}. Designating a file system as untranslated does not affect character set conversion, only end-of-line conversion. Essentially, it directs diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 6abf29c0093..ba8475e86ac 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -83,15 +83,20 @@ mode for the C programming language is @code{c-mode}. @cindex DNS mode @cindex Javascript mode @cindex Awk mode +@cindex C# mode +@cindex IDLWAVE mode +@cindex JSON mode +@cindex SQL mode +@cindex TypeScript mode Emacs has programming language modes for Lisp, Scheme, the -Scheme-based DSSSL expression language, Ada, ASM, AWK, C, C++, +Scheme-based DSSSL expression language, Ada, ASM, AWK, C, C++, C#, Fortran, Icon, IDL (CORBA), IDLWAVE, Java, Javascript, M4, Makefiles, Metafont (@TeX{}'s companion for font creation), Modula2, Object Pascal, Objective-C, Octave, Pascal, Perl, Pike, PostScript, Prolog, -Python, Ruby, Simula, SQL, Tcl, Verilog, and VHDL@. An alternative -mode for Perl is called CPerl mode. Modes are also available for the -scripting languages of the common GNU and Unix shells, and -MS-DOS/MS-Windows @samp{BAT} files, and for makefiles, DNS master +Python, Ruby, Simula, SQL, Tcl, TypeScript, Verilog, and VHDL@. An +alternative mode for Perl is called CPerl mode. Modes are also +available for the scripting languages of the common GNU and Unix +shells, and MS-DOS/MS-Windows @samp{BAT} files, JSON, DNS master files, and various sorts of configuration files. Ideally, Emacs should have a major mode for each programming @@ -1419,7 +1424,7 @@ displaying all of the documentation texts concatenated together. This abnormal hook's value is a list of functions that can produce documentation for the symbol at point as appropriate for the current buffer's major-mode. These functions act as a collection of backends -for ElDoc. Major mode register their documentation lookup functions +for ElDoc. Major modes register their documentation lookup functions with ElDoc by adding their functions to the buffer-local value of this variable. @end vtable diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index df8fa2f8e79..860ef2fc78e 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -7981,7 +7981,7 @@ The command \\[yank] can retrieve it from there. @dots{} " (progn (message "Read only text copied to kill ring") nil) (barf-if-buffer-read-only) ;; If the buffer isn't read-only, the text is. - (signal 'text-read-only (list (current-buffer))))) + (signal 'text-read-only (list (current-buffer))))))) @end group @end smallexample diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in index 8a61adf2323..69991696899 100644 --- a/doc/lispref/Makefile.in +++ b/doc/lispref/Makefile.in @@ -111,6 +111,7 @@ srcs = \ $(srcdir)/objects.texi \ $(srcdir)/os.texi \ $(srcdir)/package.texi \ + $(srcdir)/parsing.texi \ $(srcdir)/positions.texi \ $(srcdir)/processes.texi \ $(srcdir)/records.texi \ diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 377b433cae5..662de29d45a 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1676,10 +1676,14 @@ as returned by @code{find-image} (@pxref{Defining Images}); otherwise this is @code{nil}. @item @var{dx}, @var{dy} -These are the pixel coordinates of the click, relative to the top left -corner of @var{object}, which is @code{(0 . 0)}. If @var{object} is -@code{nil}, which stands for a buffer, the coordinates are relative to -the top left corner of the character glyph clicked on. +These are the pixel offsets of the click relative to the top left +corner of the @var{object}'s glyph that is the nearest one to the +click. The relevant @var{object}s can be either a buffer, or a string, +or an image, see above. If @var{object} is @code{nil} or a string, +the coordinates are relative to the top left corner of the character +glyph clicked on. Note that the offsets are always zero on text-mode +frames, when @var{object} is @code{nil}, since each glyph there is +considered to have exactly 1x1 pixel dimensions. @item @var{width}, @var{height} If the click is on a character, either from buffer text or from diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index a3d1d804086..b1bbe5e0a96 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -222,6 +222,7 @@ To view this manual in other formats, click * Non-ASCII Characters:: Non-ASCII text in buffers and strings. * Searching and Matching:: Searching buffers for strings or regexps. * Syntax Tables:: The syntax table controls word and list parsing. +* Parsing Program Source:: Generate syntax tree for program sources. * Abbrevs:: How Abbrev mode works, and its data structures. * Threads:: Concurrency in Emacs Lisp. @@ -937,6 +938,7 @@ Font Lock Mode * Syntactic Font Lock:: Fontification based on syntax tables. * Multiline Font Lock:: How to coerce Font Lock into properly highlighting multiline constructs. +* Parser-based Font Lock:: Use parse data for fontification. Multiline Font Lock Constructs @@ -947,6 +949,7 @@ Multiline Font Lock Constructs Automatic Indentation of code * SMIE:: A simple minded indentation engine. +* Parser-based Indentation:: Parser-based indentation engine. Simple Minded Indentation Engine @@ -1359,6 +1362,17 @@ Syntax Tables * Syntax Table Internals:: How syntax table information is stored. * Categories:: Another way of classifying character syntax. +Parsing Program Source + +* Language Definitions:: Loading tree-sitter language definitions. +* Using Parser:: Introduction to parsers. +* Retrieving Nodes:: Retrieving nodes from a syntax tree. +* Accessing Node Information:: Accessing node information. +* Pattern Matching:: Pattern matching with query patterns. +* Multiple Languages:: Parse text written in multiple languages. +* Tree-sitter major modes:: Develop major modes using tree-sitter. +* Tree-sitter C API:: Compare the C API and the ELisp API. + Syntax Descriptors * Syntax Class Table:: Table of syntax classes. @@ -1703,6 +1717,7 @@ Object Internals @include searching.texi @include syntax.texi +@include parsing.texi @include abbrevs.texi @include threads.texi @include processes.texi diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 9527df33b82..c472f9b4411 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -2853,11 +2853,14 @@ mode; most major modes define syntactic criteria for which faces to use in which contexts. This section explains how to customize Font Lock for a particular major mode. - Font Lock mode finds text to highlight in two ways: through -syntactic parsing based on the syntax table, and through searching -(usually for regular expressions). Syntactic fontification happens -first; it finds comments and string constants and highlights them. -Search-based fontification happens second. + Font Lock mode finds text to highlight in three ways: through +parsing based on a full-blown parser (usually, via an external library +or program), through syntactic parsing based on the Emacs's built-in +syntax table, or through searching (usually for regular expressions). +If enabled, parser-based fontification happens first +(@pxref{Parser-based Font Lock}). Syntactic fontification happens +next; it finds comments and string constants and highlights them. +Search-based fontification happens last. @menu * Font Lock Basics:: Overview of customizing Font Lock. @@ -2872,6 +2875,7 @@ Search-based fontification happens second. * Syntactic Font Lock:: Fontification based on syntax tables. * Multiline Font Lock:: How to coerce Font Lock into properly highlighting multiline constructs. +* Parser-based Font Lock:: Use parse data for fontification. @end menu @node Font Lock Basics @@ -3652,6 +3656,71 @@ This face inherits, by default, from @code{font-lock-constant-face}. @item font-lock-negation-char-face @vindex font-lock-negation-char-face for easily-overlooked negation characters. + +@item font-lock-escape-face +@vindex font-lock-escape-face +for escape sequences in strings. +This face inherits, by default, from @code{font-lock-regexp-grouping-backslash}. + +Here is an example in Python, where the escape sequence @code{\n} is used: + +@smallexample +@group +print('Hello world!\n') +@end group +@end smallexample + +@item font-lock-number-face +@vindex font-lock-number-face +for numbers. + +@item font-lock-operator-face +@vindex font-lock-operator-face +for operators. + +@item font-lock-property-face +@vindex font-lock-property-face +for properties of an object, such as the declaration and use of fields +in a struct. +This face inherits, by default, from @code{font-lock-variable-name-face}. + +For example, + +@smallexample +@group +typedef struct +@{ + int prop; +// ^ property +@} obj; + +int main() +@{ + obj o; + o.prop = 3; +// ^ property +@} +@end group +@end smallexample + +@item font-lock-punctuation-face +@vindex font-lock-punctuation-face +for punctuation such as brackets and delimiters. + +@item font-lock-bracket-face +@vindex font-lock-bracket-face +for brackets (e.g., @code{()}, @code{[]}, @code{@{@}}). +This face inherits, by default, from @code{font-lock-punctuation-face}. + +@item font-lock-delimiter-face +@vindex font-lock-delimiter-face +for delimiters (e.g., @code{;}, @code{:}, @code{,}). +This face inherits, by default, from @code{font-lock-punctuation-face}. + +@item font-lock-misc-punctuation-face +@vindex font-lock-misc-punctuation-face +for punctuation that is not a bracket or delimiter. +This face inherits, by default, from @code{font-lock-punctuation-face}. @end table @node Syntactic Font Lock @@ -3876,6 +3945,191 @@ Since this function is called after every buffer change, it should be reasonably fast. @end defvar +@node Parser-based Font Lock +@subsection Parser-based Font Lock +@cindex parser-based font-lock + +@c This node is written when the only parser Emacs has is tree-sitter; +@c if in the future more parser are supported, this should be +@c reorganized and rewritten to describe multiple parsers in parallel. + +Besides simple syntactic font lock and regexp-based font lock, Emacs +also provides complete syntactic font lock with the help of a parser. +Currently, Emacs uses the tree-sitter library (@pxref{Parsing Program +Source}) for this purpose. + +Parser-based font lock and other font lock mechanisms are not mutually +exclusive. By default, if enabled, parser-based font lock runs first, +replacing syntactic font lock, then the regexp-based font lock. + +Although parser-based font lock doesn't share the same customization +variables with regexp-based font lock, it uses similar customization +schemes. The tree-sitter counterpart of @var{font-lock-keywords} is +@var{treesit-font-lock-settings}. + +@cindex tree-sitter fontifications, overview +@cindex fontifications with tree-sitter, overview +In general, tree-sitter fontification works as follows: + +@itemize @bullet +@item +A Lisp program (usually, part of a major mode) provides a @dfn{query} +consisting of @dfn{patterns}, each pattern associated with a +@dfn{capture name}. + +@item +The tree-sitter library finds the nodes in the parse tree +that match these patterns, tags the nodes with the corresponding +capture names, and returns them to the Lisp program. + +@item +The Lisp program uses the returned nodes to highlight the portions of +buffer text corresponding to each node as appropriate, using the +tagged capture names of the nodes to determine the correct +fontification. For example, a node tagged @code{font-lock-keyword} +would be highlighted in @code{font-lock-keyword} face. +@end itemize + +For more information about queries, patterns, and capture names, see +@ref{Pattern Matching}. + +To setup tree-sitter fontification, a major mode should first set +@code{treesit-font-lock-settings} with the output of +@code{treesit-font-lock-rules}, then call +@code{treesit-major-mode-setup}. + +@defun treesit-font-lock-rules &rest query-specs +This function is used to set @var{treesit-font-lock-settings}. It +takes care of compiling queries and other post-processing, and outputs +a value that @var{treesit-font-lock-settings} accepts. Here's an +example: + +@example +@group +(treesit-font-lock-rules + :language 'javascript + :feature 'constant + :override t + '((true) @@font-lock-constant-face + (false) @@font-lock-constant-face) + :language 'html + :feature 'script + "(script_element) @@font-lock-builtin-face") +@end group +@end example + +This function takes a series of @var{query-spec}s, where each +@var{query-spec} is a @var{query} preceded by one or more +@var{:keyword}/@var{value} pairs. Each @var{query} is a +tree-sitter query in either the string, s-expression or compiled form. + +For each @var{query}, the @var{:keyword}/@var{value} pairs that +precede it add meta information to it. The @code{:lang} keyword +declares @var{query}'s language. The @code{:feature} keyword sets the +feature name of @var{query}. Users can control which features are +enabled with @code{font-lock-maximum-decoration} and +@code{treesit-font-lock-feature-list} (described below). These two +keywords are mandatory. + +Other keywords are optional: + +@multitable @columnfractions .15 .15 .6 +@headitem Keyword @tab Value @tab Description +@item @code{:override} @tab nil +@tab If the region already has a face, discard the new face +@item @tab t @tab Always apply the new face +@item @tab @code{append} @tab Append the new face to existing ones +@item @tab @code{prepend} @tab Prepend the new face to existing ones +@item @tab @code{keep} @tab Fill-in regions without an existing face +@end multitable + +Lisp programs mark patterns in @var{query} with capture names (names +that starts with @code{@@}), and tree-sitter will return matched nodes +tagged with those same capture names. For the purpose of +fontification, capture names in @var{query} should be face names like +@code{font-lock-keyword-face}. The captured node will be fontified +with that face. + +@findex treesit-fontify-with-override +Capture names can also be function names, in which case the function +is called with 4 arguments: @var{node} and @var{override}, @var{start} +and @var{end}, where @var{node} is the node itself, @var{override} is +the override property of the rule which captured this node, and +@var{start} and @var{end} limits the region in which this function +should fontify. (If this function wants to respect the @var{override} +argument, it can use @code{treesit-fontify-with-override}.) + +Beyond the 4 arguments presented, this function should accept more +arguments as optional arguments for future extensibility. + +If a capture name is both a face and a function, the face takes +priority. If a capture name is neither a face nor a function, it is +ignored. +@end defun + +@defvar treesit-font-lock-feature-list +This is a list of lists of feature symbols. Each element of the list +is a list that represents a decoration level. +@code{font-lock-maximum-decoration} controls which levels are +activated. + +Each element of the list is a list of the form @w{@code{(@var{feature} +@dots{})}}, where each @var{feature} corresponds to the +@code{:feature} value of a query defined in +@code{treesit-font-lock-rules}. Removing a feature symbol from this +list disables the corresponding query during font-lock. + +Common feature names, for many programming languages, include +@code{definition}, @code{type}, @code{assignment}, @code{builtin}, +@code{constant}, @code{keyword}, @code{string-interpolation}, +@code{comment}, @code{doc}, @code{string}, @code{operator}, +@code{preprocessor}, @code{escape-sequence}, and @code{key}. Major +modes are free to subdivide or extend these common features. + +Some of these features warrant some explanation: @code{definition} +highlights whatever is being defined, e.g., the function name in a +function definition, the struct name in a struct definition, the +variable name in a variable definition; @code{assignment} highlights +the whatever is being assigned to, e.g., the variable or field in an +assignment statement; @code{key} highlights keys in key-value pairs, +e.g., keys in a JSON object, or a Python dictionary; @code{doc} +highlights docstrings or doc-comments. + +For example, the value of this variable could be: +@example +@group +((comment string doc) ; level 1 + (function-name keyword type builtin constant) ; level 2 + (variable-name string-interpolation key)) ; level 3 +@end group +@end example + +Major modes should set this variable before calling +@code{treesit-major-mode-setup}. + +@findex treesit-font-lock-recompute-features +For this variable to take effect, a Lisp program should call +@code{treesit-font-lock-recompute-features} (which resets +@code{treesit-font-lock-settings} accordingly), or +@code{treesit-major-mode-setup} (which calls +@code{treesit-font-lock-recompute-features}). +@end defvar + +@defvar treesit-font-lock-settings +A list of settings for tree-sitter based font lock. The exact format +of each setting is considered internal. One should always use +@code{treesit-font-lock-rules} to set this variable. + +@c Because the format is internal, we don't document them here. Though +@c we do have it explained in the docstring. We also expose the fact +@c that it is a list of settings, so one could combine two of them with +@c append. +@end defvar + +Multi-language major modes should provide range functions in +@code{treesit-range-functions}, and Emacs will set the ranges +accordingly before fontifing a region (@pxref{Multiple Languages}). + @node Auto-Indentation @section Automatic Indentation of code @@ -3932,10 +4186,12 @@ and a few other such modes) has been made more generic over the years, so if your language seems somewhat similar to one of those languages, you might try to use that engine. @c FIXME: documentation? Another one is SMIE which takes an approach in the spirit -of Lisp sexps and adapts it to non-Lisp languages. +of Lisp sexps and adapts it to non-Lisp languages. Yet another one is +to rely on a full-blown parser, for example, the tree-sitter library. @menu * SMIE:: A simple minded indentation engine. +* Parser-based Indentation:: Parser-based indentation engine. @end menu @node SMIE @@ -4595,6 +4851,197 @@ to the file's local variables of the form: @code{eval: (smie-config-local '(@var{rules}))}. @end defun +@node Parser-based Indentation +@subsection Parser-based Indentation +@cindex parser-based indentation + +@c This node is written when the only parser Emacs has is tree-sitter; +@c if in the future more parsers are supported, this should be +@c reorganized and rewritten to describe multiple parsers in parallel. + +When built with the tree-sitter library (@pxref{Parsing Program +Source}), Emacs is capable of parsing the program source and producing +a syntax tree. This syntax tree can be used for guiding the program +source indentation commands. For maximum flexibility, it is possible +to write a custom indentation function that queries the syntax tree +and indents accordingly for each language, but that is a lot of work. +It is more convenient to use the simple indentation engine described +below: then the major mode needs only to write some indentation rules +and the engine takes care of the rest. + +To enable the parser-based indentation engine, either set +@var{treesit-simple-indent-rules} and call +@code{treesit-major-mode-setup}, or equivalently, set the value of +@code{indent-line-function} to @code{treesit-indent}. + +@defvar treesit-indent-function +This variable stores the actual function called by +@code{treesit-indent}. By default, its value is +@code{treesit-simple-indent}. In the future we might add other, +more complex indentation engines. +@end defvar + +@heading Writing indentation rules +@cindex indentation rules, for parser-based indentation + +@defvar treesit-simple-indent-rules +This local variable stores indentation rules for every language. It is +a list of the form: @w{@code{(@var{language} . @var{rules})}}, where +@var{language} is a language symbol, and @var{rules} is a list of the +form @w{@code{(@var{matcher} @var{anchor} @var{offset})}}. + +First, Emacs passes the smallest tree-sitter node at the beginning of +the current line to @var{matcher}; if it returns non-@code{nil}, this +rule is applicable. Then Emacs passes the node to @var{anchor}, which +returns a buffer position. Emacs takes the column number of that +position, adds @var{offset} to it, and the result is the indentation +column for the current line. @var{offset} can be an integer or a +variable whose value is an integer. + +The @var{matcher} and @var{anchor} are functions, and Emacs provides +convenient defaults for them. + +Each @var{matcher} or @var{anchor} is a function that takes three +arguments: @var{node}, @var{parent}, and @var{bol}. The argument +@var{bol} is the buffer position whose indentation is required: the +position of the first non-whitespace character after the beginning of +the line. The argument @var{node} is the largest (highest-in-tree) +node that starts at that position; and @var{parent} is the parent of +@var{node}. However, when that position is in a whitespace or inside +a multi-line string, no node can start at that position, so +@var{node} is @code{nil}. In that case, @var{parent} would be the +smallest node that spans that position. + +Emacs finds @var{bol}, @var{node} and @var{parent} and +passes them to each @var{matcher} and @var{anchor}. @var{matcher} +should return non-@code{nil} if the rule is applicable, and +@var{anchor} should return a buffer position. +@end defvar + +@defvar treesit-simple-indent-presets +This is a list of defaults for @var{matcher}s and @var{anchor}s in +@code{treesit-simple-indent-rules}. Each of them represents a function +that takes 3 arguments: @var{node}, @var{parent} and @var{bol}. The +available default functions are: + +@ftable @code +@item no-node +This matcher is a function that is called with 3 arguments: +@var{node}, @var{parent}, and @var{bol}, and returns non-@code{nil}, +indicating a match, if @var{node} is @code{nil}, i.e., there is no +node that starts at @var{bol}. This is the case when @var{bol} is on +an empty line or inside a multi-line string, etc. + +@item parent-is +This matcher is a function of one argument, @var{type}; it returns a +function that is called with 3 arguments: @var{node}, @var{parent}, +and @var{bol}, and returns non-@code{nil} (i.e., a match) if +@var{parent}'s type matches regexp @var{type}. + +@item node-is +This matcher is a function of one argument, @var{type}; it returns a +function that is called with 3 arguments: @var{node}, @var{parent}, +and @var{bol}, and returns non-@code{nil} if @var{node}'s type matches +regexp @var{type}. + +@item query +This matcher is a function of one argument, @var{query}; it returns a +function that is called with 3 arguments: @var{node}, @var{parent}, +and @var{bol}, and returns non-@code{nil} if querying @var{parent} +with @var{query} captures @var{node} (@pxref{Pattern Matching}). + +@item match +This matcher is a function of 5 arguments: @var{node-type}, +@var{parent-type}, @var{node-field}, @var{node-index-min}, and +@var{node-index-max}). It returns a function that is called with 3 +arguments: @var{node}, @var{parent}, and @var{bol}, and returns +non-@code{nil} if @var{node}'s type matches regexp @var{node-type}, +@var{parent}'s type matches regexp @var{parent-type}, @var{node}'s +field name in @var{parent} matches regexp @var{node-field}, and +@var{node}'s index among its siblings is between @var{node-index-min} +and @var{node-index-max}. If the value of an argument is @code{nil}, +this matcher doesn't check that argument. For example, to match the +first child where parent is @code{argument_list}, use + +@example +(match nil "argument_list" nil nil 0 0) +@end example + +@item comment-end +This matcher is a function that is called with 3 arguments: +@var{node}, @var{parent}, and @var{bol}, and returns non-@code{nil} if +point is before a comment ending token. Comment ending tokens are +defined by regular expression @code{treesit-comment-end} +(@pxref{Tree-sitter major modes, treesit-comment-end}). + +@item first-sibling +This anchor is a function that is called with 3 arguments: @var{node}, +@var{parent}, and @var{bol}, and returns the start of the first child +of @var{parent}. + +@item parent +This anchor is a function that is called with 3 arguments: @var{node}, +@var{parent}, and @var{bol}, and returns the start of @var{parent}. + +@item parent-bol +This anchor is a function that is called with 3 arguments: @var{node}, +@var{parent}, and @var{bol}, and returns the first non-space character +on the line of @var{parent}. + +@item prev-sibling +This anchor is a function that is called with 3 arguments: @var{node}, +@var{parent}, and @var{bol}, and returns the start of the previous +sibling of @var{node}. + +@item no-indent +This anchor is a function that is called with 3 arguments: @var{node}, +@var{parent}, and @var{bol}, and returns the start of @var{node}. + +@item prev-line +This anchor is a function that is called with 3 arguments: @var{node}, +@var{parent}, and @var{bol}, and returns the first non-whitespace +character on the previous line. + +@item point-min +This anchor is a function that is called with 3 arguments: @var{node}, +@var{parent}, and @var{bol}, and returns the beginning of the buffer. +This is useful as the beginning of the buffer is always at column 0. + +@item comment-start +This anchor is a function that is called with 3 arguments: @var{node}, +@var{parent}, and @var{bol}, and returns the position right after the +comment-start token. Comment-start tokens are defined by regular +expression @code{treesit-comment-start} (@pxref{Tree-sitter major +modes, treesit-comment-start}). This function assumes @var{parent} is +the comment node. + +@item coment-start-skip +This anchor is a function that is called with 3 arguments: @var{node}, +@var{parent}, and @var{bol}, and returns the position after the +comment-start token and any whitespace characters following that +token. Comment-start tokens are defined by regular expression +@code{treesit-comment-start}. This function assumes @var{parent} is +the comment node. +@end ftable +@end defvar + +@heading Indentation utilities +@cindex utility functions for parser-based indentation + +Here are some utility functions that can help writing parser-based +indentation rules. + +@defun treesit-check-indent mode +This function checks the current buffer's indentation against major +mode @var{mode}. It indents the current buffer according to +@var{mode} and compares the results with the current indentation. +Then it pops up a buffer showing the differences. Correct +indentation (target) is shown in green color, current indentation is +shown in red color. @c Are colors customizable? faces? +@end defun + +It is also helpful to use @code{treesit-inspect-mode} (@pxref{Language +Definitions}) when writing indentation rules. @node Desktop Save Mode @section Desktop Save Mode diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi new file mode 100644 index 00000000000..0f6a99b299c --- /dev/null +++ b/doc/lispref/parsing.texi @@ -0,0 +1,1886 @@ +@c -*- mode: texinfo; coding: utf-8 -*- +@c This is part of the GNU Emacs Lisp Reference Manual. +@c Copyright (C) 2021-2022 Free Software Foundation, Inc. +@c See the file elisp.texi for copying conditions. +@node Parsing Program Source +@chapter Parsing Program Source + +@cindex syntax tree, from parsing program source +Emacs provides various ways to parse program source text and produce a +@dfn{syntax tree}. In a syntax tree, text is no longer considered a +one-dimensional stream of characters, but a structured tree of nodes, +where each node representing a piece of text. Thus, a syntax tree can +enable interesting features like precise fontification, indentation, +navigation, structured editing, etc. + +Emacs has a simple facility for parsing balanced expressions +(@pxref{Parsing Expressions}). There is also the SMIE library for +generic navigation and indentation (@pxref{SMIE}). + +In addition to those, Emacs also provides integration with +@uref{https://tree-sitter.github.io/tree-sitter, the tree-sitter +library}) if support for it was compiled in. The tree-sitter library +implements an incremental parser and has support from a wide range of +programming languages. + +@defun treesit-available-p +This function returns non-@code{nil} if tree-sitter features are +available for the current Emacs session. +@end defun + +To be able to parse the program source using the tree-sitter library +and access the syntax tree of the program, a Lisp program needs to +load a language definition library, and create a parser for that +language and the current buffer. After that, the Lisp program can +query the parser about specific nodes of the syntax tree. Then, it +can access various kinds of information about each node, and search +for nodes using a powerful pattern-matching syntax. This chapter +explains how to do all this, and also how a Lisp program can work with +source files that mix multiple programming languages. + +@menu +* Language Definitions:: Loading tree-sitter language definitions. +* Using Parser:: Introduction to parsers. +* Retrieving Nodes:: Retrieving nodes from a syntax tree. +* Accessing Node Information:: Accessing node information. +* Pattern Matching:: Pattern matching with query patterns. +* Multiple Languages:: Parse text written in multiple languages. +* Tree-sitter major modes:: Develop major modes using tree-sitter. +* Tree-sitter C API:: Compare the C API and the ELisp API. +@end menu + +@node Language Definitions +@section Tree-sitter Language Definitions +@cindex language definitions, for tree-sitter + +@heading Loading a language definition +@cindex loading language definition for tree-sitter + +@cindex language argument, for tree-sitter +Tree-sitter relies on language definitions to parse text in that +language. In Emacs, a language definition is represented by a symbol. +For example, the C language definition is represented as the symbol +@code{c}, and @code{c} can be passed to tree-sitter functions as the +@var{language} argument. + +@vindex treesit-extra-load-path +@vindex treesit-load-language-error +@vindex treesit-load-suffixes +Tree-sitter language definitions are distributed as dynamic libraries. +In order to use a language definition in Emacs, you need to make sure +that the dynamic library is installed on the system. Emacs looks for +language definitions in several places, in the following order: + +@itemize @bullet +@item +first, in the list of directories specified by the variable +@code{treesit-extra-load-path}; +@item +then, in the @file{tree-sitter} subdirectory of the directory +specified by @code{user-emacs-directory} (@pxref{Init File}); +@item +and finally, in the system's default locations for dynamic libraries. +@end itemize + +In each of these directories, Emacs looks for a file with file-name +extensions specified by the variable @code{treesit-load-suffixes}. + +If Emacs cannot find the library or has problems loading it, Emacs +signals the @code{treesit-load-language-error} error. The data of +that signal could be one of the following: + +@table @code +@item (not-found @var{error-msg} @dots{}) +This means that Emacs could not find the language definition library. +@item (symbol-error @var{error-msg}) +This means that Emacs could not find in the library the expected function +that every language definition library should export. +@item (version-mismatch @var{error-msg}) +This means that the version of language definition library is incompatible +with that of the tree-sitter library. +@end table + +@noindent +In all of these cases, @var{error-msg} might provide additional +details about the failure. + +@defun treesit-language-available-p language &optional detail +This function returns non-@code{nil} if the language definitions for +@var{language} exist and can be loaded. + +If @var{detail} is non-@code{nil}, return @code{(t . nil)} when +@var{language} is available, and @code{(nil . @var{data})} when it's +unavailable. @var{data} is the signal data of +@code{treesit-load-language-error}. +@end defun + +@vindex treesit-load-name-override-list +By convention, the file name of the dynamic library for @var{language} is +@file{libtree-sitter-@var{language}.@var{ext}}, where @var{ext} is the +system-specific extension for dynamic libraries. Also by convention, +the function provided by that library is named +@code{tree_sitter_@var{language}}. If a language definition library +doesn't follow this convention, you should add an entry + +@example +(@var{language} @var{library-base-name} @var{function-name}) +@end example + +to the list in the variable @code{treesit-load-name-override-list}, where +@var{library-base-name} is the basename of the dynamic library's file name, +(usually, @file{libtree-sitter-@var{language}}), and +@var{function-name} is the function provided by the library +(usually, @code{tree_sitter_@var{language}}). For example, + +@example +(cool-lang "libtree-sitter-coool" "tree_sitter_cooool") +@end example + +@noindent +for a language that considers itself too ``cool'' to abide by +conventions. + +@cindex language-definition version, compatibility +@defun treesit-language-version &optional min-compatible +This function returns the version of the language-definition +Application Binary Interface (@acronym{ABI}) supported by the +tree-sitter library. By default, it returns the latest ABI version +supported by the library, but if @var{min-compatible} is +non-@code{nil}, it returns the oldest ABI version which the library +still can support. Language definition libraries must be built for +ABI versions between the oldest and the latest versions supported by +the tree-sitter library, otherwise the library will be unable to load +them. +@end defun + +@heading Concrete syntax tree +@cindex syntax tree, concrete + +A syntax tree is what a parser generates. In a syntax tree, each node +represents a piece of text, and is connected to each other by a +parent-child relationship. For example, if the source text is + +@example +1 + 2 +@end example + +@noindent +its syntax tree could be + +@example +@group + +--------------+ + | root "1 + 2" | + +--------------+ + | + +--------------------------------+ + | expression "1 + 2" | + +--------------------------------+ + | | | ++------------+ +--------------+ +------------+ +| number "1" | | operator "+" | | number "2" | ++------------+ +--------------+ +------------+ +@end group +@end example + +We can also represent it as an s-expression: + +@example +(root (expression (number) (operator) (number))) +@end example + +@subheading Node types +@cindex node types, in a syntax tree + +@cindex type of node, tree-sitter +@anchor{tree-sitter node type} +@cindex named node, tree-sitter +@anchor{tree-sitter named node} +@cindex anonymous node, tree-sitter +Names like @code{root}, @code{expression}, @code{number}, and +@code{operator} specify the @dfn{type} of the nodes. However, not all +nodes in a syntax tree have a type. Nodes that don't have a type are +known as @dfn{anonymous nodes}, and nodes with a type are @dfn{named +nodes}. Anonymous nodes are tokens with fixed spellings, including +punctuation characters like bracket @samp{]}, and keywords like +@code{return}. + +@subheading Field names + +@cindex field name, tree-sitter +@cindex tree-sitter node field name +@anchor{tree-sitter node field name} +To make the syntax tree easier to analyze, many language definitions +assign @dfn{field names} to child nodes. For example, a +@code{function_definition} node could have a @code{declarator} and a +@code{body}: + +@example +@group +(function_definition + declarator: (declaration) + body: (compound_statement)) +@end group +@end example + +@heading Exploring the syntax tree +@cindex explore tree-sitter syntax tree +@cindex inspection of tree-sitter parse tree nodes + +To aid in understanding the syntax of a language and in debugging of +Lisp program that use the syntax tree, Emacs provides an ``explore'' +mode, which displays the syntax tree of the source in the current +buffer in real time. Emacs also comes with an ``inspect mode'', which +displays information of the nodes at point in the mode-line. + +@deffn Command treesit-explore-mode +This mode pops up a window displaying the syntax tree of the source in +the current buffer. Selecting text in the source buffer highlights +the corresponding nodes in the syntax tree display. Clicking +on nodes in the syntax tree highlights the corresponding text in the +source buffer. +@end deffn + +@deffn Command treesit-inspect-mode +This minor mode displays on the mode-line the node that @emph{starts} +at point. For example, the mode-line can display + +@example +@var{parent} @var{field}: (@var{node} (@var{child} (@dots{}))) +@end example + +@noindent +where @var{node}, @var{child}, etc., are nodes which begin at point. +@var{parent} is the parent of @var{node}. @var{node} is displayed in +a bold typeface. @var{field-name}s are field names of @var{node} and +of @var{child}, etc. + +If no node starts at point, i.e., point is in the middle of a node, +then the mode line displays the earliest node that spans point, and +its immediate parent. + +This minor mode doesn't create parsers on its own. It uses the first +parser in @code{(treesit-parser-list)} (@pxref{Using Parser}). +@end deffn + +@heading Reading the grammar definition +@cindex reading grammar definition, tree-sitter + +Authors of language definitions define the @dfn{grammar} of a +programming language, which determines how a parser constructs a +concrete syntax tree out of the program text. In order to use the +syntax tree effectively, you need to consult the @dfn{grammar file}. + +The grammar file is usually @file{grammar.js} in a language +definition's project repository. The link to a language definition's +home page can be found on +@uref{https://tree-sitter.github.io/tree-sitter, tree-sitter's +homepage}. + +The grammar definition is written in JavaScript. For example, the +rule matching a @code{function_definition} node looks like + +@example +@group +function_definition: $ => seq( + $.declaration_specifiers, + field('declarator', $.declaration), + field('body', $.compound_statement) +) +@end group +@end example + +@noindent +The rules are represented by functions that take a single argument +@var{$}, representing the whole grammar. The function itself is +constructed by other functions: the @code{seq} function puts together +a sequence of children; the @code{field} function annotates a child +with a field name. If we write the above definition in the so-called +@dfn{Backus-Naur Form} (@acronym{BNF}) syntax, it would look like + +@example +@group +function_definition := + <declaration_specifiers> <declaration> <compound_statement> +@end group +@end example + +@noindent +and the node returned by the parser would look like + +@example +@group +(function_definition + (declaration_specifier) + declarator: (declaration) + body: (compound_statement)) +@end group +@end example + +Below is a list of functions that one can see in a grammar definition. +Each function takes other rules as arguments and returns a new rule. + +@table @code +@item seq(@var{rule1}, @var{rule2}, @dots{}) +matches each rule one after another. +@item choice(@var{rule1}, @var{rule2}, @dots{}) +matches one of the rules in its arguments. +@item repeat(@var{rule}) +matches @var{rule} for @emph{zero or more} times. +This is like the @samp{*} operator in regular expressions. +@item repeat1(@var{rule}) +matches @var{rule} for @emph{one or more} times. +This is like the @samp{+} operator in regular expressions. +@item optional(@var{rule}) +matches @var{rule} for @emph{zero or one} time. +This is like the @samp{?} operator in regular expressions. +@item field(@var{name}, @var{rule}) +assigns field name @var{name} to the child node matched by @var{rule}. +@item alias(@var{rule}, @var{alias}) +makes nodes matched by @var{rule} appear as @var{alias} in the syntax +tree generated by the parser. For example, + +@example +alias(preprocessor_call_exp, call_expression) +@end example + +@noindent +makes any node matched by @code{preprocessor_call_exp} appear as +@code{call_expression}. +@end table + +Below are grammar functions of lesser importance for reading a +language definition. + +@table @code +@item token(@var{rule}) +marks @var{rule} to produce a single leaf node. That is, instead of +generating a parent node with individual child nodes under it, +everything is combined into a single leaf node. @xref{Retrieving +Nodes}. +@item token.immediate(@var{rule}) +Normally, grammar rules ignore preceding whitespace; this +changes @var{rule} to match only when there is no preceding +whitespaces. +@item prec(@var{n}, @var{rule}) +gives @var{rule} the level-@var{n} precedence. +@item prec.left([@var{n},] @var{rule}) +marks @var{rule} as left-associative, optionally with level @var{n}. +@item prec.right([@var{n},] @var{rule}) +marks @var{rule} as right-associative, optionally with level @var{n}. +@item prec.dynamic(@var{n}, @var{rule}) +this is like @code{prec}, but the precedence is applied at runtime +instead. +@end table + +The documentation of the tree-sitter project has +@uref{https://tree-sitter.github.io/tree-sitter/creating-parsers, more +about writing a grammar}. Read especially ``The Grammar DSL'' +section. + +@node Using Parser +@section Using Tree-sitter Parser +@cindex tree-sitter parser, using + +This section describes how to create and configure a tree-sitter +parser. In Emacs, each tree-sitter parser is associated with a +buffer. As the user edits the buffer, the associated parser and +syntax tree are automatically kept up-to-date. + +@defvar treesit-max-buffer-size +This variable contains the maximum size of buffers in which +tree-sitter can be activated. Major modes should check this value +when deciding whether to enable tree-sitter features. +@end defvar + +@defun treesit-can-enable-p +This function checks whether the current buffer is suitable for +activating tree-sitter features. It basically checks +@code{treesit-available-p} and @code{treesit-max-buffer-size}. +@end defun + +@cindex creating tree-sitter parsers +@cindex tree-sitter parser, creating +@defun treesit-parser-create language &optional buffer no-reuse +Create a parser for the specified @var{buffer} and @var{language} +(@pxref{Language Definitions}). If @var{buffer} is omitted or +@code{nil}, it stands for the current buffer. + +By default, this function reuses a parser if one already exists for +@var{language} in @var{buffer}, but if @var{no-reuse} is +non-@code{nil}, this function always creates a new parser. +@end defun + +Given a parser, we can query information about it. + +@defun treesit-parser-buffer parser +This function returns the buffer associated with @var{parser}. +@end defun + +@defun treesit-parser-language parser +This function returns the language used by @var{parser}. +@end defun + +@defun treesit-parser-p object +This function checks if @var{object} is a tree-sitter parser, and +returns non-@code{nil} if it is, and @code{nil} otherwise. +@end defun + +There is no need to explicitly parse a buffer, because parsing is done +automatically and lazily. A parser only parses when a Lisp program +queries for a node in its syntax tree. Therefore, when a parser is +first created, it doesn't parse the buffer; it waits until the Lisp +program queries for a node for the first time. Similarly, when some +change is made in the buffer, a parser doesn't re-parse immediately. + +@vindex treesit-buffer-too-large +When a parser does parse, it checks for the size of the buffer. +Tree-sitter can only handle buffer no larger than about 4GB. If the +size exceeds that, Emacs signals the @code{treesit-buffer-too-large} +error with signal data being the buffer size. + +Once a parser is created, Emacs automatically adds it to the +internal parser list. Every time a change is made to the buffer, +Emacs updates parsers in this list so they can update their syntax +tree incrementally. + +@defun treesit-parser-list &optional buffer +This function returns the parser list of @var{buffer}. If +@var{buffer} is @code{nil} or omitted, it defaults to the current +buffer. +@end defun + +@defun treesit-parser-delete parser +This function deletes @var{parser}. +@end defun + +@cindex tree-sitter narrowing +@anchor{tree-sitter narrowing} +Normally, a parser ``sees'' the whole buffer, but when the buffer is +narrowed (@pxref{Narrowing}), the parser will only see the accessible +portion of the buffer. As far as the parser can tell, the hidden +region was deleted. When the buffer is later widened, the parser +thinks text is inserted at the beginning and at the end. Although +parsers respect narrowing, modes should not use narrowing as a means +to handle a multi-language buffer; instead, set the ranges in which the +parser should operate. @xref{Multiple Languages}. + +Because a parser parses lazily, when the user or a Lisp program +narrows the buffer, the parser is not affected immediately; as long as +the mode doesn't query for a node while the buffer is narrowed, the +parser is oblivious of the narrowing. + +@cindex tree-sitter parse string +@cindex parse string, tree-sitter +Besides creating a parser for a buffer, a Lisp program can also parse a +string. Unlike a buffer, parsing a string is a one-off operation, and +there is no way to update the result. + +@defun treesit-parse-string string language +This function parses @var{string} using @var{language}, and returns +the root node of the generated syntax tree. +@end defun + +@heading Be notified by changes to the parse tree +@cindex update callback, for tree-sitter parse-tree +@cindex after-change notifier, for tree-sitter parse-tree +@cindex tree-sitter parse-tree, update and after-change callback +@cindex notifiers, tree-sitter + +A Lisp program might want to be notified of text affected by +incremental parsing. For example, inserting a comment-closing token +converts text before that token into a comment. Even +though the text is not directly edited, it is deemed to be ``changed'' +nevertheless. + +Emacs lets a Lisp program to register callback functions +(a.k.a.@: @dfn{notifiers}) for this kind of changes. A notifier +function takes two arguments: @var{ranges} and @var{parser}. +@var{ranges} is a list of cons cells of the form @w{@code{(@var{start} +. @var{end})}}, where @var{start} and @var{end} mark the start and the +end positions of a range. @var{parser} is the parser issuing the +notification. + +Every time a parser reparses a buffer, it compares the old and new +parse-tree, computes the ranges in which nodes have changed, and +passes the ranges to notifier functions. + +@defun treesit-parser-add-notifier parser function +This function adds @var{function} to @var{parser}'s list of +after-change notifier functions. @var{function} must be a function +symbol, not a lambda function (@pxref{Anonymous Functions}). +@end defun + +@defun treesit-parser-remove-notifier parser function +This function removes @var{function} from the list of @var{parser}'s +after-change notifier functions. @var{function} must be a function +symbol, rather than a lambda function. +@end defun + +@defun treesit-parser-notifiers parser +This function returns the list of @var{parser}'s notifier functions. +@end defun + +@node Retrieving Nodes +@section Retrieving Nodes +@cindex retrieve node, tree-sitter +@cindex tree-sitter, find node +@cindex get node, tree-sitter + +@cindex terminology, for tree-sitter functions +Here's some terminology and conventions we use when documenting +tree-sitter functions. + +We talk about a node being ``smaller'' or ``larger'', and ``lower'' or +``higher''. A smaller and lower node is lower in the syntax tree and +therefore spans a smaller portion of buffer text; a larger and higher +node is higher up in the syntax tree, it contains many smaller nodes +as its children, and therefore spans a larger portion of text. + +When a function cannot find a node, it returns @code{nil}. For +convenience, all functions that take a node as argument and return +a node, also accept the node argument of @code{nil} and in that case +just return @code{nil}. + +@vindex treesit-node-outdated +Nodes are not automatically updated when the associated buffer is +modified, and there is no way to update a node once it is retrieved. +Using an outdated node signals the @code{treesit-node-outdated} error. + +@heading Retrieving nodes from syntax tree +@cindex retrieving tree-sitter nodes +@cindex syntax tree, retrieving nodes + +@cindex leaf node, of tree-sitter parse tree +@cindex tree-sitter parse tree, leaf node +@defun treesit-node-at pos &optional parser-or-lang named +This function returns a @dfn{leaf} node at buffer position @var{pos}. +A leaf node is a node that doesn't have any child nodes. + +This function tries to return a node whose span covers @var{pos}: the +node's beginning position is less or equal to @var{pos}, and the +node's end position is greater or equal to @var{pos}. + +If no leaf node's span covers @var{pos} (e.g., @var{pos} is in the +whitespace between two leaf nodes), this function returns the first +leaf node after @var{pos}. + +Finally, if there is no leaf node after @var{pos}, return the first +leaf node before @var{pos}. + +When @var{parser-or-lang} is @code{nil} or omitted, this function uses +the first parser in @code{(treesit-parser-list)} of the current +buffer. If @var{parser-or-lang} is a parser object, it uses that +parser; if @var{parser-or-lang} is a language, it finds the first +parser using that language in @code{(treesit-parser-list)}, and uses +that. + +If this function cannot find a suitable node to return, it returns +@code{nil}. + +If @var{named} is non-@code{nil}, this function looks only for named +nodes (@pxref{tree-sitter named node, named node}). + +Example: + +@example +@group +;; Find the node at point in a C parser's syntax tree. +(treesit-node-at (point) 'c) + @result{} #<treesit-node (primitive_type) in 23-27> +@end group +@end example +@end defun + +@defun treesit-node-on beg end &optional parser-or-lang named +This function returns the @emph{smallest} node that covers the region +of buffer text between @var{beg} and @var{end}. In other words, the +start of the node is before or at @var{beg}, and the end of the node +is at or after @var{end}. + +@emph{Beware:} calling this function on an empty line that is not +inside any top-level construct (function definition, etc.) most +probably will give you the root node, because the root node is the +smallest node that covers that empty line. Most of the time, you want +to use @code{treesit-node-at}, described above, instead. + +When @var{parser-or-lang} is @code{nil}, this function uses the first +parser in @code{(treesit-parser-list)} of the current buffer. If +@var{parser-or-lang} is a parser object, it uses that parser; if +@var{parser-or-lang} is a language, it finds the first parser using +that language in @code{(treesit-parser-list)}, and uses that. + +If @var{named} is non-@code{nil}, this function looks for a named node +only (@pxref{tree-sitter named node, named node}). +@end defun + +@defun treesit-parser-root-node parser +This function returns the root node of the syntax tree generated by +@var{parser}. +@end defun + +@defun treesit-buffer-root-node &optional language +This function finds the first parser that uses @var{language} in +@code{(treesit-parser-list)} of the current buffer, and returns the +root node generated by that parser. If it cannot find an appropriate +parser, it returns @code{nil}. +@end defun + +Given a node, a Lisp program can retrieve other nodes starting from +it, or query for information about this node. + +@heading Retrieving nodes from other nodes +@cindex syntax tree nodes, retrieving from other nodes + +@subheading By kinship +@cindex kinship, syntax tree nodes +@cindex nodes, by kinship +@cindex syntax tree nodes, by kinship + +@defun treesit-node-parent node +This function returns the immediate parent of @var{node}. +@end defun + +@defun treesit-node-child node n &optional named +This function returns the @var{n}'th child of @var{node}. If +@var{named} is non-@code{nil}, it counts only named nodes +(@pxref{tree-sitter named node, named node}). + +For example, in a node that represents a string @code{"text"}, there +are three children nodes: the opening quote @code{"}, the string text +@code{text}, and the closing quote @code{"}. Among these nodes, the +first child is the opening quote @code{"}, and the first named child +is the string text. + +This function returns @code{nil} if there is no @var{n}'th child. +@var{n} could be negative, e.g., @code{-1} represents the last child. +@end defun + +@defun treesit-node-children node &optional named +This function returns all of @var{node}'s children as a list. If +@var{named} is non-@code{nil}, it retrieves only named nodes. +@end defun + +@defun treesit-next-sibling node &optional named +This function finds the next sibling of @var{node}. If @var{named} is +non-@code{nil}, it finds the next named sibling. +@end defun + +@defun treesit-prev-sibling node &optional named +This function finds the previous sibling of @var{node}. If +@var{named} is non-@code{nil}, it finds the previous named sibling. +@end defun + +@subheading By field name +@cindex nodes, by field name +@cindex syntax tree nodes, by field name + +To make the syntax tree easier to analyze, many language definitions +assign @dfn{field names} to child nodes (@pxref{tree-sitter node field +name, field name}). For example, a @code{function_definition} node +could have a @code{declarator} node and a @code{body} node. + +@defun treesit-child-by-field-name node field-name +This function finds the child of @var{node} whose field name is +@var{field-name}, a string. + +@example +@group +;; Get the child that has "body" as its field name. +(treesit-child-by-field-name node "body") + @result{} #<treesit-node (compound_statement) in 45-89> +@end group +@end example +@end defun + +@subheading By position +@cindex nodes, by position +@cindex syntax tree nodes, by position + +@defun treesit-first-child-for-pos node pos &optional named +This function finds the first child of @var{node} that extends beyond +buffer position @var{pos}. ``Extends beyond'' means the end of the +child node is greater or equal to @var{pos}. This function only looks +for immediate children of @var{node}, and doesn't look in its +grandchildren. If @var{named} is non-@code{nil}, it looks for the +first named child (@pxref{tree-sitter named node, named node}). +@end defun + +@defun treesit-node-descendant-for-range node beg end &optional named +This function finds the @emph{smallest} descendant node of @var{node} +that spans the region of text between positions @var{beg} and +@var{end}. It is similar to @code{treesit-node-at}. If @var{named} +is non-@code{nil}, it looks for smallest named child. +@end defun + +@heading Searching for node + +@defun treesit-search-subtree node predicate &optional backward all limit +This function traverses the subtree of @var{node} (including +@var{node} itself), looking for a node for which @var{predicate} +returns non-@code{nil}. @var{predicate} is a regexp that is matched +against each node's type, or a predicate function that takes a node +and returns non-@code{nil} if the node matches. The function returns +the first node that matches, or @code{nil} if none does. + +By default, this function only traverses named nodes, but if @var{all} +is non-@code{nil}, it traverses all the nodes. If @var{backward} is +non-@code{nil}, it traverses backwards (i.e., it visits the last child first +when traversing down the tree). If @var{limit} is non-@code{nil}, it +must be a number that limits the tree traversal to that many levels +down the tree. +@end defun + +@defun treesit-search-forward start predicate &optional backward all +Like @code{treesit-search-subtree}, this function also traverses the +parse tree and matches each node with @var{predicate} (except for +@var{start}), where @var{predicate} can be a regexp or a function. +For a tree like the below where @var{start} is marked S, this function +traverses as numbered from 1 to 12: + +@example +@group + 12 + | + S--------3----------11 + | | | +o--o-+--o 1--+--2 6--+-----10 +| | | | +o o +-+-+ +--+--+ + | | | | | + 4 5 7 8 9 +@end group +@end example + +Note that this function doesn't traverse the subtree of @var{start}, +and it always traverse leaf nodes first, then upwards. + +Like @code{treesit-search-subtree}, this function only searches for +named nodes by default, but if @var{all} is non-@code{nil}, it +searches for all nodes. If @var{backward} is non-@code{nil}, it +searches backwards. + +While @code{treesit-search-subtree} traverses the subtree of a node, +this function starts with node @var{start} and traverses every node +that comes after it in the buffer position order, i.e., nodes with +start positions greater than the end position of @var{start}. + +In the tree shown above, @code{treesit-search-subtree} traverses node +S (@var{start}) and nodes marked with @code{o}, where this function +traverses the nodes marked with numbers. This function is useful for +answering questions like ``what is the first node after @var{start} in +the buffer that satisfies some condition?'' +@end defun + +@defun treesit-search-forward-goto node predicate &optional start backward all +This function moves point to the start or end of the next node after +@var{node} in the buffer that matches @var{predicate}. If @var{start} +is non-@code{nil}, stop at the beginning rather than the end of a node. + +This function guarantees that the matched node it returns makes +progress in terms of buffer position: the start/end position of the +returned node is always greater than that of @var{node}. + +Arguments @var{predicate}, @var{backward} and @var{all} are the same +as in @code{treesit-search-forward}. +@end defun + +@defun treesit-induce-sparse-tree root predicate &optional process-fn limit +This function creates a sparse tree from @var{root}'s subtree. + +It takes the subtree under @var{root}, and combs it so only the nodes +that match @var{predicate} are left. Like previous functions, the +@var{predicate} can be a regexp string that matches against each +node's type, or a function that takes a node and return non-@code{nil} +if it matches. + +For example, for a subtree on the left that consist of both numbers +and letters, if @var{predicate} is ``letter only'', the returned tree +is the one on the right. + +@example +@group + a a a + | | | ++---+---+ +---+---+ +---+---+ +| | | | | | | | | +b 1 2 b | | b c d + | | => | | => | + c +--+ c + e + | | | | | + +--+ d 4 +--+ d + | | | + e 5 e +@end group +@end example + +If @var{process-fn} is non-@code{nil}, instead of returning the matched +nodes, this function passes each node to @var{process-fn} and uses the +returned value instead. If non-@code{nil}, @var{limit} is the number of +levels to go down from @var{root}. + +Each node in the returned tree looks like +@w{@code{(@var{tree-sitter-node} . (@var{child} @dots{}))}}. The +@var{tree-sitter-node} of the root of this tree will be nil if +@var{root} doesn't match @var{predicate}. If no node matches +@var{predicate}, the function returns @code{nil}. +@end defun + +@heading More convenience functions + +@defun treesit-filter-child node predicate &optional named +This function finds immediate children of @var{node} that satisfy +@var{predicate}. + +The @var{predicate} function takes a node as the argument and should +return non-@code{nil} to indicate that the node should be kept. If +@var{named} is non-@code{nil}, this function only examines the named +nodes. +@end defun + +@defun treesit-parent-until node predicate +This function repeatedly finds the parents of @var{node}, and returns +the parent that satisfies @var{predicate}, a function that takes a +node as the argument. If no parent satisfies @var{predicate}, this +function returns @code{nil}. +@end defun + +@defun treesit-parent-while node predicate +This function repeatedly finds the parent of @var{node}, and keeps +doing so as long as the nodes satisfy @var{predicate}, a function that +takes a node as the argument. That is, this function returns the +farthest parent that still satisfies @var{predicate}. +@end defun + +@defun treesit-node-top-level node &optional type +This function returns the highest parent of @var{node} that has the +same type as @var{node}. If no such parent exists, it returns +@code{nil}. Therefore this function is also useful for testing +whether @var{node} is top-level. + +If @var{type} is non-@code{nil}, this function matches each parent's +type with @var{type} as a regexp, rather than using @var{node}'s type. +@end defun + +@node Accessing Node Information +@section Accessing Node Information +@cindex information of node, syntax trees +@cindex syntax trees, node information + +@heading Basic information of Node + +Every node is associated with a parser, and that parser is associated +with a buffer. The following functions retrieve them. + +@defun treesit-node-parser node +This function returns @var{node}'s associated parser. +@end defun + +@defun treesit-node-buffer node +This function returns @var{node}'s parser's associated buffer. +@end defun + +@defun treesit-node-language node +This function returns @var{node}'s parser's associated language. +@end defun + +Each node represents a portion of text in the buffer. Functions below +find relevant information about that text. + +@defun treesit-node-start node +Return the start position of @var{node}. +@end defun + +@defun treesit-node-end node +Return the end position of @var{node}. +@end defun + +@defun treesit-node-text node &optional object +Return the buffer text that @var{node} represents, as a string. (If +@var{node} is retrieved from parsing a string, it will be the text +from that string.) +@end defun + +@cindex predicates for syntax tree nodes +Here are some predicates on tree-sitter nodes: + +@defun treesit-node-p object +Checks if @var{object} is a tree-sitter syntax node. +@end defun + +@defun treesit-node-eq node1 node2 +Checks if @var{node1} and @var{node2} are the same node in a syntax +tree. +@end defun + +@heading Property information + +In general, nodes in a concrete syntax tree fall into two categories: +@dfn{named nodes} and @dfn{anonymous nodes}. Whether a node is named +or anonymous is determined by the language definition +(@pxref{tree-sitter named node, named node}). + +@cindex tree-sitter missing node +@cindex missing node, tree-sitter +Apart from being named or anonymous, a node can have other properties. +A node can be ``missing'': such nodes are inserted by the parser in +order to recover from certain kinds of syntax errors, i.e., something +should probably be there according to the grammar, but is not there. +This can happen during editing of the program source, when the source +is not yet in its final form. + +@cindex tree-sitter extra node +@cindex extra node, tree-sitter +A node can be ``extra'': such nodes represent things like comments, +which can appear anywhere in the text. + +@cindex tree-sitter outdated node +@cindex outdated node, tree-sitter +A node can be ``outdated'', if its parser has reparsed at least once +after the node was created. + +@cindex tree-sitter node that has error +@cindex has error, tree-sitter node +A node ``has error'' if the text it spans contains a syntax error. It +can be that the node itself has an error, or one of its descendants +has an error. + +@defun treesit-node-check node property +This function checks if @var{node} has the specified @var{property}. +@var{property} can be @code{named}, @code{missing}, @code{extra}, +@code{outdated}, or @code{has-error}. +@end defun + +@defun treesit-node-type node +Named nodes have ``types'' (@pxref{tree-sitter node type, node type}). +For example, a named node can be a @code{string_literal} node, where +@code{string_literal} is its type. The type of an anonymous node is +just the text that the node represents; e.g., the type of a @samp{,} +node 480is just @samp{,}. + +This function returns @var{node}'s type as a string. +@end defun + +@heading Information as a child or parent + +@defun treesit-node-index node &optional named +This function returns the index of @var{node} as a child node of its +parent. If @var{named} is non-@code{nil}, it only counts named nodes +(@pxref{tree-sitter named node, named node}). +@end defun + +@defun treesit-node-field-name node +A child of a parent node could have a field name (@pxref{tree-sitter +node field name, field name}). This function returns the field name +of @var{node} as a child of its parent. +@end defun + +@defun treesit-node-field-name-for-child node n +This function returns the field name of the @var{n}'th child of +@var{node}. It returns @code{nil} if there is no @var{n}'th child, or +the @var{n}'th child doesn't have a field name. + +Note that @var{n} counts both named and anonymous child. And @var{n} +could be negative, e.g., @code{-1} represents the last child. +@end defun + +@defun treesit-child-count node &optional named +This function finds the number of children of @var{node}. If +@var{named} is non-@code{nil}, it only counts named children +(@pxref{tree-sitter named node, named node}). +@end defun + +@node Pattern Matching +@section Pattern Matching Tree-sitter Nodes +@cindex pattern matching with tree-sitter nodes + +@cindex capturing, tree-sitter node +Tree-sitter lets Lisp programs match patterns using a small +declarative language. This pattern matching consists of two steps: +first tree-sitter matches a @dfn{pattern} against nodes in the syntax +tree, then it @dfn{captures} specific nodes that matched the pattern +and returns the captured nodes. + +We describe first how to write the most basic query pattern and how to +capture nodes in a pattern, then the pattern-matching function, and +finally the more advanced pattern syntax. + +@heading Basic query syntax + +@cindex tree-sitter query pattern syntax +@cindex pattern syntax, tree-sitter query +@cindex query, tree-sitter +A @dfn{query} consists of multiple @dfn{patterns}. Each pattern is an +s-expression that matches a certain node in the syntax node. A +pattern has the form @w{@code{(@var{type} (@var{child}@dots{}))}} + +For example, a pattern that matches a @code{binary_expression} node that +contains @code{number_literal} child nodes would look like + +@example +(binary_expression (number_literal)) +@end example + +To @dfn{capture} a node using the query pattern above, append +@code{@@@var{capture-name}} after the node pattern you want to +capture. For example, + +@example +(binary_expression (number_literal) @@number-in-exp) +@end example + +@noindent +captures @code{number_literal} nodes that are inside a +@code{binary_expression} node with the capture name +@code{number-in-exp}. + +We can capture the @code{binary_expression} node as well, with, for +example, the capture name @code{biexp}: + +@example +(binary_expression + (number_literal) @@number-in-exp) @@biexp +@end example + +@heading Query function + +@cindex query functions, tree-sitter +Now we can introduce the @dfn{query functions}. + +@defun treesit-query-capture node query &optional beg end node-only +This function matches patterns in @var{query} within @var{node}. +The argument @var{query} can be either a string, a s-expression, or a +compiled query object. For now, we focus on the string syntax; +s-expression syntax and compiled query are described at the end of the +section. + +The argument @var{node} can also be a parser or a language symbol. A +parser means using its root node, a language symbol means find or +create a parser for that language in the current buffer, and use the +root node. + +The function returns all the captured nodes in a list of the form +@w{@code{(@var{capture_name} . @var{node})}}. If @var{node-only} is +non-@code{nil}, it returns the list of nodes instead. By default the +entire text of @var{node} is searched, but if @var{beg} and @var{end} +are both non-@code{nil}, they specify the region of buffer text where +this function should match nodes. Any matching node whose span +overlaps with the region between @var{beg} and @var{end} are captured, +it doesn't have to be completely in the region. + +@vindex treesit-query-error +@findex treesit-query-validate +This function raises the @code{treesit-query-error} error if +@var{query} is malformed. The signal data contains a description of +the specific error. You can use @code{treesit-query-validate} to +validate and debug the query. +@end defun + +For example, suppose @var{node}'s text is @code{1 + 2}, and +@var{query} is + +@example +@group +(setq query + "(binary_expression + (number_literal) @@number-in-exp) @@biexp") +@end group +@end example + +Matching that query would return + +@example +@group +(treesit-query-capture node query) + @result{} ((biexp . @var{<node for "1 + 2">}) + (number-in-exp . @var{<node for "1">}) + (number-in-exp . @var{<node for "2">})) +@end group +@end example + +As mentioned earlier, @var{query} could contain multiple patterns. +For example, it could have two top-level patterns: + +@example +@group +(setq query + "(binary_expression) @@biexp + (number_literal) @@number @@biexp") +@end group +@end example + +@defun treesit-query-string string query language +This function parses @var{string} with @var{language}, matches its +root node with @var{query}, and returns the result. +@end defun + +@heading More query syntax + +Besides node type and capture, tree-sitter's pattern syntax can +express anonymous node, field name, wildcard, quantification, +grouping, alternation, anchor, and predicate. + +@subheading Anonymous node + +An anonymous node is written verbatim, surrounded by quotes. A +pattern matching (and capturing) keyword @code{return} would be + +@example +"return" @@keyword +@end example + +@subheading Wild card + +In a pattern, @samp{(_)} matches any named node, and @samp{_} matches +any named and anonymous node. For example, to capture any named child +of a @code{binary_expression} node, the pattern would be + +@example +(binary_expression (_) @@in_biexp) +@end example + +@subheading Field name + +It is possible to capture child nodes that have specific field names. +In the pattern below, @code{declarator} and @code{body} are field +names, indicated by the colon following them. + +@example +@group +(function_definition + declarator: (_) @@func-declarator + body: (_) @@func-body) +@end group +@end example + +It is also possible to capture a node that doesn't have a certain +field, say, a @code{function_definition} without a @code{body} field. + +@example +(function_definition !body) @@func-no-body +@end example + +@subheading Quantify node + +@cindex quantify node, tree-sitter +Tree-sitter recognizes quantification operators @samp{*}, @samp{+} and +@samp{?}. Their meanings are the same as in regular expressions: +@samp{*} matches the preceding pattern zero or more times, @samp{+} +matches one or more times, and @samp{?} matches zero or one time. + +For example, the following pattern matches @code{type_declaration} +nodes that has @emph{zero or more} @code{long} keyword. + +@example +(type_declaration "long"*) @@long-type +@end example + +The following pattern matches a type declaration that has zero or one +@code{long} keyword: + +@example +(type_declaration "long"?) @@long-type +@end example + +@subheading Grouping + +Similar to groups in regular expression, we can bundle patterns into +groups and apply quantification operators to them. For example, to +express a comma separated list of identifiers, one could write + +@example +(identifier) ("," (identifier))* +@end example + +@subheading Alternation + +Again, similar to regular expressions, we can express ``match anyone +from this group of patterns'' in a pattern. The syntax is a list of +patterns enclosed in square brackets. For example, to capture some +keywords in C, the pattern would be + +@example +@group +[ + "return" + "break" + "if" + "else" +] @@keyword +@end group +@end example + +@subheading Anchor + +The anchor operator @samp{.} can be used to enforce juxtaposition, +i.e., to enforce two things to be directly next to each other. The +two ``things'' can be two nodes, or a child and the end of its parent. +For example, to capture the first child, the last child, or two +adjacent children: + +@example +@group +;; Anchor the child with the end of its parent. +(compound_expression (_) @@last-child .) +@end group + +@group +;; Anchor the child with the beginning of its parent. +(compound_expression . (_) @@first-child) +@end group + +@group +;; Anchor two adjacent children. +(compound_expression + (_) @@prev-child + . + (_) @@next-child) +@end group +@end example + +Note that the enforcement of juxtaposition ignores any anonymous +nodes. + +@subheading Predicate + +It is possible to add predicate constraints to a pattern. For +example, with the following pattern: + +@example +@group +( + (array . (_) @@first (_) @@last .) + (#equal @@first @@last) +) +@end group +@end example + +@noindent +tree-sitter only matches arrays where the first element equals to +the last element. To attach a predicate to a pattern, we need to +group them together. A predicate always starts with a @samp{#}. +Currently there are two predicates, @code{#equal} and @code{#match}. + +@deffn Predicate equal arg1 arg2 +Matches if @var{arg1} equals to @var{arg2}. Arguments can be either +strings or capture names. Capture names represent the text that the +captured node spans in the buffer. +@end deffn + +@deffn Predicate match regexp capture-name +Matches if the text that @var{capture-name}'s node spans in the buffer +matches regular expression @var{regexp}. Matching is case-sensitive. +@end deffn + +Note that a predicate can only refer to capture names that appear in +the same pattern. Indeed, it makes little sense to refer to capture +names in other patterns. + +@heading S-expression patterns + +@cindex tree-sitter patterns as sexps +@cindex patterns, tree-sitter, in sexp form +Besides strings, Emacs provides a s-expression based syntax for +tree-sitter patterns. It largely resembles the string-based syntax. +For example, the following query + +@example +@group +(treesit-query-capture + node "(addition_expression + left: (_) @@left + \"+\" @@plus-sign + right: (_) @@right) @@addition + + [\"return\" \"break\"] @@keyword") +@end group +@end example + +@noindent +is equivalent to + +@example +@group +(treesit-query-capture + node '((addition_expression + left: (_) @@left + "+" @@plus-sign + right: (_) @@right) @@addition + + ["return" "break"] @@keyword)) +@end group +@end example + +Most patterns can be written directly as strange but nevertheless +valid s-expressions. Only a few of them needs modification: + +@itemize +@item +Anchor @samp{.} is written as @code{:anchor}. +@item +@samp{?} is written as @samp{:?}. +@item +@samp{*} is written as @samp{:*}. +@item +@samp{+} is written as @samp{:+}. +@item +@code{#equal} is written as @code{:equal}. In general, predicates +change their @samp{#} to @samp{:}. +@end itemize + +For example, + +@example +@group +"( + (compound_expression . (_) @@first (_)* @@rest) + (#match \"love\" @@first) + )" +@end group +@end example + +@noindent +is written in s-expression as + +@example +@group +'(( + (compound_expression :anchor (_) @@first (_) :* @@rest) + (:match "love" @@first) + )) +@end group +@end example + +@heading Compiling queries + +@cindex compiling tree-sitter queries +@cindex queries, compiling +If a query is intended to be used repeatedly, especially in tight +loops, it is important to compile that query, because a compiled query +is much faster than an uncompiled one. A compiled query can be used +anywhere a query is accepted. + +@defun treesit-query-compile language query +This function compiles @var{query} for @var{language} into a compiled +query object and returns it. + +This function raises the @code{treesit-query-error} error if +@var{query} is malformed. The signal data contains a description of +the specific error. You can use @code{treesit-query-validate} to +validate and debug the query. +@end defun + +@defun treesit-query-language query +This function return the language of @var{query}. +@end defun + +@defun treesit-query-expand query +This function converts the s-expression @var{query} into the string +format. +@end defun + +@defun treesit-pattern-expand pattern +This function converts the s-expression @var{pattern} into the string +format. +@end defun + +For more details, read the tree-sitter project's documentation about +pattern-matching, which can be found at +@uref{https://tree-sitter.github.io/tree-sitter/using-parsers#pattern-matching-with-queries}. + +@node Multiple Languages +@section Parsing Text in Multiple Languages +@cindex multiple languages, parsing with tree-sitter +@cindex parsing multiple languages with tree-sitter +Sometimes, the source of a programming language could contain snippets +of other languages; @acronym{HTML} + @acronym{CSS} + JavaScript is one +example. In that case, text segments written in different languages +need to be assigned different parsers. Traditionally, this is +achieved by using narrowing. While tree-sitter works with narrowing +(@pxref{tree-sitter narrowing, narrowing}), the recommended way is +instead to set regions of buffer text (i.e., ranges) in which a parser +will operate. This section describes functions for setting and +getting ranges for a parser. + +Lisp programs should call @code{treesit-update-ranges} to make sure +the ranges for each parser are correct before using parsers in a +buffer, and call @code{treesit-language-at} to figure out the language +responsible for the text at some position. These two functions don't +work by themselves, they need major modes to set +@code{treesit-range-settings} and +@code{treesit-language-at-point-function}, which do the actual work. +These functions and variables are explained in more detail towards the +end of the section. + +@heading Getting and setting ranges + +@defun treesit-parser-set-included-ranges parser ranges +This function sets up @var{parser} to operate on @var{ranges}. The +@var{parser} will only read the text of the specified ranges. Each +range in @var{ranges} is a list of the form @w{@code{(@var{beg} +. @var{end})}}. + +The ranges in @var{ranges} must come in order and must not overlap. +That is, in pseudo code: + +@example +@group +(cl-loop for idx from 1 to (1- (length ranges)) + for prev = (nth (1- idx) ranges) + for next = (nth idx ranges) + should (<= (car prev) (cdr prev) + (car next) (cdr next))) +@end group +@end example + +@vindex treesit-range-invalid +If @var{ranges} violates this constraint, or something else went +wrong, this function signals the @code{treesit-range-invalid} error. +The signal data contains a specific error message and the ranges we +are trying to set. + +This function can also be used for disabling ranges. If @var{ranges} +is @code{nil}, the parser is set to parse the whole buffer. + +Example: + +@example +@group +(treesit-parser-set-included-ranges + parser '((1 . 9) (16 . 24) (24 . 25))) +@end group +@end example +@end defun + +@defun treesit-parser-included-ranges parser +This function returns the ranges set for @var{parser}. The return +value is the same as the @var{ranges} argument of +@code{treesit-parser-included-ranges}: a list of cons cells of the form +@w{@code{(@var{beg} . @var{end})}}. If @var{parser} doesn't have any +ranges, the return value is @code{nil}. + +@example +@group +(treesit-parser-included-ranges parser) + @result{} ((1 . 9) (16 . 24) (24 . 25)) +@end group +@end example +@end defun + +@defun treesit-query-range source query &optional beg end +This function matches @var{source} with @var{query} and returns the +ranges of captured nodes. The return value is a list of cons cells of +the form @w{@code{(@var{beg} . @var{end})}}, where @var{beg} and +@var{end} specify the beginning and the end of a region of text. + +For convenience, @var{source} can be a language symbol, a parser, or a +node. If it's a language symbol, this function matches in the root +node of the first parser using that language; if a parser, this +function matches in the root node of that parser; if a node, this +function matches in that node. + +The argument @var{query} is the query used to capture nodes +(@pxref{Pattern Matching}). The capture names don't matter. The +arguments @var{beg} and @var{end}, if both non-@code{nil}, limit the +range in which this function queries. + +Like other query functions, this function raises the +@code{treesit-query-error} error if @var{query} is malformed. +@end defun + +@heading Supporting multiple languages in Lisp programs + +It should suffice for general Lisp programs to call the following two +functions in order to support program sources that mixes multiple +languages. + +@defun treesit-update-ranges &optional beg end +This function updates ranges for parsers in the buffer. It makes sure +the parsers' ranges are set correctly between @var{beg} and @var{end}, +according to @code{treesit-range-settings}. If omitted, @var{beg} +defaults to the beginning of the buffer, and @var{end} defaults to the +end of the buffer. + +For example, fontification functions use this function before querying +for nodes in a region. +@end defun + +@defun treesit-language-at pos +This function returns the language of the text at buffer position +@var{pos}. Under the hood it calls +@code{treesit-language-at-point-function} and returns its return +value. If @code{treesit-language-at-point-function} is @code{nil}, +this function returns the language of the first parser in the returned +value of @code{treesit-parser-list}. If there is no parser in the +buffer, it returns @code{nil}. +@end defun + +@heading Supporting multiple languages in major modes + +@cindex host language, tree-sitter +@cindex tree-sitter host and embedded languages +@cindex embedded language, tree-sitter +Normally, in a set of languages that can be mixed together, there is a +@dfn{host language} and one or more @dfn{embedded languages}. A Lisp +program usually first parses the whole document with the host +language's parser, retrieves some information, sets ranges for the +embedded languages with that information, and then parses the embedded +languages. + +Take a buffer containing @acronym{HTML}, @acronym{CSS} and JavaScript +as an example. A Lisp program will first parse the whole buffer with +an @acronym{HTML} parser, then query the parser for +@code{style_element} and @code{script_element} nodes, which +correspond to @acronym{CSS} and JavaScript text, respectively. Then +it sets the range of the @acronym{CSS} and JavaScript parser to the +ranges in which their corresponding nodes span. + +Given a simple @acronym{HTML} document: + +@example +@group +<html> + <script>1 + 2</script> + <style>body @{ color: "blue"; @}</style> +</html> +@end group +@end example + +@noindent +a Lisp program will first parse with a @acronym{HTML} parser, then set +ranges for @acronym{CSS} and JavaScript parsers: + +@example +@group +;; Create parsers. +(setq html (treesit-get-parser-create 'html)) +(setq css (treesit-get-parser-create 'css)) +(setq js (treesit-get-parser-create 'javascript)) +@end group + +@group +;; Set CSS ranges. +(setq css-range + (treesit-query-range + 'html + "(style_element (raw_text) @@capture)")) +(treesit-parser-set-included-ranges css css-range) +@end group + +@group +;; Set JavaScript ranges. +(setq js-range + (treesit-query-range + 'html + "(script_element (raw_text) @@capture)")) +(treesit-parser-set-included-ranges js js-range) +@end group +@end example + +Emacs automates this process in @code{treesit-update-ranges}. A +multi-language major mode should set @code{treesit-range-settings} so +that @code{treesit-update-ranges} knows how to perform this process +automatically. Major modes should use the helper function +@code{treesit-range-rules} to generate a value that can be assigned to +@code{treesit-range-settings}. The settings in the following example +directly translate into operations shown above. + +@example +@group +(setq-local treesit-range-settings + (treesit-range-rules + :embed 'javascript + :host 'html + '((script_element (raw_text) @@capture)) +@end group + +@group + :embed 'css + :host 'html + '((style_element (raw_text) @@capture)))) +@end group +@end example + +@defun treesit-range-rules &rest query-specs +This function is used to set @var{treesit-range-settings}. It +takes care of compiling queries and other post-processing, and outputs +a value that @var{treesit-range-settings} can have. + +It takes a series of @var{query-spec}s, where each @var{query-spec} is +a @var{query} preceded by zero or more @var{keyword}/@var{value} +pairs. Each @var{query} is a tree-sitter query in either the +string, s-expression or compiled form, or a function. + +If @var{query} is a tree-sitter query, it should be preceded by two +@var{:keyword}/@var{value} pairs, where the @code{:embed} keyword +specifies the embedded language, and the @code{:host} keyword +specified the host language. + +@code{treesit-update-ranges} uses @var{query} to figure out how to set +the ranges for parsers for the embedded language. It queries +@var{query} in a host language parser, computes the ranges in which +the captured nodes span, and applies these ranges to embedded +language parsers. + +If @var{query} is a function, it doesn't need any @var{:keyword} and +@var{value} pair. It should be a function that takes 2 arguments, +@var{start} and @var{end}, and sets the ranges for parsers in the +current buffer in the region between @var{start} and @var{end}. It is +fine for this function to set ranges in a larger region that +encompasses the region between @var{start} and @var{end}. +@end defun + +@defvar treesit-range-settings +This variable helps @code{treesit-update-ranges} in updating the +ranges for parsers in the buffer. It is a list of @var{setting}s +where the exact format of a @var{setting} is considered internal. You +should use @code{treesit-range-rules} to generate a value that this +variable can have. + +@c Because the format is internal, we don't document them here. Though +@c we do have it explained in the docstring. We also expose the fact +@c that it is a list of settings, so one could combine two of them with +@c append. +@end defvar + + +@defvar treesit-language-at-point-function +This variable's value should be a function that takes a single +argument, @var{pos}, which is a buffer position, and returns the +language of the buffer text at @var{pos}. This variable is used by +@code{treesit-language-at}. +@end defvar + +@node Tree-sitter major modes +@section Developing major modes with tree-sitter +@cindex major mode, developing with tree-sitter + +This section covers some general guidelines on developing tree-sitter +integration for a major mode. + +A major mode supporting tree-sitter features should roughly follow +this pattern: + +@c FIXME: Update this part once we settle on the exact format. +@example +@group +(define-derived-mode woomy-mode prog-mode "Woomy" + "A mode for Woomy programming language." + ;; Shared setup. + ... + (cond + ;; Tree-sitter setup. + ((treesit-ready-p 'woomy-mode 'woomy) + (setq-local treesit-variables ...) + (treesit-major-mode-setup)) + ;; Non-tree-sitter setup. + (t + ...))) +@end group +@end example + +First, the major mode should use @code{treesit-ready-p} to determine +whether tree-sitter can be activated in this mode. + +@defun treesit-ready-p mode language &optional quiet +This function checks for conditions for activating tree-sitter. It +checks whether Emacs was built with tree-sitter, whether the buffer's +size is not too large for tree-sitter to handle it, and whether the +language definition for @var{language} is available on the system +(@pxref{Language Definitions}). + +This function emits a warning if tree-sitter cannot be activated. If +@var{quiet} is @code{message}, the warning is turned into a message; +if @var{quiet} is @code{nil}, no warning or message is displayed. + +If all the necessary conditions are met, this function returns +non-@code{nil}; otherwise it returns @code{nil}. +@end defun + +Next, the major mode should set up tree-sitter variables and call +@code{treesit-major-mode-setup}. + +@defun treesit-major-mode-setup +This function activates some tree-sitter features for a major mode. + +Currently, it sets up the following features: +@itemize +@item +If @code{treesit-font-lock-settings} is non-@code{nil}, it sets up +fontification. +@item +If @code{treesit-simple-indent-rules} is non-@code{nil}, it sets up +indentation. +@item +If @code{treesit-defun-type-regexp} is non-@code{nil}, it sets up +navigation functions for @code{beginning-of-defun} and +@code{end-of-defun}. +@end itemize +@end defun + +For more information of these built-in tree-sitter features, +@pxref{Parser-based Font Lock}, @pxref{Parser-based Indentation}, and +@pxref{List Motion}. + +For supporting mixing of multiple languages in a major mode, +@pxref{Multiple Languages}. + +Setting the following local variables allows tree-sitter's indentation +engine to correctly indent multi-line comments: + +@defvar treesit-comment-start +This should be a regular expression matching an opening comment token. +For example, it should match @samp{//}, @samp{////}, @samp{/*}, +@samp{/****}, etc., in C. +@end defvar + +@defvar treesit-comment-end +This should be a regular expression matching a closing comment token. +For example, it should match @samp{*/}, @samp{****/}, etc., in C. +@end defvar + +@node Tree-sitter C API +@section Tree-sitter C API Correspondence + +Emacs' tree-sitter integration doesn't expose every feature +provided by tree-sitter's C API. Missing features include: + +@itemize +@item +Creating a tree cursor and navigating the syntax tree with it. +@item +Setting timeout and cancellation flag for a parser. +@item +Setting the logger for a parser. +@item +Printing a @acronym{DOT} graph of the syntax tree to a file. +@item +Copying and modifying a syntax tree. (Emacs doesn't expose a tree +object.) +@item +Using (row, column) coordinates as position. +@item +Updating a node with changes. (In Emacs, retrieve a new node instead +of updating the existing one.) +@item +Querying statics of a language definition. +@end itemize + +In addition, Emacs makes some changes to the C API to make the API more +convenient and idiomatic: + +@itemize +@item +Instead of using byte positions, the Emacs Lisp API uses character +positions. +@item +Null nodes are converted to nil. +@end itemize + +Below is the correspondence between all C API functions and their +ELisp counterparts. Sometimes one ELisp function corresponds to +multiple C functions, and many C functions don't have an ELisp +counterpart. + +@example +ts_parser_new treesit-parser-create +ts_parser_delete +ts_parser_set_language +ts_parser_language treesit-parser-language +ts_parser_set_included_ranges treesit-parser-set-included-ranges +ts_parser_included_ranges treesit-parser-included-ranges +ts_parser_parse +ts_parser_parse_string treesit-parse-string +ts_parser_parse_string_encoding +ts_parser_reset +ts_parser_set_timeout_micros +ts_parser_timeout_micros +ts_parser_set_cancellation_flag +ts_parser_cancellation_flag +ts_parser_set_logger +ts_parser_logger +ts_parser_print_dot_graphs +ts_tree_copy +ts_tree_delete +ts_tree_root_node +ts_tree_language +ts_tree_edit +ts_tree_get_changed_ranges +ts_tree_print_dot_graph +ts_node_type treesit-node-type +ts_node_symbol +ts_node_start_byte treesit-node-start +ts_node_start_point +ts_node_end_byte treesit-node-end +ts_node_end_point +ts_node_string treesit-node-string +ts_node_is_null +ts_node_is_named treesit-node-check +ts_node_is_missing treesit-node-check +ts_node_is_extra treesit-node-check +ts_node_has_changes +ts_node_has_error treesit-node-check +ts_node_parent treesit-node-parent +ts_node_child treesit-node-child +ts_node_field_name_for_child treesit-node-field-name-for-child +ts_node_child_count treesit-node-child-count +ts_node_named_child treesit-node-child +ts_node_named_child_count treesit-node-child-count +ts_node_child_by_field_name treesit-node-by-field-name +ts_node_child_by_field_id +ts_node_next_sibling treesit-next-sibling +ts_node_prev_sibling treesit-prev-sibling +ts_node_next_named_sibling treesit-next-sibling +ts_node_prev_named_sibling treesit-prev-sibling +ts_node_first_child_for_byte treesit-first-child-for-pos +ts_node_first_named_child_for_byte treesit-first-child-for-pos +ts_node_descendant_for_byte_range treesit-descendant-for-range +ts_node_descendant_for_point_range +ts_node_named_descendant_for_byte_range treesit-descendant-for-range +ts_node_named_descendant_for_point_range +ts_node_edit +ts_node_eq treesit-node-eq +ts_tree_cursor_new +ts_tree_cursor_delete +ts_tree_cursor_reset +ts_tree_cursor_current_node +ts_tree_cursor_current_field_name +ts_tree_cursor_current_field_id +ts_tree_cursor_goto_parent +ts_tree_cursor_goto_next_sibling +ts_tree_cursor_goto_first_child +ts_tree_cursor_goto_first_child_for_byte +ts_tree_cursor_goto_first_child_for_point +ts_tree_cursor_copy +ts_query_new +ts_query_delete +ts_query_pattern_count +ts_query_capture_count +ts_query_string_count +ts_query_start_byte_for_pattern +ts_query_predicates_for_pattern +ts_query_step_is_definite +ts_query_capture_name_for_id +ts_query_string_value_for_id +ts_query_disable_capture +ts_query_disable_pattern +ts_query_cursor_new +ts_query_cursor_delete +ts_query_cursor_exec treesit-query-capture +ts_query_cursor_did_exceed_match_limit +ts_query_cursor_match_limit +ts_query_cursor_set_match_limit +ts_query_cursor_set_byte_range +ts_query_cursor_set_point_range +ts_query_cursor_next_match +ts_query_cursor_remove_match +ts_query_cursor_next_capture +ts_language_symbol_count +ts_language_symbol_name +ts_language_symbol_for_name +ts_language_field_count +ts_language_field_name_for_id +ts_language_field_id_for_name +ts_language_symbol_type +ts_language_version +@end example diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index 7945232bf8f..a01e568de07 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -834,6 +834,22 @@ a defun. The function @code{end-of-defun} calls this function instead of using its normal method. @end defvar +@findex treesit-beginning-of-defun +@findex treesit-end-of-defun +If Emacs is compiled with tree-sitter, it can use the tree-sitter parser +information to move across syntax constructs. A major mode can set +@code{treesit-defun-type-regexp} and get navigation functionality for +free, by using @code{treesit-beginning-of-defun} and +@code{treesit-end-of-defun}. + +@defvar treesit-defun-type-regexp +The value of this variable is a regexp matching the node type of defun +nodes. (For ``node'', ``node type'', @pxref{Parsing Program Source}.) + +For example, @code{python-mode} sets this variable to a regexp that +matches either @code{function_definition} or @code{class_definition}. +@end defvar + @node Skipping Characters @subsection Skipping Characters @cindex skipping characters diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 4454188cc4a..2f277ea73ae 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -558,11 +558,13 @@ differences, like @code{char-equal} when @code{case-fold-search} is @cindex locale-dependent string equivalence @defun string-collate-equalp string1 string2 &optional locale ignore-case This function returns @code{t} if @var{string1} and @var{string2} are -equal with respect to collation rules. A collation rule is not only +equal with respect to the collation rules of the specified +@var{locale}, which defaults to your current system locale. A +collation rule is not only determined by the lexicographic order of the characters contained in -@var{string1} and @var{string2}, but also further rules about +@var{string1} and @var{string2}, but also by further rules about relations between these characters. Usually, it is defined by the -@var{locale} environment Emacs is running with and by the Standard C +locale environment with which Emacs is running and by the Standard C library against which Emacs was linked@footnote{ For more information about collation rules and their locale dependencies, see @uref{https://unicode.org/reports/tr10/, The Unicode @@ -589,8 +591,12 @@ dependent; a @var{locale} @code{"en_US.UTF-8"} is applicable on POSIX systems, while it would be, e.g., @code{"enu_USA.1252"} on MS-Windows systems. -If @var{ignore-case} is non-@code{nil}, characters are converted to lower-case -before comparing them. +If @var{ignore-case} is non-@code{nil}, characters are compared +case-insensitively, by converting them to lower-case. However, if the +underlying system library doesn't provide locale-specific collation +rules, this function falls back to @code{string-equal}, in which case +the @var{ignore-case} argument is ignored, and the comparison will +always be case-sensitive. @vindex w32-collate-ignore-punctuation To emulate Unicode-compliant collation on MS-Windows systems, @@ -672,11 +678,13 @@ This function returns the result of comparing @var{string1} and @cindex locale-dependent string comparison @defun string-collate-lessp string1 string2 &optional locale ignore-case This function returns @code{t} if @var{string1} is less than -@var{string2} in collation order. A collation order is not only +@var{string2} in collation order of the specified @var{locale}, which +defaults to your current system locale. A collation order is not only determined by the lexicographic order of the characters contained in -@var{string1} and @var{string2}, but also further rules about +@var{string1} and @var{string2}, but also by further rules about relations between these characters. Usually, it is defined by the -@var{locale} environment Emacs is running with. +locale environment with which Emacs is running, and by the Standard C +library against which Emacs was linked. For example, punctuation and whitespace characters might be ignored for sorting (@pxref{Sequence Functions}): @@ -706,8 +714,12 @@ systems. The @var{locale} value of @code{"POSIX"} or @code{"C"} lets @end group @end example -If @var{ignore-case} is non-@code{nil}, characters are converted to lower-case -before comparing them. +If @var{ignore-case} is non-@code{nil}, characters are compared +case-insensitively, by converting them to lower-case. However, if the +underlying system library doesn't provide locale-specific collation +rules, this function falls back to @code{string-lessp}, in which case +the @var{ignore-case} argument is ignored, and the comparison will +always be case-sensitive. To emulate Unicode-compliant collation on MS-Windows systems, bind @code{w32-collate-ignore-punctuation} to a non-@code{nil} value, since diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 793c22949c8..ef938e88ecf 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5460,6 +5460,10 @@ Extensions are usually shared-library files; on GNU and Unix systems, they have the @file{.so} file-name extension. @end defun +@defun sqlite-version +Return a string denoting the version of the SQLite library in use. +@end defun + @findex sqlite-mode-open-file If you wish to list the contents of an SQLite file, you can use the @code{sqlite-mode-open-file} command. This will pop to a buffer using diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 872e5f88f55..83728be0a54 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -560,11 +560,12 @@ favors the @samp{rms@@gnu.org.gpg} form for usernames over the param was provided. In general, if you prefer idiosyncrasies traditionally exhibited by -this backend, such as prioritizing field count in a filename, try -setting this option to @code{nil}. But, if you experience problems -predicting the outcome of searches relative to other auth-source -backends or encounter code expecting to query multiple backends -uniformly, try flipping it back to @code{t} (the default). +this backend, such as prioritizing field count in a filename or +matching against subdomain labels, keep this option set to @code{nil} +(the default). But, if you experience problems predicting the outcome +of searches relative to other auth-source backends or encounter code +expecting to query multiple backends uniformly, try flipping it to +@code{t}. @end defvar @node Help for developers diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index bade04fb95c..a8f5248c4c8 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -898,7 +898,7 @@ lines. @vindex defun-tactic @r{(c-)} Move to the beginning or end of the current or next function. Other -constructs (such as a structs or classes) which have a brace block +constructs (such as structs or classes) which have a brace block also count as ``functions'' here. To move over several functions, you can give these commands a repeat count. diff --git a/doc/misc/edt.texi b/doc/misc/edt.texi index 8b4ac0da5d6..d6f9c9faf9b 100644 --- a/doc/misc/edt.texi +++ b/doc/misc/edt.texi @@ -317,7 +317,7 @@ emulation. Emacs binds keys to @acronym{ASCII} control characters and so does the real EDT@. Where EDT key bindings and Emacs key bindings conflict, the default Emacs key bindings are retained by the EDT emulation by -default. If you are a diehard EDT user you may not like this. The +default. If you are a die-hard EDT user you may not like this. The @ref{Control keys} section explains how to change this so that the EDT bindings to @acronym{ASCII} control characters override the default Emacs bindings. @@ -443,7 +443,7 @@ the PC @key{NumLock} keypad key will be configurable for the emulation of the @key{PF1} key. The PC keypad can now emulate an LK-201 keypad (less the comma key), the standard keyboard supplied with DEC terminals VT-200 and above. This @file{.xmodmaprc} file switches the role of the -@key{F12} and @key{NumLock} keys. It has been tested on RedHat +@key{F12} and @key{NumLock} keys. It has been tested on Red Hat GNU/Linux 5.2. Other versions of GNU/Linux may require different keycodes. (@ref{Unix} for further help on how to do this.) @@ -460,7 +460,7 @@ keycode assignments vary from system to system, some investigation is needed to see how to do this on a particular system. You will need to look at the output generated by @code{xmodmap} invoked -with the "-pm" switch. For example, on RedHat GNU/Linux 5.2 on a PC, we +with the "-pm" switch. For example, on Red Hat GNU/Linux 5.2 on a PC, we get the following output when running @samp{xmodmap -pm}: @example @@ -495,7 +495,7 @@ keycode 96 = F12 . @end example -@noindent So, in RedHat GNU/Linux 5.2 on a PC, Num_Lock generates keycode 77. +@noindent So, in Red Hat GNU/Linux 5.2 on a PC, Num_Lock generates keycode 77. The following steps are taken: @enumerate @@ -883,7 +883,7 @@ Here are some examples: (setq edt-word-entities '(?\t) ; specifies TAB, the default @end example -@noindent You can also specify characters by their decimal ascii values: +@noindent You can also specify characters by their decimal ASCII values: @example (setq edt-word-entities '(9 45 47)) ; specifies TAB, - , and / @@ -893,7 +893,7 @@ Here are some examples: @section Enabling EDT Control Key Sequence Bindings Where EDT key bindings and Emacs key bindings conflict, the default -Emacs key bindings are retained by default. Some diehard EDT users +Emacs key bindings are retained by default. Some die-hard EDT users may not like this. So, if the variable @code{edt-use-EDT-control-key-bindings} is set to true in a user's @file{.emacs} file, then the default EDT Emulation mode will enable most diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi index b58f6be7581..bc3f545b2bb 100644 --- a/doc/misc/efaq-w32.texi +++ b/doc/misc/efaq-w32.texi @@ -457,12 +457,12 @@ to your init file: @node Using with Explorer @subsection For use with Internet Explorer @cindex Internet Explorer, view source in Emacs -@cindex mailto urls, associating with Emacs -@cindex news urls, associating with Emacs +@cindex mailto URLs, associating with Emacs +@cindex news URLs, associating with Emacs @cindex URLs, associating mail and news URLs with Emacs You can use Emacs as the editor for composing mail for -@indicateurl{mailto:} links, reading usenet for @indicateurl{news:} +@indicateurl{mailto:} links, reading Usenet for @indicateurl{news:} links, and viewing source. The following registry entries control this: diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 04bdcc61614..a815aebf59b 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -280,7 +280,7 @@ able to find it. Sometimes, multiple servers are acceptable alternatives for handling a given major-mode. In those cases, you may combine the helper function -@code{eglot-alternatives} with the funcional form of +@code{eglot-alternatives} with the functional form of @code{eglot-server-programs}. @lisp @@ -994,8 +994,8 @@ this variable should be a property list of the following format: Here @code{:@var{server}} identifies a particular language server and @var{plist} is the corresponding keyword-value property list of one or more parameter settings for that server, serialized by Eglot as a JSON -object. @var{plist} may be arbitrarity complex, generally containing -other keywork-value property sublists corresponding to JSON subobjects. +object. @var{plist} may be arbitrarily complex, generally containing +other keyword-value property sublists corresponding to JSON subobjects. The JSON values @code{true}, @code{false}, @code{null} and @code{@{@}} are represented by the Lisp values @code{t}, @code{:json-false}, @code{nil}, and @code{eglot-@{@}}, respectively. diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi index 1b9f5e10400..8c8a6f3154a 100644 --- a/doc/misc/emacs-gnutls.texi +++ b/doc/misc/emacs-gnutls.texi @@ -132,7 +132,7 @@ PEM or DER format and examples can be found in most Unix distributions. By default the following locations are tried in this order: @file{/etc/ssl/certs/ca-certificates.crt} for Debian, Ubuntu, Gentoo and Arch Linux; @file{/etc/pki/tls/certs/ca-bundle.crt} for -Fedora and RHEL; @file{/etc/ssl/ca-bundle.pem} for Suse; +Fedora and RHEL; @file{/etc/ssl/ca-bundle.pem} for SUSE; @file{/usr/ssl/certs/ca-bundle.crt} for Cygwin; @file{/usr/local/share/certs/ca-root-nss.crt} for FreeBSD@. You can easily customize @code{gnutls-trustfiles} to be something else, but diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 0d807e323e6..e165adbb498 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -78,6 +78,7 @@ Getting Started Advanced Usage * Connecting:: Ways of connecting to an IRC server. +* SASL:: Authenticating via SASL. * Sample Configuration:: An example configuration file. * Integrations:: Integrations available for ERC. * Options:: Options that are available for ERC. @@ -390,8 +391,11 @@ modules are loaded. There is a spiffy customize interface, which may be reached by typing @kbd{M-x customize-option @key{RET} erc-modules @key{RET}}. -Alternatively, set @code{erc-modules} manually and then call -@code{erc-update-modules}. +When removing a module outside of the Custom ecosystem, you may wish +to ensure it's disabled by invoking its associated minor-mode toggle, +such as @kbd{M-x erc-spelling-mode @key{RET}}. Note that, these days, +calling @code{erc-update-modules} in an init file is typically +unnecessary. The following is a list of available modules. @@ -479,6 +483,10 @@ Replace text in messages @item ring Enable an input history +@cindex modules, sasl +@item sasl +Enable SASL authentication + @cindex modules, scrolltobottom @item scrolltobottom Scroll to the bottom of the buffer @@ -517,6 +525,38 @@ Translate morse code in messages @end table +@subheading Local Modules +@cindex local modules + +All modules operate as minor modes under the hood, and some newer ones +may be defined as buffer-local. These so-called ``local modules'' are +a work in progress and their behavior and interface are subject to +change. As of ERC 5.5, the only practical differences are + +@enumerate +@item +``Control variables,'' like @code{erc-sasl-mode}, are stateful across +IRC sessions and override @code{erc-module} membership when influencing +module activation in new sessions. +@item +Removing a local module from @code{erc-modules} via Customize not only +disables its mode but also kills its control variable in all ERC +buffers. +@item +``Mode toggles,'' like @code{erc-sasl-mode} and +@code{erc-sasl-enable}, behave differently relative to each other and +to their global counterparts. (More on this just below.) +@end enumerate + +By default, all local-mode toggles, like @code{erc-sasl-mode}, only +affect the current buffer, but their ``non-mode'' variants, such as +@code{erc-sasl-enable}, operate on all buffers belonging to a +connection when called interactively. Keep in mind that whether +enabled or not, a module may effectively be ``inert'' in certain types +of buffers, such as queries and channels. Whatever the case, a local +toggle never mutates @code{erc-modules}. + + @c PRE5_4: Document every option of every module in its own subnode @@ -526,6 +566,7 @@ Translate morse code in messages @menu * Connecting:: Ways of connecting to an IRC server. +* SASL:: Authenticating via SASL * Sample Configuration:: An example configuration file. * Integrations:: Integrations available for ERC. * Options:: Options that are available for ERC. @@ -598,6 +639,7 @@ while helpers, like @code{erc-compute-nick}, will determine other parameters, and some, like @code{client-certificate}, will just be @code{nil}. +@anchor{ERC client-certificate} To use a certificate with @code{erc-tls}, specify the optional @var{client-certificate} keyword argument, whose value should be as described in the documentation of @code{open-network-stream}: if @@ -732,7 +774,10 @@ ERC should automatically attempt to connect with another nickname. You can manually set another nickname with the /NICK command. @end defopt +@anchor{ERC username} @subheading User +@cindex user + @defun erc-compute-user &optional user Determine a suitable value to send as the first argument of the opening @samp{USER} IRC command by consulting the following sources: @@ -844,6 +889,7 @@ netrc's case). The actual key goes in the @samp{password} (or @noindent For details, @pxref{Top,,auth-source, auth, Emacs auth-source Library}. +@anchor{ERC auth-source functions} @defopt erc-auth-source-server-function @end defopt @defopt erc-auth-source-services-function @@ -856,7 +902,8 @@ current context, if any. For example, with NickServ queries, @code{:user} is the ``desired'' nickname rather than the current one. Generalized names, like @code{:user} and @code{:host}, are always used over back-end specific ones, like @code{:login} or @code{:machine}. -ERC expects a string to use as the secret or nil, if the search fails. +ERC expects a string to use as the secret or @code{nil}, if the search +fails. @findex erc-auth-source-search The default value for all three options is the function @@ -918,6 +965,143 @@ When providing an ID as an entry-point argument, strings and symbols make the most sense, but any reasonably printable object is acceptable. +@node SASL +@section Authenticating via SASL +@cindex SASL + +Regardless of the mechanism or the network, you'll likely have to be +registered before first use. Please refer to the network's own +instructions for details. If you're new to IRC and using a bouncer, +know that you probably won't be needing SASL for the client-to-bouncer +connection. To get started, just add @code{sasl} to +@code{erc-modules} like any other module. But before that, please +explore all custom options pertaining to your chosen mechanism. + +@defopt erc-sasl-mechanism +The name of an SASL subprotocol type as a @emph{lowercase} symbol. + +@var{plain} and @var{scram} (``password-based''): + +@indentedblock +Here, ``password'' refers to your account password, which is usually +your @samp{NickServ} password. To make this work, customize +@code{erc-sasl-user} and @code{erc-sasl-password} or specify the +@code{:user} and @code{:password} keyword arguments when invoking +@code{erc-tls}. Note that @code{:user} cannot be given interactively. +@end indentedblock + +@var{external} (via Client TLS Certificate): + +@indentedblock +This works in conjunction with the @code{:client-certificate} keyword +offered by @code{erc-tls}. Just ensure you've registered your +fingerprint with the network beforehand. The fingerprint is usually a +SHA1 or SHA256 digest in either "normalized" or "openssl" forms. The +first is lowercase without delims (@samp{deadbeef}) and the second +uppercase with colon seps (@samp{DE:AD:BE:EF}). These days, there's +usually a @samp{CERT ADD} command offered by NickServ that can +register you automatically if you issue it while connected with a +client cert. (@pxref{ERC client-certificate}). + +Additional considerations: +@enumerate +@item +Most IRCds will allow you to authenticate with a client cert but +without the hassle of SASL (meaning you may not need this module). +@item +Technically, @var{EXTERNAL} merely indicates that an out-of-band mode +of authentication is in effect (being deferred to), so depending on +the specific application or service, there's a remote chance your +server has something else in mind. +@end enumerate +@end indentedblock + +@var{ecdsa-nist256p-challenge}: + +@indentedblock +This mechanism is quite complicated and currently requires the +external @samp{openssl} executable, so please use something else if at +all possible. Ignoring that, specify your key file (e.g., +@samp{~/pki/mykey.pem}) as the value of @code{erc-sasl-password}, and +then configure your network settings. On servers running Atheme +services, you can add your public key with @samp{NickServ} like so: + +@example +ERC> /msg NickServ set property \ + pubkey AgGZmlYTUjJlea/BVz7yrjJ6gysiAPaQxzeUzTH4hd5j + +@end example +(You may be able to omit the @samp{property} subcommand.) +@end indentedblock + +@end defopt + +@defopt erc-sasl-user +This should be your network account username, typically the same one +registered with nickname services. Specify this when your NickServ +login differs from the @code{:user} you're connecting with. +(@pxref{ERC username}) +@end defopt + +@defopt erc-sasl-password +As noted elsewhere, the @code{:password} parameter for @code{erc-tls} +was originally intended for traditional ``server passwords,'' but these +aren't really used any more. As such, this option defaults to +borrowing that parameter for its own uses, thus allowing you to call +@code{erc-tls} with @code{:password} set to your NickServ password. + +You can also set this to a nonemtpy string, and ERC will send that +when needed, no questions asked. If you instead give a non-@code{nil} +symbol (other than @code{:password}), like @samp{Libera.Chat}, ERC +will use it for the @code{:host} field in an auth-source query. +Actually, the same goes for when this option is @code{nil} but an +explicit session ID is already on file (@pxref{Network Identifier}). +For all such queries, ERC specifies the resolved value of +@code{erc-sasl-user} for the @code{:user} (@code{:login}) param. Keep +in mind that none of this matters unless +@code{erc-sasl-auth-source-function} holds a function, and it's +@code{nil} by default. As a last resort, ERC will prompt you for +input. + +Lastly, if your mechanism is @code{ecdsa-nist256p-challenge}, this +option should instead hold the file name of your key. +@end defopt + +@defopt erc-sasl-auth-source-function +This is nearly identical to the other ERC @samp{auth-source} function +options (@pxref{ERC auth-source functions}) except that the default +value here is @code{nil}, meaning you have to set it to something like +@code{erc-auth-source-search} for queries to be performed. +@end defopt + +@defopt erc-sasl-authzid +In the rarest of circumstances, a network may want you to specify a +specific role or assume an alternate identity. In most cases, this +happens because the server is buggy or misconfigured. If you suspect +such a thing, please contact your network operator. Otherwise, just +leave this set to @code{nil}. +@end defopt + +@subheading Troubleshooting + +@strong{Warning:} ERC's SASL offering is currently limited by a lack +of support for proper IRCv3 capability negotiation. In most cases, +this shouldn't affect your ability to authenticate. + +If you're struggling, remember that your SASL password is almost +always your NickServ password. When in doubt, try restoring all SASL +options to their defaults and calling @code{erc-tls} with @code{:user} +set to your NickServ account name and @code{:password} to your +NickServ password. If you're still having trouble, please contact us +(@pxref{Getting Help and Reporting Bugs}). + +As you try out different settings, keep in mind that it's best to +create a fresh session for every change, for example, by calling +@code{erc-tls} from scratch. More experienced users may be able to +get away with cycling @code{erc-sasl-mode} and issuing a +@samp{/reconnect}, but that's generally not recommended. Whatever the +case, you'll probably want to temporarily disable +@code{erc-server-auto-reconnect} while experimenting. @node Sample Configuration @section Sample Configuration diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index 7cb5621b694..49022ac3415 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -144,9 +144,8 @@ information to disk (e.g., which messages you read), you are now asked if you want to restore that information from the auto-save file. -To prevent this message make sure you exit Gnus -via @samp{q} in group buffer instead of -just killing Emacs. +To prevent this message make sure you exit Gnus via @kbd{q} in group +buffer instead of just killing Emacs. @node FAQ 2-2 @subsubheading Question 2.2 @@ -180,25 +179,23 @@ example for this (guess from whose .gnus :-)): @node FAQ 2-4 @subsubheading Question 2.4 -My group buffer becomes a bit crowded, is there a way to -sort my groups into categories so I can easier browse -through them? +My group buffer is a bit crowded. Is there a way to sort groups into +categories so I can browse them more easily? @subsubheading Answer -Gnus offers the topic mode, it allows you to sort your -groups in, well, topics, e.g., all groups dealing with -Linux under the topic linux, all dealing with music under -the topic music and all dealing with scottish music under -the topic scottish which is a subtopic of music. +Gnus offers the topic mode, it allows you to sort your groups in, +well, topics. For example, all groups dealing with Linux under the +topic @samp{linux}, all dealing with music under the topic +@samp{music} and all dealing with Scottish music under the topic +@samp{scottish} which is a subtopic of @samp{music}. -To enter topic mode, just hit t while in Group buffer. Now -you can use @samp{T n} to create a topic -at point and @samp{T m} to move a group to -a specific topic. For more commands see the manual or the -menu. You might want to include the %P specifier at the -beginning of your gnus-group-line-format variable to have -the groups nicely indented. +To enter topic mode, just hit @kbd{t} while in Group buffer. Now you +can use @kbd{T n} to create a topic at point and @kbd{T m} to move a +group to a specific topic. For more commands see the manual or the +menu. You might want to include the @samp{%P} specifier at the +beginning of your @var{gnus-group-line-format} variable to have the +groups nicely indented. @node FAQ 2-5 @subsubheading Question 2.5 @@ -208,16 +205,14 @@ sort the groups in a topic? @subsubheading Answer -Move point over the group you want to move and -hit @samp{C-k}, now move point to the -place where you want the group to be and -hit @samp{C-y}. +Move point over the group you want to move and hit @kbd{C-k}, now move +point to the place where you want the group to be and hit @kbd{C-y}. @node FAQ 3 - Getting Messages @subsection Getting Messages @menu -* FAQ 3-1:: I just installed Gnus, started it via @samp{M-x gnus} +* FAQ 3-1:: I just installed Gnus, started it via @kbd{M-x gnus} but it only says "nntp (news) open error", what to do? * FAQ 3-2:: I'm working under Windows and have no idea what ~/.gnus.el means. @@ -242,9 +237,8 @@ hit @samp{C-y}. @node FAQ 3-1 @subsubheading Question 3.1 -I just installed Gnus, started it via -@samp{M-x gnus} -but it only says "nntp (news) open error", what to do? +I just installed Gnus, started it via @kbd{M-x gnus} but it only says +"nntp (news) open error", what to do? @subsubheading Answer @@ -270,7 +264,7 @@ The ~/ means the home directory where Gnus and Emacs look for the configuration files. However, you don't really need to know what this means, it suffices that Emacs knows what it means :-) You can type -@samp{C-x C-f ~/.gnus.el @key{RET}} +@kbd{C-x C-f ~/.gnus.el @key{RET}} (yes, with the forward slash, even on Windows), and Emacs will open the right file for you. (It will most likely be new, and thus empty.) @@ -295,7 +289,7 @@ possibility to set environment variables. Create a new one with name HOME and value C:\myhome. Rebooting is not necessary. Now to create @file{~/.gnus.el}, say -@samp{C-x C-f ~/.gnus.el @key{RET} C-x C-s}. +@kbd{C-x C-f ~/.gnus.el @key{RET} C-x C-s}. in Emacs. @node FAQ 3-3 @@ -331,14 +325,12 @@ subscribe to a group. @subsubheading Answer -If you know the name of the group say @samp{U -name.of.group @key{RET}} in group buffer (use the -tab-completion Luke). Otherwise hit ^ in group buffer, -this brings you to the server buffer. Now place point (the -cursor) over the server which carries the group you want, -hit @samp{@key{RET}}, move point to the group -you want to subscribe to and say @samp{u} -to subscribe to it. +If you know the name of the group say @kbd{U name.of.group @key{RET}} +in group buffer (use the tab-completion Luke). Otherwise hit @kbd{^} +in group buffer, this brings you to the server buffer. Now place +point (the cursor) over the server which carries the group you want, +hit @kbd{RET}, move point to the group you want to subscribe to and +say @kbd{u} to subscribe to it. @node FAQ 3-5 @subsubheading Question 3.5 @@ -625,12 +617,10 @@ When I enter a group, all read messages are gone. How to view them again? @subsubheading Answer -If you enter the group by saying -@samp{@key{RET}} -in group buffer with point over the group, only unread and ticked messages are loaded. Say -@samp{C-u @key{RET}} -instead to load all available messages. If you want only the 300 newest say -@samp{C-u 300 @key{RET}} +If you enter the group by saying @kbd{@key{RET}} in group buffer with +point over the group, only unread and ticked messages are loaded. Say +@kbd{C-u @key{RET}} instead to load all available messages. If you +want only the 300 newest say @kbd{C-u 300 @key{RET}} Loading only unread messages can be annoying if you have threaded view enabled, say @@ -643,12 +633,12 @@ in @file{~/.gnus.el} to load enough old articles to prevent teared threads, repl all articles (Warning: Both settings enlarge the amount of data which is fetched when you enter a group and slow down the process of entering a group). -You can say @samp{/o N} in the summary buffer to load the last N +You can say @kbd{/o N} in the summary buffer to load the last N messages. If you don't want all old messages, but the parent of the message you're just reading, -you can say @samp{^}, if you want to retrieve the whole thread -the message you're just reading belongs to, @samp{A T} is your friend. +you can say @kbd{^}, if you want to retrieve the whole thread +the message you're just reading belongs to, @kbd{A T} is your friend. @node FAQ 4-2 @subsubheading Question 4.2 @@ -659,10 +649,10 @@ enter a group, even when it's read? @subsubheading Answer You can tick important messages. To do this hit -@samp{u} while point is in summary buffer +@kbd{u} while point is in summary buffer over the message. When you want to remove the mark, hit -either @samp{d} (this deletes the tick -mark and set's unread mark) or @samp{M c} +either @kbd{d} (this deletes the tick +mark and set's unread mark) or @kbd{M c} (which deletes all marks for the message). @node FAQ 4-3 @@ -672,10 +662,7 @@ How to view the headers of a message? @subsubheading Answer -Say @samp{t} -to show all headers, one more -@samp{t} -hides them again. +Say @kbd{t} to show all headers, one more @kbd{t} hides them again. @node FAQ 4-4 @subsubheading Question 4.4 @@ -684,11 +671,8 @@ How to view the raw unformatted message? @subsubheading Answer -Say -@samp{C-u g} -to show the raw message -@samp{g} -returns to normal view. +Type @kbd{C-u g} to show the raw message @kbd{g} returns to normal +view. @node FAQ 4-5 @subsubheading Question 4.5 @@ -765,11 +749,11 @@ more readable? Gnus offers you several functions to ``wash'' incoming mail, you can find them if you browse through the menu, item Article->Washing. The most interesting ones are probably ``Wrap -long lines'' (@samp{W w}), ``Decode ROT13'' -(@samp{W r}) and ``Outlook Deuglify'' which repairs +long lines'' (@kbd{W w}), ``Decode ROT13'' +(@kbd{W r}) and ``Outlook Deuglify'' which repairs the dumb quoting used by many users of Microsoft products -(@samp{W Y f} gives you full deuglify. -See @samp{W Y C-h} or have a look at the menus for +(@kbd{W Y f} gives you full deuglify. +See @kbd{W Y C-h} or have a look at the menus for other deuglifications). @node FAQ 4-9 @@ -792,21 +776,21 @@ the scoring-value to messages. The first and easiest way is to set up rules based on the article you are just reading. Say you're reading a message by a guy who always writes nonsense and you want to ignore his messages in the future. Hit -@samp{L}, to set up a rule which lowers the score. +@kbd{L}, to set up a rule which lowers the score. Now Gnus asks you which the criteria for lowering the Score shall -be. Hit @samp{?} twice to see all possibilities, -we want @samp{a} which means the author (the from +be. Hit @kbd{?} twice to see all possibilities, +we want @kbd{a} which means the author (the from header). Now Gnus wants to know which kind of matching we want. -Hit either @samp{e} for an exact match or -@samp{s} for substring-match and delete afterwards +Hit either @kbd{e} for an exact match or +@kbd{s} for substring-match and delete afterwards everything but the name to score down all authors with the given name no matter which email address is used. Now you need to tell Gnus when to apply the rule and how long it should last, hit -@samp{p} to apply the rule now and let it last +@kbd{p} to apply the rule now and let it last forever. If you want to raise the score instead of lowering it say -@samp{I} instead of @samp{L}. +@kbd{I} instead of @kbd{L}. -You can also set up rules by hand. To do this say @samp{V +You can also set up rules by hand. To do this say @kbd{V f} in summary buffer. Then you are asked for the name of the score file, it's name.of.group.SCORE for rules valid in only one group or all.Score for rules valid in all groups. See the @@ -851,7 +835,7 @@ set other variables specific for some groups? @subsubheading Answer While in group buffer move point over the group and hit -@samp{G c}, this opens a buffer where you +@kbd{G c}, this opens a buffer where you can set options for the group. At the bottom of the buffer you'll find an item that allows you to set variables locally for the group. To disable threading enter @@ -889,10 +873,10 @@ back ends. Gnus thinks ``highest-article-number @minus{} lowest-article-number = total-number-of-articles''. This works OK for Usenet groups, but if you delete and move many messages in mail groups, this fails. To cure the -symptom, enter the group via @samp{C-u @key{RET}} +symptom, enter the group via @kbd{C-u @key{RET}} (this makes Gnus get all messages), then -hit @samp{M P b} to mark all messages and -then say @samp{B m name.of.group} to move +hit @kbd{M P b} to mark all messages and +then say @kbd{B m name.of.group} to move all messages to the group they have been in before, they get new message numbers in this process and the count is right again (until you delete and move your mail to other @@ -1110,28 +1094,20 @@ What are the basic commands I need to know for sending mail and postings? @subsubheading Answer -To start composing a new mail hit @samp{m} -either in Group or Summary buffer, for a posting, it's -either @samp{a} in Group buffer and -filling the Newsgroups header manually -or @samp{a} in the Summary buffer of the -group where the posting shall be send to. Replying by mail -is -@samp{r} if you don't want to cite the -author, or import the cited text manually and -@samp{R} to cite the text of the original -message. For a follow up to a newsgroup, it's -@samp{f} and @samp{F} -(analogously to @samp{r} and -@samp{R}). - -Enter new headers above the line saying "--text follows -this line--", enter the text below the line. When ready -hit @samp{C-c C-c}, to send the message, -if you want to finish it later hit @samp{C-c -C-d} to save it in the drafts group, where you -can start editing it again by saying @samp{D -e}. +To start composing a new mail hit @kbd{m} either in Group or Summary +buffer, for a posting, it's either @kbd{a} in Group buffer and filling +the Newsgroups header manually or @kbd{a} in the Summary buffer of the +group where the posting shall be send to. Replying by mail is @kbd{r} +if you don't want to cite the author, or import the cited text +manually and @kbd{R} to cite the text of the original message. For a +follow up to a newsgroup, it's @kbd{f} and @kbd{F} (analogously to +@kbd{r} and @kbd{R}). + +Enter new headers above the line saying "--text follows this line--", +enter the text below the line. When ready hit @kbd{C-c C-c}, to send +the message, if you want to finish it later hit @kbd{C-c C-d} to save +it in the drafts group, where you can start editing it again by saying +@kbd{D e}. @node FAQ 5-2 @subsubheading Question 5.2 @@ -1156,8 +1132,7 @@ For other versions of Gnus, say in @file{~/.gnus.el}. -You can reformat a paragraph by hitting @samp{M-q} -(as usual). +You can reformat a paragraph by hitting @kbd{M-q} (as usual). @node FAQ 5-3 @subsubheading Question 5.3 @@ -1358,16 +1333,13 @@ place them in ~/.emacs: @end example @noindent -Now you should be ready to go. Say @samp{M-x bbdb @key{RET} -@key{RET}} to open a bbdb buffer showing all -entries. Say @samp{c} to create a new -entry, @samp{b} to search your BBDB and -@samp{C-o} to add a new field to an -entry. If you want to add a sender to the BBDB you can -also just hit @kbd{:} on the posting in the summary buffer and -you are done. When you now compose a new mail, -hit @samp{TAB} to cycle through know -recipients. +Now you should be ready to go. Say @kbd{M-x bbdb @key{RET} @key{RET}} +to open a bbdb buffer showing all entries. Say @kbd{c} to create a +new entry, @kbd{b} to search your BBDB and @kbd{C-o} to add a new +field to an entry. If you want to add a sender to the BBDB you can +also just hit @kbd{:} on the posting in the summary buffer and you are +done. When you now compose a new mail, hit @kbd{TAB} to cycle through +know recipients. @node FAQ 5-8 @subsubheading Question 5.8 @@ -1576,17 +1548,17 @@ world, you may find tools at Now you've got to import this mbox file into Gnus. To do this, create a nndoc group based on the mbox file by -saying @samp{G f /path/file.mbox @key{RET}} in +saying @kbd{G f /path/file.mbox @key{RET}} in Group buffer. You now have read-only access to your mail. If you want to import the messages to your normal Gnus mail groups hierarchy, enter the nndoc group you've -just created by saying @samp{C-u @key{RET}} +just created by saying @kbd{C-u @key{RET}} (thus making sure all messages are retrieved), mark all -messages by saying @samp{M P b} and +messages by saying @kbd{M P b} and either copy them to the desired group by saying -@samp{B c name.of.group @key{RET}} or send them +@kbd{B c name.of.group @key{RET}} or send them through nnmail-split-methods (respool them) by saying -@samp{B r}. +@kbd{B r}. @node FAQ 6-2 @subsubheading Question 6.2 @@ -1598,7 +1570,7 @@ How to archive interesting messages? If you stumble across an interesting message, say in gnu.emacs.gnus and want to archive it there are several solutions. The first and easiest is to save it to a file -by saying @samp{O f}. However, wouldn't +by saying @kbd{O f}. However, wouldn't it be much more convenient to have more direct access to the archived message from Gnus? If you say yes, put this snippet by Frank Haun <pille3003@@fhaun.de> in @@ -1621,10 +1593,9 @@ more then one article." @end example @noindent -You can now say @samp{M-x -my-archive-article} in summary buffer to -archive the article under the cursor in a nnml -group. (Change nnml to your preferred back end.) +You can now say @kbd{M-x my-archive-article} in summary buffer to +archive the article under the cursor in a nnml group. (Change nnml to +your preferred back end.) Of course you can also make sure the cache is enabled by saying @@ -1644,26 +1615,20 @@ How to search for a specific message? @subsubheading Answer -There are several ways for this, too. For a posting from -a Usenet group the easiest solution is probably to ask -@uref{https://groups.google.com, groups.google.com}, -if you found the posting there, tell Google to display -the raw message, look for the message-id, and say -@samp{M-^ the@@message.id @key{RET}} in a -summary buffer. -There's a Gnus interface for -groups.google.com which you can call with -@samp{G W}) in group buffer. - -Another idea which works for both mail and news groups -is to enter the group where the message you are -searching is and use the standard Emacs search -@samp{C-s}, it's smart enough to look at -articles in collapsed threads, too. If you want to -search bodies, too try @samp{M-s} -instead. Further on there are the -gnus-summary-limit-to-foo functions, which can help you, -too. +There are several ways for this, too. For a posting from a Usenet +group the easiest solution is probably to ask +@uref{https://groups.google.com, groups.google.com}, if you found the +posting there, tell Google to display the raw message, look for the +message-id, and say @kbd{M-^ the@@message.id @key{RET}} in a summary +buffer. There's a Gnus interface for @samp{groups.google.com} which +you can call with @kbd{G W}) in group buffer. + +Another idea which works for both mail and news groups is to enter the +group where the message you are searching is and use the standard +Emacs search @kbd{C-s}, it's smart enough to look at articles in +collapsed threads, too. If you want to search bodies, too try +@kbd{M-s} instead. Further on there are the gnus-summary-limit-to-foo +functions, which can help you, too. @node FAQ 6-4 @subsubheading Question 6.4 @@ -1673,18 +1638,18 @@ How to get rid of old unwanted mail? @subsubheading Answer You can of course just mark the mail you don't need -anymore by saying @samp{#} with point -over the mail and then say @samp{B @key{DEL}} +anymore by saying @kbd{#} with point +over the mail and then say @kbd{B @key{DEL}} to get rid of them forever. You could also instead of actually deleting them, send them to a junk-group by -saying @samp{B m nnml:trash-bin} which +saying @kbd{B m nnml:trash-bin} which you clear from time to time, but both are not the intended way in Gnus. In Gnus, we let mail expire like news expires on a news server. That means you tell Gnus the message is expirable (you tell Gnus "I don't need this mail -anymore") by saying @samp{E} with point +anymore") by saying @kbd{E} with point over the mail in summary buffer. Now when you leave the group, Gnus looks at all messages which you marked as expirable before and if they are old enough (default is @@ -1703,13 +1668,13 @@ mailing lists where there's an online archive), you've got two choices: auto-expire and total-expire. Auto-expire means, that every article which has no marks set and is selected for reading is -marked as expirable, Gnus hits @samp{E} +marked as expirable, Gnus hits @kbd{E} for you every time you read a message. Total-expire follows a slightly different approach, here all article where the read mark is set are expirable. To activate auto-expire, include auto-expire in the -Group parameters for the group. (Hit @samp{G +Group parameters for the group. (Hit @kbd{G c} in summary buffer with point over the group to change group parameters). For total-expire add total-expire to the group-parameters. @@ -1721,10 +1686,10 @@ you should use total-expire. If you want a message to be excluded from expiration in a group where total or auto expire is active, set either -tick (hit @samp{u}) or dormant mark (hit -@samp{u}), when you use auto-expire, you +tick (hit @kbd{u}) or dormant mark (hit +@kbd{u}), when you use auto-expire, you can also set the read mark (hit -@samp{d}). +@kbd{d}). @node FAQ 6-6 @subsubheading Question 6.6 @@ -1817,12 +1782,12 @@ newsreaders like Forte Agent. It is enabled by default. You've got to select the servers whose groups can be stored locally. To do this, open the server buffer -(that is press @samp{^} while in the +(that is press @kbd{^} while in the group buffer). Now select a server by moving point to the line naming that server. Finally, agentize the -server by typing @samp{J a}. If you +server by typing @kbd{J a}. If you make a mistake, or change your mind, you can undo this -action by typing @samp{J r}. When +action by typing @kbd{J r}. When you're done, type 'q' to return to the group buffer. Now the next time you enter a group on an agentized server, the headers will be stored on disk and read from @@ -1838,7 +1803,7 @@ I want to store article bodies on disk, too. How to do it? You can tell the agent to automatically fetch the bodies of articles which fulfill certain predicates, this is done in a special buffer which can be reached by -saying @samp{J c} in group +saying @kbd{J c} in group buffer. Please refer to the documentation for information which predicates are possible and how exactly to do it. @@ -1847,12 +1812,12 @@ Further on you can tell the agent manually which articles to store on disk. There are two ways to do this: Number one: In the summary buffer, process mark a set of articles that shall be stored in the agent by -saying @samp{#} with point over the -article and then type @samp{J s}. The +saying @kbd{#} with point over the +article and then type @kbd{J s}. The other possibility is to set, again in the summary buffer, downloadable (%) marks for the articles you -want by typing @samp{@@} with point over -the article and then typing @samp{J u}. +want by typing @kbd{@@} with point over +the article and then typing @kbd{J u}. What's the difference? Well, process marks are erased as soon as you exit the summary buffer while downloadable marks are permanent. You can actually set downloadable @@ -1874,10 +1839,10 @@ while I'm offline? All you've got to do is to tell Gnus when you are online (plugged) and when you are offline (unplugged), the rest works automatically. You can toggle plugged/unplugged -state by saying @samp{J j} in group -buffer. To start Gnus unplugged say @samp{M-x +state by saying @kbd{J j} in group +buffer. To start Gnus unplugged say @kbd{M-x gnus-unplugged} instead of -@samp{M-x gnus}. Note that for this to +@kbd{M-x gnus}. Note that for this to work, the agent must be active. @node FAQ 8 - Getting help @@ -1901,14 +1866,14 @@ How to find information and help inside Emacs? @subsubheading Answer The first stop should be the Gnus manual (Say -@samp{C-h i d m Gnus @key{RET}} to start the +@kbd{C-h i d m Gnus @key{RET}} to start the Gnus manual, then walk through the menus or do a -full-text search with @samp{s}). Then +full-text search with @kbd{s}). Then there are the general Emacs help commands starting with -C-h, type @samp{C-h ? ?} to get a list +@kbd{C-h}, type @kbd{C-h ? ?} to get a list of all available help commands and their meaning. Finally -@samp{M-x apropos-command} lets you -search through all available functions and @samp{M-x +@kbd{M-x apropos-command} lets you +search through all available functions and @kbd{M-x apropos} searches the bound variables. @node FAQ 8-2 @@ -1963,7 +1928,7 @@ Where to report bugs? @subsubheading Answer -Say @samp{M-x gnus-bug}, this will start +Say @kbd{M-x gnus-bug}, this will start a message to the @email{bugs@@gnus.org, gnus bug mailing list} including information about your environment which make @@ -1998,7 +1963,7 @@ The reason for this could be the way Gnus reads its active file, see the node "The Active File" in the Gnus manual for things you might try to speed the process up. An other idea would be to byte compile your @file{~/.gnus.el} (say -@samp{M-x byte-compile-file @key{RET} ~/.gnus.el +@kbd{M-x byte-compile-file @key{RET} ~/.gnus.el @key{RET}} to do it). Finally, if you have require statements in your .gnus, you could replace them with @code{with-eval-after-load}, which loads the stuff not at startup diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index c4705928d33..10f7bd94f7e 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -402,21 +402,21 @@ This manual corresponds to Gnus v5.13 @end iftex @menu -* Don't Panic:: Your first 20 minutes with Gnus. -* Starting Up:: Finding news can be a pain. -* Group Buffer:: Selecting, subscribing and killing groups. -* Summary Buffer:: Reading, saving and posting articles. -* Article Buffer:: Displaying and handling articles. -* Composing Messages:: Information on sending mail and news. -* Select Methods:: Gnus reads all messages from various select methods. -* Scoring:: Assigning values to articles. -* Searching:: Mail and News search engines. -* Various:: General purpose settings. -* The End:: Farewell and goodbye. -* Appendices:: Terminology, Emacs intro, @acronym{FAQ}, History, Internals. -* GNU Free Documentation License:: The license for this documentation. -* Index:: Variable, function and concept index. -* Key Index:: Key Index. +* Don't Panic:: Your first 20 minutes with Gnus. +* Starting Up:: Finding news can be a pain. +* Group Buffer:: Selecting, subscribing and killing groups. +* Summary Buffer:: Reading, saving and posting articles. +* Article Buffer:: Displaying and handling articles. +* Composing Messages:: Information on sending mail and news. +* Select Methods:: Gnus reads all messages from various select methods. +* Scoring:: Assigning values to articles. +* Searching:: Mail and News search engines. +* Various:: General purpose settings. +* The End:: Farewell and goodbye. +* Appendices:: Terminology, Emacs intro, @acronym{FAQ}, History, Internals. +* GNU Free Documentation License:: The license for this documentation. +* Index:: Variable, function and concept index. +* Key Index:: Key Index. @c Doesn't work right in html. @c FIXME Do this in a more standard way. @@ -589,14 +589,15 @@ Decoding Variables Article Treatment * Article Highlighting:: You want to make the article look like fruit salad. -* Article Fontisizing:: Making emphasized text look nice. +* Article Fontifying:: Making emphasized text look nice. * Article Hiding:: You also want to make certain info go away. * Article Washing:: Lots of way-neat functions to make life better. * Article Header:: Doing various header transformations. * Article Buttons:: Click on URLs, Message-IDs, addresses and the like. * Article Button Levels:: Controlling appearance of buttons. * Article Date:: Grumble, UT! -* Article Display:: Display various stuff---X-Face, Picons, Smileys, Gravatars +* Article Display:: Display various stuff: + X-Face, Picons, Gravatars, Smileys. * Article Signature:: What is a signature? * Article Miscellanea:: Various other stuff. @@ -641,7 +642,7 @@ Select Methods * Getting Mail:: Reading your personal mail with Gnus. * Browsing the Web:: Getting messages from a plethora of Web sources. * Other Sources:: Reading directories, files. -* Virtual Groups:: Combining articles from multiple sources. +* Virtual Groups:: Combining articles and groups together. * Email Based Diary:: Using mails to manage diary events in Gnus. * Gnus Unplugged:: Reading news and mail offline. @@ -666,6 +667,13 @@ Getting News * Indirect Functions:: Connecting indirectly to the server. * Common Variables:: Understood by several connection functions. +Using IMAP + +* Connecting to an IMAP Server:: Getting started with @acronym{IMAP}. +* Customizing the IMAP Connection:: Variables for @acronym{IMAP} connection. +* Client-Side IMAP Splitting:: Put mail in the correct mail box. +* Support for IMAP Extensions:: Getting extensions and labels from servers. + Getting Mail * Mail in a Newsreader:: Important introductory notes. @@ -685,6 +693,7 @@ Getting Mail Mail Sources * Mail Source Specifiers:: How to specify what a mail source is. +* Mail Source Functions:: * Mail Source Customization:: Some variables that influence things. * Fetching Mail:: Using the mail source specifiers. @@ -695,6 +704,10 @@ Choosing a Mail Back End * Mail Spool:: Store your mail in a private spool? * MH Spool:: An mhspool-like back end. * Maildir:: Another one-file-per-message format. +* nnmaildir Group Parameters:: +* Article Identification:: +* NOV Data:: +* Article Marks:: * Mail Folders:: Having one file for each group. * Comparing Mail Back Ends:: An in-depth looks at pros and cons. @@ -734,10 +747,10 @@ The NNDiary Back End The Gnus Diary Library -* Diary Summary Line Format:: A nicer summary buffer line format. -* Diary Articles Sorting:: A nicer way to sort messages. -* Diary Headers Generation:: Not doing it manually. -* Diary Group Parameters:: Not handling them manually. +* Diary Summary Line Format:: A nicer summary buffer line format. +* Diary Articles Sorting:: A nicer way to sort messages. +* Diary Headers Generation:: Not doing it manually. +* Diary Group Parameters:: Not handling them manually. Gnus Unplugged @@ -796,9 +809,22 @@ Advanced Scoring Searching * Search Engines:: Selecting and configuring search engines. -* Creating Search Groups:: Creating search groups. +* Creating Search Groups:: How and where. * Search Queries:: Gnus' built-in search syntax. * nnmairix:: Searching with Mairix. +* nnir:: + +nnmairix + +* About mairix:: About the mairix mail search engine +* nnmairix requirements:: What you will need for using nnmairix +* What nnmairix does:: What does nnmairix actually do? +* Setting up mairix:: Set up your mairix installation +* Configuring nnmairix:: Set up the nnmairix back end +* nnmairix keyboard shortcuts:: List of available keyboard shortcuts +* Propagating marks:: How to propagate marks from nnmairix groups +* nnmairix tips and tricks:: Some tips, tricks and examples +* nnmairix caveats:: Some more stuff you might want to know Various @@ -839,8 +865,7 @@ Image Enhancements * X-Face:: Display a funky, teensy black-and-white image. * Face:: Display a funkier, teensier colored image. -* Smileys:: Show all those happy faces the way they were - meant to be shown. +* Smileys:: Show all those happy faces the way they were meant to be shown. * Picons:: How to display pictures of what you're reading. * Gravatars:: Display the avatar of people you read. @@ -862,12 +887,39 @@ Spam Package * Extending the Spam package:: * Spam Statistics Package:: +Spam Back Ends + +* Blacklists and Whitelists:: +* BBDB Whitelists:: +* Gmane Spam Reporting:: +* Anti-spam Hashcash Payments:: +* Blackholes:: +* Regular Expressions Header Matching:: +* Bogofilter:: +* SpamAssassin back end:: +* ifile spam filtering:: +* Spam Statistics Filtering:: +* SpamOracle:: + Spam Statistics Package * Creating a spam-stat dictionary:: * Splitting mail using spam-stat:: * Low-level interface to the spam-stat dictionary:: +The Gnus Registry + +* Gnus Registry Setup:: +* Registry Article Refer Method:: +* Fancy splitting to parent:: +* Store custom flags and keywords:: +* Store arbitrary data:: + +The Gnus Cloud + +* Gnus Cloud Setup:: +* Gnus Cloud Usage:: + Appendices * History:: How Gnus got where it is today. @@ -895,7 +947,7 @@ New Features * Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7. * Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9. * Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11. -* No Gnus:: Very punny. Gnus 5.12/5.13 +* No Gnus:: Very punny. Gnus 5.12/5.13. * Ma Gnus:: Celebrating 25 years of Gnus. Customization @@ -1002,7 +1054,7 @@ The fundamental building blocks of Gnus are @dfn{servers}, Each server maintains a list of groups, and those groups contain articles. Because Gnus presents a unified interface to a wide variety of servers, the vocabulary doesn't always quite line up (@pxref{FAQ -- Glossary}, for a more complete glossary). Thus a local maildir is +- Glossary}, for a more complete glossary). Thus a local Maildir is referred to as a ``server'' (@pxref{Finding the News}) the same as a Usenet or IMAP server is; ``groups'' (@pxref{Group Buffer}) might mean an NNTP group, IMAP folder, or local mail directory; and an @@ -1039,7 +1091,7 @@ the News}, for details. New mail has to come from somewhere. Some servers, such as NNTP or IMAP, are themselves responsible for fetching newly-arrived articles. -Others, such as maildir or mbox servers, only store articles and don't +Others, such as Maildir or mbox servers, only store articles and don't fetch them from anywhere. In the latter case, Gnus provides for @code{mail sources}: places @@ -1099,15 +1151,15 @@ If you puzzle at any terms used in this manual, please refer to the terminology section (@pxref{Terminology}). @menu -* Finding the News:: Choosing a method for getting news. -* The Server is Down:: How can I read my mail then? -* Child Gnusae:: You can have more than one Gnus active at a time. -* New Groups:: What is Gnus supposed to do with new groups? -* Changing Servers:: You may want to move from one server to another. -* Startup Files:: Those pesky startup files---@file{.newsrc}. -* Auto Save:: Recovering from a crash. -* The Active File:: Reading the active file over a slow line Takes Time. -* Startup Variables:: Other variables you might change. +* Finding the News:: Choosing a method for getting news. +* The Server is Down:: How can I read my mail then? +* Child Gnusae:: You can have more than one Gnus active at a time. +* New Groups:: What is Gnus supposed to do with new groups? +* Changing Servers:: You may want to move from one server to another. +* Startup Files:: Those pesky startup files---@file{.newsrc}. +* Auto Save:: Recovering from a crash. +* The Active File:: Reading the active file over a slow line Takes Time. +* Startup Variables:: Other variables you might change. @end menu @@ -2907,8 +2959,6 @@ sending the message if @code{gnus-add-to-list} is set to @code{t}. If this variable is set, @code{gnus-mailing-list-mode} is turned on when entering summary buffer. -See also @code{gnus-parameter-to-list-alist}. - @anchor{subscribed} @item subscribed @cindex subscribed @@ -8718,7 +8768,7 @@ these articles easier. @menu * Article Highlighting:: You want to make the article look like fruit salad. -* Article Fontisizing:: Making emphasized text look nice. +* Article Fontifying:: Making emphasized text look nice. * Article Hiding:: You also want to make certain info go away. * Article Washing:: Lots of way-neat functions to make life better. * Article Header:: Doing various header transformations. @@ -8840,8 +8890,8 @@ default. @xref{Customizing Articles}, for how to highlight articles automatically. -@node Article Fontisizing -@subsection Article Fontisizing +@node Article Fontifying +@subsection Article Fontifying @cindex emphasis @cindex article emphasis @@ -16758,8 +16808,7 @@ value is @code{nil}. Do @emph{not} use the same maildir both in @code{mail-sources} and as an @code{nnmaildir} group. The results might happen to be useful, but that would be by chance, not by design, and the results might be -different in the future. If your split rules create new groups, -remember to supply a @code{create-directory} server parameter. +different in the future. @end table @node nnmaildir Group Parameters @@ -18399,10 +18448,10 @@ useful things for you. @menu -* Diary Summary Line Format:: A nicer summary buffer line format. -* Diary Articles Sorting:: A nicer way to sort messages. -* Diary Headers Generation:: Not doing it manually. -* Diary Group Parameters:: Not handling them manually. +* Diary Summary Line Format:: A nicer summary buffer line format. +* Diary Articles Sorting:: A nicer way to sort messages. +* Diary Headers Generation:: Not doing it manually. +* Diary Group Parameters:: Not handling them manually. @end menu @node Diary Summary Line Format @@ -21579,10 +21628,11 @@ relative date parsing and tie-ins into other Emacs packages. For details on Gnus' query language, see @ref{Search Queries}. @menu -* Search Engines:: Selecting and configuring search engines. -* Creating Search Groups:: How and where. -* Search Queries:: Gnus' built-in search syntax. -* nnmairix:: Searching with Mairix. +* Search Engines:: Selecting and configuring search engines. +* Creating Search Groups:: How and where. +* Search Queries:: Gnus' built-in search syntax. +* nnmairix:: Searching with Mairix. +* nnir:: @end menu @node Search Engines @@ -21878,7 +21928,7 @@ bound to mairix searches and are automatically updated. * What nnmairix does:: What does nnmairix actually do? * Setting up mairix:: Set up your mairix installation * Configuring nnmairix:: Set up the nnmairix back end -* nnmairix keyboard shortcuts:: List of available keyboard shortcuts +* nnmairix keyboard shortcuts:: List of available keyboard shortcuts * Propagating marks:: How to propagate marks from nnmairix groups * nnmairix tips and tricks:: Some tips, tricks and examples * nnmairix caveats:: Some more stuff you might want to know @@ -26488,7 +26538,7 @@ keyboard shortcuts like @kbd{M M i} for Important, using the first letter. @end defvar -@defun gnus-registry-mark-article +@defun gnus-registry-set-article-mark Call this function to mark an article with a custom registry mark. It will offer the available marks for completion. @end defun diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi index 4bdbd5c2196..0c59fdf7385 100644 --- a/doc/misc/idlwave.texi +++ b/doc/misc/idlwave.texi @@ -3799,7 +3799,7 @@ configuration is not possible, but choices abound. The default @code{idlwave-help-browser-function} inherits the browser configured in @code{browse-url-browser-function}. -Note that the HTML files decompiled from the help sources contain +Note that the HTML files recompiled from the help sources contain specific references to the @samp{Symbol} font, which by default is not permitted in normal encodings (it's invalid, technically). Though it only impacts a few symbols, you can trick Mozilla-based browsers into diff --git a/doc/misc/mairix-el.texi b/doc/misc/mairix-el.texi index 3632c64bd46..28b86c43aca 100644 --- a/doc/misc/mairix-el.texi +++ b/doc/misc/mairix-el.texi @@ -70,7 +70,7 @@ database. Mairix is a tool for indexing and searching words in locally stored mail. It was written by Richard Curnow and is licensed under the GPL@. Mairix comes with most popular GNU/Linux distributions, but it also -runs under Windows (with cygwin), macOS and Solaris. The website can +runs under Windows (with Cygwin), macOS and Solaris. The website can be found at @uref{http://www.rpcurnow.force9.co.uk/mairix/index.html} diff --git a/doc/misc/message.texi b/doc/misc/message.texi index cfad4f4e07e..fb6e97f0d3d 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -935,7 +935,7 @@ Manual}). @section IDNA @cindex IDNA @cindex internationalized domain names -@cindex non-ascii domain names +@cindex non-ASCII domain names @acronym{IDNA} is a standard way to encode non-@acronym{ASCII} domain names into a readable @acronym{ASCII} string. The details can be diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 09f2d28c2f2..cfc77a84ea8 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2022-09-21.15} +\def\texinfoversion{2022-11-12.22} % % Copyright 1985, 1986, 1988, 1990-2022 Free Software Foundation, Inc. % @@ -2544,34 +2544,30 @@ end \scriptfont\sffam=\sevensf } -% -% The font-changing commands (all called \...fonts) redefine the meanings -% of \STYLEfont, instead of just \STYLE. We do this because \STYLE needs -% to also set the current \fam for math mode. Our \STYLE (e.g., \rm) -% commands hardwire \STYLEfont to set the current font. -% -% The fonts used for \ifont are for "math italics" (\itfont is for italics -% in regular text). \syfont is also used in math mode only. -% -% Each font-changing command also sets the names \lsize (one size lower) -% and \lllsize (three sizes lower). These relative commands are used -% in, e.g., the LaTeX logo and acronyms. -% -% This all needs generalizing, badly. + +% \defineassignfonts{SIZE} - +% Define sequence \assignfontsSIZE, which switches between font sizes +% by redefining the meanings of \STYLEfont. (Just \STYLE additionally sets +% the current \fam for math mode.) % +\def\defineassignfonts#1{% + \expandafter\edef\csname assignfonts#1\endcsname{% + \let\noexpand\rmfont\csname #1rm\endcsname + \let\noexpand\itfont\csname #1it\endcsname + \let\noexpand\slfont\csname #1sl\endcsname + \let\noexpand\bffont\csname #1bf\endcsname + \let\noexpand\ttfont\csname #1tt\endcsname + \let\noexpand\smallcaps\csname #1sc\endcsname + \let\noexpand\sffont \csname #1sf\endcsname + \let\noexpand\ifont \csname #1i\endcsname + \let\noexpand\syfont \csname #1sy\endcsname + \let\noexpand\ttslfont\csname #1ttsl\endcsname + } +} \def\assignfonts#1{% - \expandafter\let\expandafter\rmfont\csname #1rm\endcsname - \expandafter\let\expandafter\itfont\csname #1it\endcsname - \expandafter\let\expandafter\slfont\csname #1sl\endcsname - \expandafter\let\expandafter\bffont\csname #1bf\endcsname - \expandafter\let\expandafter\ttfont\csname #1tt\endcsname - \expandafter\let\expandafter\smallcaps\csname #1sc\endcsname - \expandafter\let\expandafter\sffont \csname #1sf\endcsname - \expandafter\let\expandafter\ifont \csname #1i\endcsname - \expandafter\let\expandafter\syfont \csname #1sy\endcsname - \expandafter\let\expandafter\ttslfont\csname #1ttsl\endcsname + \csname assignfonts#1\endcsname } \newif\ifrmisbold @@ -2595,12 +2591,21 @@ end \csname\curfontstyle\endcsname }% +% Define the font-changing commands (all called \...fonts). +% Each font-changing command also sets the names \lsize (one size lower) +% and \lllsize (three sizes lower). These relative commands are used +% in, e.g., the LaTeX logo and acronyms. +% +% Note: The fonts used for \ifont are for "math italics" (\itfont is for +% italics in regular text). \syfont is also used in math mode only. +% \def\definefontsetatsize#1#2#3#4#5{% + \defineassignfonts{#1}% \expandafter\def\csname #1fonts\endcsname{% \def\curfontsize{#1}% \def\lsize{#2}\def\lllsize{#3}% \csname rmisbold#5\endcsname - \assignfonts{#1}% + \csname assignfonts#1\endcsname \resetmathfonts \setleading{#4}% }} @@ -2645,9 +2650,16 @@ end % Check if we are currently using a typewriter font. Since all the % Computer Modern typewriter fonts have zero interword stretch (and % shrink), and it is reasonable to expect all typewriter fonts to have -% this property, we can check that font parameter. -% -\def\ifmonospace{\ifdim\fontdimen3\font=0pt } +% this property, we can check that font parameter. #1 is what to +% print if we are indeed using \tt; #2 is what to print otherwise. +\def\ifusingtt#1#2{\ifdim \fontdimen3\font=0pt #1\else #2\fi} + +% Same as above, but check for italic font. Actually this also catches +% non-italic slanted fonts since it is impossible to distinguish them from +% italic fonts. But since this is only used by $ and it uses \sl anyway +% this is not a problem. +\def\ifusingit#1#2{\ifdim \fontdimen1\font>0pt #1\else #2\fi} + % Check if internal flag is clear, i.e. has not been @set. \def\ifflagclear#1#2#3{% @@ -2655,8 +2667,6 @@ end #2\else#3\fi } - - { \catcode`\'=\active \catcode`\`=\active @@ -2672,33 +2682,28 @@ end % lilypond developers report. xpdf does work with the regular 0x27. % \def\codequoteright{% - \ifmonospace - \ifflagclear{txicodequoteundirected}{% - \ifflagclear{codequoteundirected}{% - '% - }{\char'15 }% - }{\char'15 }% - \else - '% - \fi + \ifusingtt + {\ifflagclear{txicodequoteundirected}% + {\ifflagclear{codequoteundirected}% + {'}% + {\char'15 }}% + {\char'15 }}% + {'}% } -% + % and a similar option for the left quote char vs. a grave accent. % Modern fonts display ASCII 0x60 as a grave accent, so some people like % the code environments to do likewise. +% \relax disables Spanish ligatures ?` and !` of \tt font. % \def\codequoteleft{% - \ifmonospace - \ifflagclear{txicodequotebacktick}{% - \ifflagclear{codequotebacktick}{% - % [Knuth] pp. 380,381,391 - % \relax disables Spanish ligatures ?` and !` of \tt font. - \relax`% - }{\char'22 }% - }{\char'22 }% - \else - \relax`% - \fi + \ifusingtt + {\ifflagclear{txicodequotebacktick}% + {\ifflagclear{codequotebacktick}% + {\relax`}% + {\char'22 }}% + {\char'22 }}% + {\relax`}% } % Commands to set the quote options. @@ -2817,20 +2822,29 @@ end \def\nohyphenation{\hyphenchar\font = -1 \aftergroup\restorehyphenation} \def\restorehyphenation{\hyphenchar\font = `- } +\newif\iffrenchspacing +\frenchspacingfalse + % Set sfcode to normal for the chars that usually have another value. % Can't use plain's \frenchspacing because it uses the `\x notation, and % sometimes \x has an active definition that messes things up. % \catcode`@=11 \def\plainfrenchspacing{% - \sfcode`\.=\@m \sfcode`\?=\@m \sfcode`\!=\@m - \sfcode`\:=\@m \sfcode`\;=\@m \sfcode`\,=\@m - \def\endofsentencespacefactor{1000}% for @. and friends + \iffrenchspacing\else + \frenchspacingtrue + \sfcode`\.=\@m \sfcode`\?=\@m \sfcode`\!=\@m + \sfcode`\:=\@m \sfcode`\;=\@m \sfcode`\,=\@m + \def\endofsentencespacefactor{1000}% for @. and friends + \fi } \def\plainnonfrenchspacing{% - \sfcode`\.3000\sfcode`\?3000\sfcode`\!3000 - \sfcode`\:2000\sfcode`\;1500\sfcode`\,1250 - \def\endofsentencespacefactor{3000}% for @. and friends + \iffrenchspacing + \frenchspacingfalse + \sfcode`\.3000\sfcode`\?3000\sfcode`\!3000 + \sfcode`\:2000\sfcode`\;1500\sfcode`\,1250 + \def\endofsentencespacefactor{3000}% for @. and friends + \fi } \catcode`@=\other \def\endofsentencespacefactor{3000}% default @@ -3389,8 +3403,8 @@ $$% \let\atchar=\@ % @{ @} @lbracechar{} @rbracechar{} all generate brace characters. -\def\lbracechar{{\ifmonospace\char123\else\ensuremath\lbrace\fi}} -\def\rbracechar{{\ifmonospace\char125\else\ensuremath\rbrace\fi}} +\def\lbracechar{{\ifusingtt{\char123}{\ensuremath\lbrace}}} +\def\rbracechar{{\ifusingtt{\char125}{\ensuremath\rbrace}}} \let\{=\lbracechar \let\}=\rbracechar @@ -3537,7 +3551,7 @@ $$% % @pounds{} is a sterling sign, which Knuth put in the CM italic font. % -\def\pounds{\ifmonospace{\ecfont\char"BF}\else{\it\$}\fi} +\def\pounds{{\ifusingtt{\ecfont\char"BF}{\it\$}}} % @euro{} comes from a separate font, depending on the current style. % We use the free feym* fonts from the eurosym package by Henrik @@ -3651,18 +3665,17 @@ $$% % hopefully nobody will notice/care. \edef\ecsize{\csname\curfontsize ecsize\endcsname}% \edef\nominalsize{\csname\curfontsize nominalsize\endcsname}% - \ifmonospace - % typewriter: - \font\thisecfont = #1ctt\ecsize \space at \nominalsize - \else - \ifx\curfontstyle\bfstylename - % bold: - \font\thisecfont = #1cb\ifusingit{i}{x}\ecsize \space at \nominalsize - \else - % regular: - \font\thisecfont = #1c\ifusingit{ti}{rm}\ecsize \space at \nominalsize - \fi - \fi + \ifusingtt + % typewriter: + {\font\thisecfont = #1ctt\ecsize \space at \nominalsize}% + % else + {\ifx\curfontstyle\bfstylename + % bold: + \font\thisecfont = #1cb\ifusingit{i}{x}\ecsize \space at \nominalsize + \else + % regular: + \font\thisecfont = #1c\ifusingit{ti}{rm}\ecsize \space at \nominalsize + \fi}% \thisecfont } @@ -3678,7 +3691,10 @@ $$% % @textdegree - the normal degrees sign. % -\def\textdegree{$^\circ$} +\def\textdegree{% + \ifmmode ^\circ + \else {\tcfont \char 176}% + \fi} % Laurent Siebenmann reports \Orb undefined with: % Textures 1.7.7 (preloaded format=plain 93.10.14) (68K) 16 APR 2004 02:38 @@ -3695,11 +3711,11 @@ $$% % only change font for tt for correct kerning and to avoid using % \ecfont unless necessary. \def\quotedblleft{% - \ifmonospace{\ecfont\char"10}\else{\char"5C}\fi + \ifusingtt{{\ecfont\char"10}}{{\char"5C}}% } \def\quotedblright{% - \ifmonospace{\ecfont\char"11}\else{\char`\"}\fi + \ifusingtt{{\ecfont\char"11}}{{\char`\"}}% } @@ -5257,7 +5273,10 @@ $$% \xdef\trimmed{\segment}% \xdef\trimmed{\expandafter\eatspaces\expandafter{\trimmed}}% \xdef\indexsortkey{\trimmed}% - \ifx\indexsortkey\empty\xdef\indexsortkey{ }\fi + \ifx\indexsortkey\empty + \message{Empty index sort key near line \the\inputlineno}% + \xdef\indexsortkey{ }% + \fi }\fi % % Append to \fullindexsortkey. @@ -6386,6 +6405,16 @@ might help (with 'rm \jobname.?? \jobname.??s')% \def\Yappendixkeyword{Yappendix} \def\Yomitfromtockeyword{Yomitfromtoc} % +% +% Definitions for @thischapter. These can be overridden in translation +% files. +\def\thischapterAppendix{% + \putwordAppendix{} \thischapternum: \thischaptername} + +\def\thischapterChapter{% + \putwordChapter{} \thischapternum: \thischaptername} +% +% \def\chapmacro#1#2#3{% \expandafter\ifx\thisenv\titlepage\else \checkenv{}% chapters, etc., should not start inside an environment. @@ -6408,22 +6437,14 @@ might help (with 'rm \jobname.?? \jobname.??s')% \xdef\currentchapterdefs{% \gdef\noexpand\thischaptername{\the\toks0}% \gdef\noexpand\thischapternum{\appendixletter}% - % \noexpand\putwordAppendix avoids expanding indigestible - % commands in some of the translations. - \gdef\noexpand\thischapter{\noexpand\putwordAppendix{} - \noexpand\thischapternum: - \noexpand\thischaptername}% + \let\noexpand\thischapter\noexpand\thischapterAppendix }% \else \toks0={#1}% \xdef\currentchapterdefs{% \gdef\noexpand\thischaptername{\the\toks0}% \gdef\noexpand\thischapternum{\the\chapno}% - % \noexpand\putwordChapter avoids expanding indigestible - % commands in some of the translations. - \gdef\noexpand\thischapter{\noexpand\putwordChapter{} - \noexpand\thischapternum: - \noexpand\thischaptername}% + \let\noexpand\thischapter\noexpand\thischapterChapter }% \fi\fi\fi % @@ -6509,6 +6530,12 @@ might help (with 'rm \jobname.?? \jobname.??s')% \def\subsubsecheadingskip{\subsecheadingskip} \def\subsubsecheadingbreak{\subsecheadingbreak} +% Definition for @thissection. This can be overridden in translation +% files. +\def\thissectionDef{% + \putwordSection{} \thissectionnum: \thissectionname} +% + % Print any size, any type, section title. % @@ -6550,11 +6577,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \xdef\currentsectiondefs{% \gdef\noexpand\thissectionname{\the\toks0}% \gdef\noexpand\thissectionnum{#4}% - % \noexpand\putwordSection avoids expanding indigestible - % commands in some of the translations. - \gdef\noexpand\thissection{\noexpand\putwordSection{} - \noexpand\thissectionnum: - \noexpand\thissectionname}% + \let\noexpand\thissection\noexpand\thissectionDef }% \fi \else @@ -6563,11 +6586,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \xdef\currentsectiondefs{% \gdef\noexpand\thissectionname{\the\toks0}% \gdef\noexpand\thissectionnum{#4}% - % \noexpand\putwordSection avoids expanding indigestible - % commands in some of the translations. - \gdef\noexpand\thissection{\noexpand\putwordSection{} - \noexpand\thissectionnum: - \noexpand\thissectionname}% + \let\noexpand\thissection\noexpand\thissectionDef }% \fi \fi\fi\fi @@ -7107,12 +7126,19 @@ might help (with 'rm \jobname.?? \jobname.??s')% \startsavinginserts \lskip=\leftskip \rskip=\rightskip \leftskip=0pt\rightskip=0pt % we want these *outside*. + % + % Set paragraph width for text inside cartouche. There are + % left and right margins of 3pt each plus two vrules 0.4pt each. \cartinner=\hsize \advance\cartinner by-\lskip \advance\cartinner by-\rskip + \advance\cartinner by -6.8pt + % + % For drawing top and bottom of cartouche. Each corner char + % adds 6pt and we take off the width of a rule to line up with the + % right boundary perfectly. \cartouter=\hsize - \advance\cartouter by 18.4pt % allow for 3pt kerns on either - % side, and for 6pt waste from - % each corner char, and rule thickness + \advance\cartouter by 11.6pt + % \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip % % If this cartouche directly follows a sectioning command, we need the @@ -8405,21 +8431,21 @@ might help (with 'rm \jobname.?? \jobname.??s')% \ifcase\paramno % 0 \expandafter\xdef\csname\the\macname\endcsname{% - \bgroup + \begingroup \noexpand\spaceisspace \noexpand\endlineisspace \noexpand\expandafter % skip any whitespace after the macro name. \expandafter\noexpand\csname\the\macname @@@\endcsname}% \expandafter\xdef\csname\the\macname @@@\endcsname{% - \egroup + \endgroup \noexpand\scanmacro{\macrobody}}% \or % 1 \expandafter\xdef\csname\the\macname\endcsname{% - \bgroup + \begingroup \noexpand\braceorline \expandafter\noexpand\csname\the\macname @@@\endcsname}% \expandafter\xdef\csname\the\macname @@@\endcsname##1{% - \egroup + \endgroup \noexpand\scanmacro{\macrobody}% }% \else % at most 9 @@ -8430,7 +8456,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% % @MACNAME@@@ removes braces surrounding the argument list. % @MACNAME@@@@ scans the macro body with arguments substituted. \expandafter\xdef\csname\the\macname\endcsname{% - \bgroup + \begingroup \noexpand\expandafter % This \expandafter skip any spaces after the \noexpand\macroargctxt % macro before we change the catcode of space. \noexpand\expandafter @@ -8444,7 +8470,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \expandafter\xdef \expandafter\expandafter \csname\the\macname @@@@\endcsname\paramlist{% - \egroup\noexpand\scanmacro{\macrobody}}% + \endgroup\noexpand\scanmacro{\macrobody}}% \else % 10 or more: \expandafter\xdef\csname\the\macname\endcsname{% \noexpand\getargvals@{\the\macname}{\argl}% @@ -8887,11 +8913,10 @@ might help (with 'rm \jobname.?? \jobname.??s')% \xrefprintnodename\printedrefname % \ifflagclear{txiomitxrefpg}{% - % But we always want a comma and a space: - ,\space - % + % We always want a comma + ,% % output the `page 3'. - \turnoffactive \putwordpage\tie\refx{#1-pg}% + \turnoffactive \putpageref{#1}% % Add a , if xref followed by a space \if\space\noexpand\tokenafterxref ,% \else\ifx\ \tokenafterxref ,% @TAB @@ -8907,6 +8932,10 @@ might help (with 'rm \jobname.?? \jobname.??s')% \endlink \endgroup} +% can be overridden in translation files +\def\putpageref#1{% + \space\putwordpage\tie\refx{#1-pg}} + % Output a cross-manual xref to #1. Used just above (twice). % % Only include the text "Section ``foo'' in" if the foo is neither @@ -9338,13 +9367,6 @@ might help (with 'rm \jobname.?? \jobname.??s')% \makevalueexpandable \ifvmode \imagevmodetrue - \else \ifx\centersub\centerV - % for @center @image, we need a vbox so we can have our vertical space - \imagevmodetrue - \vbox\bgroup % vbox has better behavior than vtop here - \fi\fi - % - \ifimagevmode \medskip % Usually we'll have text after the image which will insert % \parskip glue, so insert it here too to equalize the space @@ -9356,14 +9378,17 @@ might help (with 'rm \jobname.?? \jobname.??s')% \vtop\bgroup \kern -\capheight \vskip-\parskip \fi % - % Enter horizontal mode so that indentation from an enclosing - % environment such as @quotation is respected. - % However, if we're at the top level, we don't want the - % normal paragraph indentation. - % On the other hand, if we are in the case of @center @image, we don't - % want to start a paragraph, which will create a hsize-width box and - % eradicate the centering. - \ifx\centersub\centerV \else \imageindent \fi + \ifx\centersub\centerV + % For @center @image, enter vertical mode and add vertical space + % Enter an extra \parskip because @center doesn't add space itself. + \vbox\bgroup\vskip\parskip\medskip\vskip\parskip + \else + % Enter horizontal mode so that indentation from an enclosing + % environment such as @quotation is respected. + % However, if we're at the top level, we don't want the + % normal paragraph indentation. + \imageindent + \fi % % Output the image. \ifpdf @@ -9388,7 +9413,10 @@ might help (with 'rm \jobname.?? \jobname.??s')% \egroup \medskip % space after a standalone image \fi - \ifx\centersub\centerV \egroup \fi + \ifx\centersub\centerV % @center @image + \medskip + \egroup % close \vbox + \fi \endgroup} @@ -10038,7 +10066,7 @@ directory should work if nowhere else does.} \gdefchar^^ae{\v Z} \gdefchar^^af{\dotaccent Z} % - \gdefchar^^b0{\textdegree{}} + \gdefchar^^b0{\textdegree} \gdefchar^^b1{\ogonek{a}} \gdefchar^^b2{\ogonek{ }} \gdefchar^^b3{\l} @@ -10461,7 +10489,7 @@ directory should work if nowhere else does.} \DeclareUnicodeCharacter{00AE}{\registeredsymbol{}}% \DeclareUnicodeCharacter{00AF}{\={ }}% % - \DeclareUnicodeCharacter{00B0}{\ringaccent{ }}% + \DeclareUnicodeCharacter{00B0}{\textdegree} \DeclareUnicodeCharacter{00B1}{\ensuremath\pm}% \DeclareUnicodeCharacter{00B2}{$^2$}% \DeclareUnicodeCharacter{00B3}{$^3$}% @@ -10965,7 +10993,7 @@ directory should work if nowhere else does.} % \DeclareUnicodeCharacter{20AC}{\euro{}}% % - \DeclareUnicodeCharacter{2192}{\expansion{}}% + \DeclareUnicodeCharacter{2192}{\arrow}% \DeclareUnicodeCharacter{21D2}{\result{}}% % % Mathematical symbols @@ -11401,6 +11429,131 @@ directory should work if nowhere else does.} \hfuzz = 1pt +\message{microtype,} + +% protrusion, from Thanh's protcode.tex. +\def\mtsetprotcode#1{% + \rpcode#1`\!=200 \rpcode#1`\,=700 \rpcode#1`\-=700 \rpcode#1`\.=700 + \rpcode#1`\;=500 \rpcode#1`\:=500 \rpcode#1`\?=200 + \rpcode#1`\'=700 + \rpcode#1 34=500 % '' + \rpcode#1 123=300 % -- + \rpcode#1 124=200 % --- + \rpcode#1`\)=50 \rpcode#1`\A=50 \rpcode#1`\F=50 \rpcode#1`\K=50 + \rpcode#1`\L=50 \rpcode#1`\T=50 \rpcode#1`\V=50 \rpcode#1`\W=50 + \rpcode#1`\X=50 \rpcode#1`\Y=50 \rpcode#1`\k=50 \rpcode#1`\r=50 + \rpcode#1`\t=50 \rpcode#1`\v=50 \rpcode#1`\w=50 \rpcode#1`\x=50 + \rpcode#1`\y=50 + % + \lpcode#1`\`=700 + \lpcode#1 92=500 % `` + \lpcode#1`\(=50 \lpcode#1`\A=50 \lpcode#1`\J=50 \lpcode#1`\T=50 + \lpcode#1`\V=50 \lpcode#1`\W=50 \lpcode#1`\X=50 \lpcode#1`\Y=50 + \lpcode#1`\v=50 \lpcode#1`\w=50 \lpcode#1`\x=50 \lpcode#1`\y=0 + % + \mtadjustprotcode#1\relax +} + +\newcount\countC +\def\mtadjustprotcode#1{% + \countC=0 + \loop + \ifcase\lpcode#1\countC\else + \mtadjustcp\lpcode#1\countC + \fi + \ifcase\rpcode#1\countC\else + \mtadjustcp\rpcode#1\countC + \fi + \advance\countC 1 + \ifnum\countC < 256 \repeat +} + +\newcount\countB +\def\mtadjustcp#1#2#3{% + \setbox\boxA=\hbox{% + \ifx#2\font\else#2\fi + \char#3}% + \countB=\wd\boxA + \multiply\countB #1#2#3\relax + \divide\countB \fontdimen6 #2\relax + #1#2#3=\countB\relax +} + +\ifx\XeTeXrevision\thisisundefined + \ifx\luatexversion\thisisundefined + \ifpdf % pdfTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{\pdffontexpand#1 20 20 1 autoexpand\relax} + \else % TeX + \def\mtfontexpand#1{} + \fi + \else % LuaTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{\expandglyphsinfont#1 20 20 1\relax} + \fi +\else % XeTeX + \mtsetprotcode\textrm + \def\mtfontexpand#1{} +\fi + + +\newif\ifmicrotype + +\def\microtypeON{% + \microtypetrue + % + \ifx\XeTeXrevision\thisisundefined + \ifx\luatexversion\thisisundefined + \ifpdf % pdfTeX + \pdfadjustspacing=2 + \pdfprotrudechars=2 + \fi + \else % LuaTeX + \adjustspacing=2 + \protrudechars=2 + \fi + \else % XeTeX + \XeTeXprotrudechars=2 + \fi + % + \mtfontexpand\textrm + \mtfontexpand\textsl + \mtfontexpand\textbf +} + +\def\microtypeOFF{% + \microtypefalse + % + \ifx\XeTeXrevision\thisisundefined + \ifx\luatexversion\thisisundefined + \ifpdf % pdfTeX + \pdfadjustspacing=0 + \pdfprotrudechars=0 + \fi + \else % LuaTeX + \adjustspacing=0 + \protrudechars=0 + \fi + \else % XeTeX + \XeTeXprotrudechars=0 + \fi +} + +\microtypeON + +\parseargdef\microtype{% + \def\txiarg{#1}% + \ifx\txiarg\onword + \microtypeON + \else\ifx\txiarg\offword + \microtypeOFF + \else + \errhelp = \EMsimple + \errmessage{Unknown @microtype option `\txiarg', must be on|off}% + \fi\fi +} + + \message{and turning on texinfo input format.} \def^^L{\par} % remove \outer, so ^L can appear in an @comment @@ -11420,23 +11573,6 @@ directory should work if nowhere else does.} \catcode`\|=\other \def\normalverticalbar{|} \catcode`\~=\other \def\normaltilde{~} -% This macro is used to make a character print one way in \tt -% (where it can probably be output as-is), and another way in other fonts, -% where something hairier probably needs to be done. -% -% #1 is what to print if we are indeed using \tt; #2 is what to print -% otherwise. Since all the Computer Modern typewriter fonts have zero -% interword stretch (and shrink), and it is reasonable to expect all -% typewriter fonts to have this, we can check that font parameter. -% -\def\ifusingtt#1#2{\ifdim \fontdimen3\font=0pt #1\else #2\fi} - -% Same as above, but check for italic font. Actually this also catches -% non-italic slanted fonts since it is impossible to distinguish them from -% italic fonts. But since this is only used by $ and it uses \sl anyway -% this is not a problem. -\def\ifusingit#1#2{\ifdim \fontdimen1\font>0pt #1\else #2\fi} - % Set catcodes for Texinfo file % Active characters for printing the wanted glyph. diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index f638d4717a1..d0d84d0a987 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -48,10 +48,9 @@ hell. For some, auth-source may provide a workaround in the form of nonstandard server passwords. See the "Connection" node in the manual under the subheading "Password". -If you require SASL immediately, please participate in ERC development -by volunteering to try (and give feedback on) edge features, one of -which is SASL. All known external offerings, past and present, are -valiant efforts whose use is nevertheless discouraged. +** Rudimentary SASL support has arrived. +A new module, 'erc-sasl', now ships with ERC 5.5. See the SASL +section in the manual for details. ** Username argument for entry-point commands. Commands 'erc' and 'erc-tls' now accept a ':user' keyword argument, @@ -125,6 +124,15 @@ The function 'erc-auto-query' was deemed too difficult to reason through and has thus been deprecated with no public replacement; it has also been removed from the client code path. +The function 'erc-open' now delays running 'erc-mode-hook' members +until most local session variables have been initialized (minus those +connection-related ones in erc-backend). 'erc-open' also no longer +calls 'erc-update-modules', although modules are still activated +in an identical fashion. + +Some groundwork has been laid for what may become a new breed of ERC +module, namely, "connection-local" (or simply "local") modules. + A few internal variables have been introduced that could just as well have been made public, possibly as user options. Likewise for some internal functions. As always, users needing such functionality @@ -371,11 +371,6 @@ node in the Eshell manual for more details. *** Eshell pipelines now only pipe stdout by default. To pipe both stdout and stderr, use the '|&' operator instead of '|'. -*** New eshell built-in command 'doas'. -The privilege-escalation program 'doas' has been added to the existing -'su' and 'sudo' commands from the 'eshell-tramp' module. The external -command may still be accessed by using '*doas'. - --- ** The 'delete-forward-char' command now deletes by grapheme clusters. This command is by default bound to the <Delete> function key @@ -750,6 +745,14 @@ This determines how long to pause Emacs after a process filter/sentinel error has been handled. +++ +** New faces for font-lock. +These faces are primarily meant for use with tree-sitter. They are: +'font-lock-bracket-face', 'font-lock-delimiter-face', +'font-lock-escape-face', 'font-lock-number-face', +'font-lock-misc-punctuation-face', 'font-lock-operator-face', +'font-lock-property-face', and 'font-lock-punctuation-face'. + ++++ ** New face 'variable-pitch-text'. This face is like 'variable-pitch' (from which it inherits), but is slightly larger, which should help with the visual size differences @@ -1407,7 +1410,8 @@ database stored on disk. *** New user option 'auth-source-pass-extra-query-keywords'. Whether to recognize additional keyword params, like ':max' and ':require', as well as accept lists of query terms paired with -applicable keywords. +applicable keywords. This disables most known behavioral quirks +unique to auth-source-pass, such as wildcard subdomain matching. ** Dired @@ -1749,9 +1753,10 @@ the second one will switch to the "*Completions*" buffer. --- *** New user option 'completion-auto-wrap'. -When non-nil, the commands 'next-completion' and 'previous-completion' -automatically wrap around on reaching the beginning or the end of -the "*Completions*" buffer. +When non-nil, the commands 'next-completion', 'previous-completion', +'next-line-completion' and 'previous-line-completion' automatically +wrap around on reaching the beginning or the end of the "*Completions*" +buffer. +++ *** New values for the 'completion-auto-help' user option. @@ -2721,6 +2726,12 @@ duplicate one output handle to another via 'NEW-FD>&OLD-FD'. For more information, see the "(eshell) Redirection" node in the Eshell manual. +++ +*** New eshell built-in command 'doas'. +The privilege-escalation program 'doas' has been added to the existing +'su' and 'sudo' commands from the 'eshell-tramp' module. The external +command may still be accessed by using '*doas'. + ++++ *** Double-quoting an Eshell expansion now treats the result as a single string. If an Eshell expansion like '$FOO' is surrounded by double quotes, the result will always be a single string, no matter the type that would @@ -2756,10 +2767,11 @@ symlinks in the latter case). +++ *** Lisp forms in Eshell now treat a 'nil' result as a failed exit status. -When executing a command that looks like '(lisp form)', Eshell will -set the exit status (available in the '$?' variable) to 2. This -allows commands like that to be used as conditionals. To change this -behavior, customize the new 'eshell-lisp-form-nil-is-failure' option. +When executing a command that looks like '(lisp form)' and returns +'nil', Eshell will set the exit status (available in the '$?' +variable) to 2. This allows commands like that to be used in +conditionals. To change this behavior, customize the new +'eshell-lisp-form-nil-is-failure' option. ** Shell @@ -2897,6 +2909,11 @@ It copies the current line into the kill ring. The new face 'abbrev-table-name' is used to display the abbrev table name. +--- +*** New key binding "O" in `M-x list-buffer'. +This key is now bound to 'Buffer-menu-view-other-window', which will +view this line's buffer in View mode in another window. + * New Modes and Packages in Emacs 29.1 @@ -2952,6 +2969,45 @@ This is a lightweight variant of 'js-mode' that is used by default when visiting JSON files. +** New mode 'typescript-ts-mode'. +A major mode based on the tree-sitter library for editing programs +in the TypeScript language. It includes support for font-locking, +indentation, and navigation. + +** New mode 'c-ts-mode'. +A major mode based on the tree-sitter library for editing programs +in the C language. It includes support for font-locking, +indentation, Imenu, which-func, and navigation. + +** New mode 'c++-ts-mode'. +A major mode based on the tree-sitter library for editing programs +in the C++ language. It includes support for font-locking, +indentation, Imenu, which-func, and navigation. + +** New mode 'java-ts-mode'. +A major mode based on the tree-sitter library for editing programs +in the Java language. It includes support for font-locking, +indentation, Imenu, which-func, and navigation. + +** New mode 'css-ts-mode'. +A major mode based on the tree-sitter library for editing programs +in the CSS language. It includes support for font-locking, +indentation, Imenu, which-func, and navigation. + +** New mode 'json-ts-mode'. +A major mode based on the tree-sitter library for editing programs +in the JSON language. It includes support for font-locking, +indentation, Imenu, which-func, and navigation. + +** New mode 'csharp-ts-mode'. +A major mode based on the tree-sitter library for editing programs +in the C# language. It includes support for font-locking, +indentation, Imenu, which-func, and navigation. + +** New mode 'csharp-mode'. +A major mode based on CC Mode for editing programs in the C# language. + + * Incompatible Lisp Changes in Emacs 29.1 +++ diff --git a/lib-src/etags.c b/lib-src/etags.c index ed8a2184649..3107c7b380e 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -774,7 +774,7 @@ static const char Rust_help [] = /* Can't do the `SCM' or `scm' prefix with a version number. */ static const char *Scheme_suffixes [] = - { "oak", "sch", "scheme", "SCM", "scm", "SM", "sm", "ss", "t", NULL }; + { "oak", "rkt", "sch", "scheme", "SCM", "scm", "SM", "sm", "ss", "t", NULL }; static const char Scheme_help [] = "In Scheme code, tags include anything defined with 'def' or with a\n\ construct whose name starts with 'def'. They also include\n\ diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c index ee21abc7230..e0d5f0c6b8e 100644 --- a/lib-src/ntlib.c +++ b/lib-src/ntlib.c @@ -138,15 +138,6 @@ getlogin (void) return NULL; } -char * -cuserid (char * s) -{ - char * name = getlogin (); - if (s) - return strcpy (s, name ? name : ""); - return name; -} - unsigned getuid (void) { diff --git a/lib-src/ntlib.h b/lib-src/ntlib.h index 2cd2b1d1079..ff85beeaa6a 100644 --- a/lib-src/ntlib.h +++ b/lib-src/ntlib.h @@ -33,7 +33,6 @@ unsigned sleep (unsigned seconds); char *getwd (char *dir); int getppid (void); char * getlogin (void); -char * cuserid (char * s); unsigned getegid (void); unsigned getgid (void); int setuid (unsigned uid); diff --git a/lib/canonicalize-lgpl.c b/lib/canonicalize-lgpl.c index 8c3d7f7cf80..870a663505d 100644 --- a/lib/canonicalize-lgpl.c +++ b/lib/canonicalize-lgpl.c @@ -47,6 +47,7 @@ #else # define __canonicalize_file_name canonicalize_file_name # define __realpath realpath +# define __strdup strdup # include "pathmax.h" # define __faccessat faccessat # if defined _WIN32 && !defined __CYGWIN__ @@ -179,27 +180,16 @@ get_path_max (void) return path_max < 0 ? 1024 : path_max <= IDX_MAX ? path_max : IDX_MAX; } -/* Act like __realpath (see below), with an additional argument - rname_buf that can be used as temporary storage. - - If GCC_LINT is defined, do not inline this function with GCC 10.1 - and later, to avoid creating a pointer to the stack that GCC - -Wreturn-local-addr incorrectly complains about. See: - https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93644 - Although the noinline attribute can hurt performance a bit, no better way - to pacify GCC is known; even an explicit #pragma does not pacify GCC. - When the GCC bug is fixed this workaround should be limited to the - broken GCC versions. */ -# if __GNUC_PREREQ (10, 1) -# if defined GCC_LINT || defined lint -__attribute__ ((__noinline__)) -# elif __OPTIMIZE__ && !__NO_INLINE__ -# define GCC_BOGUS_WRETURN_LOCAL_ADDR -# endif -# endif +/* Scratch buffers used by realpath_stk and managed by __realpath. */ +struct realpath_bufs +{ + struct scratch_buffer rname; + struct scratch_buffer extra; + struct scratch_buffer link; +}; + static char * -realpath_stk (const char *name, char *resolved, - struct scratch_buffer *rname_buf) +realpath_stk (const char *name, char *resolved, struct realpath_bufs *bufs) { char *dest; char const *start; @@ -224,12 +214,7 @@ realpath_stk (const char *name, char *resolved, return NULL; } - struct scratch_buffer extra_buffer, link_buffer; - scratch_buffer_init (&extra_buffer); - scratch_buffer_init (&link_buffer); - scratch_buffer_init (rname_buf); - char *rname_on_stack = rname_buf->data; - char *rname = rname_on_stack; + char *rname = bufs->rname.data; bool end_in_extra_buffer = false; bool failed = true; @@ -239,16 +224,16 @@ realpath_stk (const char *name, char *resolved, if (!IS_ABSOLUTE_FILE_NAME (name)) { - while (!__getcwd (rname, rname_buf->length)) + while (!__getcwd (bufs->rname.data, bufs->rname.length)) { if (errno != ERANGE) { dest = rname; goto error; } - if (!scratch_buffer_grow (rname_buf)) - goto error_nomem; - rname = rname_buf->data; + if (!scratch_buffer_grow (&bufs->rname)) + return NULL; + rname = bufs->rname.data; } dest = __rawmemchr (rname, '\0'); start = name; @@ -302,13 +287,13 @@ realpath_stk (const char *name, char *resolved, if (!ISSLASH (dest[-1])) *dest++ = '/'; - while (rname + rname_buf->length - dest + while (rname + bufs->rname.length - dest < startlen + sizeof dir_suffix) { idx_t dest_offset = dest - rname; - if (!scratch_buffer_grow_preserve (rname_buf)) - goto error_nomem; - rname = rname_buf->data; + if (!scratch_buffer_grow_preserve (&bufs->rname)) + return NULL; + rname = bufs->rname.data; dest = rname + dest_offset; } @@ -319,13 +304,13 @@ realpath_stk (const char *name, char *resolved, ssize_t n; while (true) { - buf = link_buffer.data; - idx_t bufsize = link_buffer.length; + buf = bufs->link.data; + idx_t bufsize = bufs->link.length; n = __readlink (rname, buf, bufsize - 1); if (n < bufsize - 1) break; - if (!scratch_buffer_grow (&link_buffer)) - goto error_nomem; + if (!scratch_buffer_grow (&bufs->link)) + return NULL; } if (0 <= n) { @@ -337,7 +322,7 @@ realpath_stk (const char *name, char *resolved, buf[n] = '\0'; - char *extra_buf = extra_buffer.data; + char *extra_buf = bufs->extra.data; idx_t end_idx IF_LINT (= 0); if (end_in_extra_buffer) end_idx = end - extra_buf; @@ -345,13 +330,13 @@ realpath_stk (const char *name, char *resolved, if (INT_ADD_OVERFLOW (len, n)) { __set_errno (ENOMEM); - goto error_nomem; + return NULL; } - while (extra_buffer.length <= len + n) + while (bufs->extra.length <= len + n) { - if (!scratch_buffer_grow_preserve (&extra_buffer)) - goto error_nomem; - extra_buf = extra_buffer.data; + if (!scratch_buffer_grow_preserve (&bufs->extra)) + return NULL; + extra_buf = bufs->extra.data; } if (end_in_extra_buffer) end = extra_buf + end_idx; @@ -403,20 +388,30 @@ realpath_stk (const char *name, char *resolved, error: *dest++ = '\0'; - if (resolved != NULL && dest - rname <= get_path_max ()) - rname = strcpy (resolved, rname); - -error_nomem: - scratch_buffer_free (&extra_buffer); - scratch_buffer_free (&link_buffer); - - if (failed || rname == resolved) + if (resolved != NULL) + { + /* Copy the full result on success or partial result if failure was due + to the path not existing or not being accessible. */ + if ((!failed || errno == ENOENT || errno == EACCES) + && dest - rname <= get_path_max ()) + { + strcpy (resolved, rname); + if (failed) + return NULL; + else + return resolved; + } + if (!failed) + __set_errno (ENAMETOOLONG); + return NULL; + } + else { - scratch_buffer_free (rname_buf); - return failed ? NULL : resolved; + if (failed) + return NULL; + else + return __strdup (bufs->rname.data); } - - return scratch_buffer_dupfree (rname_buf, dest - rname); } /* Return the canonical absolute name of file NAME. A canonical name @@ -433,12 +428,15 @@ error_nomem: char * __realpath (const char *name, char *resolved) { - #ifdef GCC_BOGUS_WRETURN_LOCAL_ADDR - #warning "GCC might issue a bogus -Wreturn-local-addr warning here." - #warning "See <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93644>." - #endif - struct scratch_buffer rname_buffer; - return realpath_stk (name, resolved, &rname_buffer); + struct realpath_bufs bufs; + scratch_buffer_init (&bufs.rname); + scratch_buffer_init (&bufs.extra); + scratch_buffer_init (&bufs.link); + char *result = realpath_stk (name, resolved, &bufs); + scratch_buffer_free (&bufs.link); + scratch_buffer_free (&bufs.extra); + scratch_buffer_free (&bufs.rname); + return result; } libc_hidden_def (__realpath) versioned_symbol (libc, __realpath, realpath, GLIBC_2_3); diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 04644bdabe3..9af8fd0c579 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -222,6 +222,8 @@ DEFS = @DEFS@ DESLIB = @DESLIB@ DOCMISC_W32 = @DOCMISC_W32@ DUMPING = @DUMPING@ +DYNAMIC_LIB_SECONDARY_SUFFIX = @DYNAMIC_LIB_SECONDARY_SUFFIX@ +DYNAMIC_LIB_SUFFIX = @DYNAMIC_LIB_SUFFIX@ DYNLIB_OBJ = @DYNLIB_OBJ@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ @@ -953,6 +955,7 @@ MKDIR_P = @MKDIR_P@ MODULES_OBJ = @MODULES_OBJ@ MODULES_SECONDARY_SUFFIX = @MODULES_SECONDARY_SUFFIX@ MODULES_SUFFIX = @MODULES_SUFFIX@ +NATIVE_COMPILATION_AOT = @NATIVE_COMPILATION_AOT@ NEXT_ASSERT_H = @NEXT_ASSERT_H@ NEXT_AS_FIRST_DIRECTIVE_ASSERT_H = @NEXT_AS_FIRST_DIRECTIVE_ASSERT_H@ NEXT_AS_FIRST_DIRECTIVE_DIRENT_H = @NEXT_AS_FIRST_DIRECTIVE_DIRENT_H@ @@ -1218,6 +1221,8 @@ TERMCAP_OBJ = @TERMCAP_OBJ@ TIME_H_DEFINES_STRUCT_TIMESPEC = @TIME_H_DEFINES_STRUCT_TIMESPEC@ TIME_H_DEFINES_TIME_UTC = @TIME_H_DEFINES_TIME_UTC@ TOOLKIT_LIBW = @TOOLKIT_LIBW@ +TREE_SITTER_CFLAGS = @TREE_SITTER_CFLAGS@ +TREE_SITTER_LIBS = @TREE_SITTER_LIBS@ UINT32_MAX_LT_UINTMAX_MAX = @UINT32_MAX_LT_UINTMAX_MAX@ UINT64_MAX_EQ_ULONG_MAX = @UINT64_MAX_EQ_ULONG_MAX@ UNDEFINE_STRTOK_R = @UNDEFINE_STRTOK_R@ @@ -1309,23 +1314,22 @@ gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31_CONDITION = @gl_GNULIB_ENABLE gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_CONDITION = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_CONDITION@ gl_GNULIB_ENABLED_61bcaca76b3e6f9ae55d57a1c3193bc4_CONDITION = @gl_GNULIB_ENABLED_61bcaca76b3e6f9ae55d57a1c3193bc4_CONDITION@ gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_CONDITION = @gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_CONDITION@ +gl_GNULIB_ENABLED_8444034ea779b88768865bb60b4fb8c9_CONDITION = @gl_GNULIB_ENABLED_8444034ea779b88768865bb60b4fb8c9_CONDITION@ gl_GNULIB_ENABLED_925677f0343de64b89a9f0c790b4104c_CONDITION = @gl_GNULIB_ENABLED_925677f0343de64b89a9f0c790b4104c_CONDITION@ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_CONDITION = @gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_CONDITION@ gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_CONDITION = @gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_CONDITION@ gl_GNULIB_ENABLED_cloexec_CONDITION = @gl_GNULIB_ENABLED_cloexec_CONDITION@ gl_GNULIB_ENABLED_d3b2383720ee0e541357aa2aac598e2b_CONDITION = @gl_GNULIB_ENABLED_d3b2383720ee0e541357aa2aac598e2b_CONDITION@ gl_GNULIB_ENABLED_dirfd_CONDITION = @gl_GNULIB_ENABLED_dirfd_CONDITION@ -gl_GNULIB_ENABLED_dynarray_CONDITION = @gl_GNULIB_ENABLED_dynarray_CONDITION@ gl_GNULIB_ENABLED_e80bf6f757095d2e5fc94dafb8f8fc8b_CONDITION = @gl_GNULIB_ENABLED_e80bf6f757095d2e5fc94dafb8f8fc8b_CONDITION@ gl_GNULIB_ENABLED_ef455225c00f5049c808c2eda3e76866_CONDITION = @gl_GNULIB_ENABLED_ef455225c00f5049c808c2eda3e76866_CONDITION@ gl_GNULIB_ENABLED_euidaccess_CONDITION = @gl_GNULIB_ENABLED_euidaccess_CONDITION@ +gl_GNULIB_ENABLED_fd38c7e463b54744b77b98aeafb4fa7c_CONDITION = @gl_GNULIB_ENABLED_fd38c7e463b54744b77b98aeafb4fa7c_CONDITION@ gl_GNULIB_ENABLED_getdtablesize_CONDITION = @gl_GNULIB_ENABLED_getdtablesize_CONDITION@ gl_GNULIB_ENABLED_getgroups_CONDITION = @gl_GNULIB_ENABLED_getgroups_CONDITION@ gl_GNULIB_ENABLED_lchmod_CONDITION = @gl_GNULIB_ENABLED_lchmod_CONDITION@ gl_GNULIB_ENABLED_open_CONDITION = @gl_GNULIB_ENABLED_open_CONDITION@ gl_GNULIB_ENABLED_rawmemchr_CONDITION = @gl_GNULIB_ENABLED_rawmemchr_CONDITION@ -gl_GNULIB_ENABLED_scratch_buffer_CONDITION = @gl_GNULIB_ENABLED_scratch_buffer_CONDITION@ -gl_GNULIB_ENABLED_stdckdint_CONDITION = @gl_GNULIB_ENABLED_stdckdint_CONDITION@ gl_GNULIB_ENABLED_strtoll_CONDITION = @gl_GNULIB_ENABLED_strtoll_CONDITION@ gl_GNULIB_ENABLED_utimens_CONDITION = @gl_GNULIB_ENABLED_utimens_CONDITION@ gl_LIBOBJDEPS = @gl_LIBOBJDEPS@ @@ -1770,43 +1774,6 @@ endif endif ## end gnulib module dup2 -## begin gnulib module dynarray -ifeq (,$(OMIT_GNULIB_MODULE_dynarray)) - -ifneq (,$(gl_GNULIB_ENABLED_dynarray_CONDITION)) -BUILT_SOURCES += malloc/dynarray.gl.h malloc/dynarray-skeleton.gl.h - -malloc/dynarray.gl.h: malloc/dynarray.h - $(AM_V_GEN)$(MKDIR_P) 'malloc' - $(AM_V_at)$(SED_HEADER_STDOUT) \ - -e '/libc_hidden_proto/d' \ - $(srcdir)/malloc/dynarray.h > $@-t - $(AM_V_at)mv $@-t $@ -MOSTLYCLEANFILES += malloc/dynarray.gl.h malloc/dynarray.gl.h-t - -malloc/dynarray-skeleton.gl.h: malloc/dynarray-skeleton.c - $(AM_V_GEN)$(MKDIR_P) 'malloc' - $(AM_V_at)$(SED_HEADER_STDOUT) \ - -e 's|<malloc/dynarray\.h>|<malloc/dynarray.gl.h>|g' \ - -e 's|__attribute_maybe_unused__|_GL_ATTRIBUTE_MAYBE_UNUSED|g' \ - -e 's|__attribute_nonnull__|_GL_ATTRIBUTE_NONNULL|g' \ - -e 's|__attribute_warn_unused_result__|_GL_ATTRIBUTE_NODISCARD|g' \ - -e 's|__glibc_likely|_GL_LIKELY|g' \ - -e 's|__glibc_unlikely|_GL_UNLIKELY|g' \ - $(srcdir)/malloc/dynarray-skeleton.c > $@-t - $(AM_V_at)mv $@-t $@ -MOSTLYCLEANFILES += malloc/dynarray-skeleton.gl.h malloc/dynarray-skeleton.gl.h-t - -libgnu_a_SOURCES += malloc/dynarray_at_failure.c malloc/dynarray_emplace_enlarge.c malloc/dynarray_finalize.c malloc/dynarray_resize.c malloc/dynarray_resize_clear.c - -endif -EXTRA_DIST += dynarray.h malloc/dynarray-skeleton.c malloc/dynarray.h - -EXTRA_libgnu_a_SOURCES += malloc/dynarray-skeleton.c - -endif -## end gnulib module dynarray - ## begin gnulib module eloop-threshold ifeq (,$(OMIT_GNULIB_MODULE_eloop-threshold)) @@ -2251,6 +2218,68 @@ EXTRA_DIST += $(top_srcdir)/build-aux/gitlog-to-changelog endif ## end gnulib module gitlog-to-changelog +## begin gnulib module glibc-internal/dynarray +ifeq (,$(OMIT_GNULIB_MODULE_glibc-internal/dynarray)) + +ifneq (,$(gl_GNULIB_ENABLED_fd38c7e463b54744b77b98aeafb4fa7c_CONDITION)) +BUILT_SOURCES += malloc/dynarray.gl.h malloc/dynarray-skeleton.gl.h + +malloc/dynarray.gl.h: malloc/dynarray.h + $(AM_V_GEN)$(MKDIR_P) 'malloc' + $(AM_V_at)$(SED_HEADER_STDOUT) \ + -e '/libc_hidden_proto/d' \ + $(srcdir)/malloc/dynarray.h > $@-t + $(AM_V_at)mv $@-t $@ +MOSTLYCLEANFILES += malloc/dynarray.gl.h malloc/dynarray.gl.h-t + +malloc/dynarray-skeleton.gl.h: malloc/dynarray-skeleton.c + $(AM_V_GEN)$(MKDIR_P) 'malloc' + $(AM_V_at)$(SED_HEADER_STDOUT) \ + -e 's|<malloc/dynarray\.h>|<malloc/dynarray.gl.h>|g' \ + -e 's|__attribute_maybe_unused__|_GL_ATTRIBUTE_MAYBE_UNUSED|g' \ + -e 's|__attribute_nonnull__|_GL_ATTRIBUTE_NONNULL|g' \ + -e 's|__attribute_warn_unused_result__|_GL_ATTRIBUTE_NODISCARD|g' \ + -e 's|__glibc_likely|_GL_LIKELY|g' \ + -e 's|__glibc_unlikely|_GL_UNLIKELY|g' \ + $(srcdir)/malloc/dynarray-skeleton.c > $@-t + $(AM_V_at)mv $@-t $@ +MOSTLYCLEANFILES += malloc/dynarray-skeleton.gl.h malloc/dynarray-skeleton.gl.h-t + +libgnu_a_SOURCES += malloc/dynarray_at_failure.c malloc/dynarray_emplace_enlarge.c malloc/dynarray_finalize.c malloc/dynarray_resize.c malloc/dynarray_resize_clear.c + +endif +EXTRA_DIST += dynarray.h malloc/dynarray-skeleton.c malloc/dynarray.h + +EXTRA_libgnu_a_SOURCES += malloc/dynarray-skeleton.c + +endif +## end gnulib module glibc-internal/dynarray + +## begin gnulib module glibc-internal/scratch_buffer +ifeq (,$(OMIT_GNULIB_MODULE_glibc-internal/scratch_buffer)) + +ifneq (,$(gl_GNULIB_ENABLED_8444034ea779b88768865bb60b4fb8c9_CONDITION)) +BUILT_SOURCES += malloc/scratch_buffer.gl.h + +malloc/scratch_buffer.gl.h: malloc/scratch_buffer.h + $(AM_V_GEN)$(MKDIR_P) 'malloc' + $(AM_V_at)$(SED_HEADER_STDOUT) \ + -e 's|__always_inline|inline _GL_ATTRIBUTE_ALWAYS_INLINE|g' \ + -e 's|__glibc_likely|_GL_LIKELY|g' \ + -e 's|__glibc_unlikely|_GL_UNLIKELY|g' \ + -e '/libc_hidden_proto/d' \ + $(srcdir)/malloc/scratch_buffer.h > $@-t + $(AM_V_at)mv $@-t $@ +MOSTLYCLEANFILES += malloc/scratch_buffer.gl.h malloc/scratch_buffer.gl.h-t + +libgnu_a_SOURCES += malloc/scratch_buffer_grow.c malloc/scratch_buffer_grow_preserve.c malloc/scratch_buffer_set_array_size.c + +endif +EXTRA_DIST += malloc/scratch_buffer.h scratch_buffer.h + +endif +## end gnulib module glibc-internal/scratch_buffer + ## begin gnulib module group-member ifeq (,$(OMIT_GNULIB_MODULE_group-member)) @@ -2736,31 +2765,6 @@ EXTRA_DIST += root-uid.h endif ## end gnulib module root-uid -## begin gnulib module scratch_buffer -ifeq (,$(OMIT_GNULIB_MODULE_scratch_buffer)) - -ifneq (,$(gl_GNULIB_ENABLED_scratch_buffer_CONDITION)) -BUILT_SOURCES += malloc/scratch_buffer.gl.h - -malloc/scratch_buffer.gl.h: malloc/scratch_buffer.h - $(AM_V_GEN)$(MKDIR_P) 'malloc' - $(AM_V_at)$(SED_HEADER_STDOUT) \ - -e 's|__always_inline|inline _GL_ATTRIBUTE_ALWAYS_INLINE|g' \ - -e 's|__glibc_likely|_GL_LIKELY|g' \ - -e 's|__glibc_unlikely|_GL_UNLIKELY|g' \ - -e '/libc_hidden_proto/d' \ - $(srcdir)/malloc/scratch_buffer.h > $@-t - $(AM_V_at)mv $@-t $@ -MOSTLYCLEANFILES += malloc/scratch_buffer.gl.h malloc/scratch_buffer.gl.h-t - -libgnu_a_SOURCES += malloc/scratch_buffer_dupfree.c malloc/scratch_buffer_grow.c malloc/scratch_buffer_grow_preserve.c malloc/scratch_buffer_set_array_size.c - -endif -EXTRA_DIST += malloc/scratch_buffer.h scratch_buffer.h - -endif -## end gnulib module scratch_buffer - ## begin gnulib module sig2str ifeq (,$(OMIT_GNULIB_MODULE_sig2str)) @@ -2916,7 +2920,6 @@ endif ## begin gnulib module stdckdint ifeq (,$(OMIT_GNULIB_MODULE_stdckdint)) -ifneq (,$(gl_GNULIB_ENABLED_stdckdint_CONDITION)) BUILT_SOURCES += $(STDCKDINT_H) # We need the following in order to create <stdckdint.h> when the system @@ -2932,7 +2935,6 @@ stdckdint.h: $(top_builddir)/config.status endif MOSTLYCLEANFILES += stdckdint.h stdckdint.h-t -endif EXTRA_DIST += intprops-internal.h stdckdint.in.h endif diff --git a/lib/malloc/scratch_buffer.h b/lib/malloc/scratch_buffer.h index e4c5c8a85da..a9bdcadec21 100644 --- a/lib/malloc/scratch_buffer.h +++ b/lib/malloc/scratch_buffer.h @@ -132,20 +132,4 @@ scratch_buffer_set_array_size (struct scratch_buffer *buffer, (buffer, nelem, size)); } -/* Return a copy of *BUFFER's first SIZE bytes as a heap-allocated block, - deallocating *BUFFER if it was heap-allocated. SIZE must be at - most *BUFFER's size. Return NULL (setting errno) on memory - exhaustion. */ -void *__libc_scratch_buffer_dupfree (struct scratch_buffer *buffer, - size_t size); -libc_hidden_proto (__libc_scratch_buffer_dupfree) - -/* Alias for __libc_scratch_dupfree. */ -static __always_inline void * -scratch_buffer_dupfree (struct scratch_buffer *buffer, size_t size) -{ - void *r = __libc_scratch_buffer_dupfree (buffer, size); - return __glibc_likely (r != NULL) ? r : NULL; -} - #endif /* _SCRATCH_BUFFER_H */ diff --git a/lib/scratch_buffer.h b/lib/scratch_buffer.h index f4fe5e8d344..c0aa21630f5 100644 --- a/lib/scratch_buffer.h +++ b/lib/scratch_buffer.h @@ -98,20 +98,10 @@ extern bool scratch_buffer_set_array_size (struct scratch_buffer *buffer, size_t nelem, size_t size); #endif -/* Return a copy of *BUFFER's first SIZE bytes as a heap-allocated block, - deallocating *BUFFER if it was heap-allocated. SIZE must be at - most *BUFFER's size. Return NULL (setting errno) on memory - exhaustion. */ -#if 0 -extern void *scratch_buffer_dupfree (struct scratch_buffer *buffer, - size_t size); -#endif - /* The implementation is imported from glibc. */ /* Avoid possible conflicts with symbols exported by the GNU libc. */ -#define __libc_scratch_buffer_dupfree gl_scratch_buffer_dupfree #define __libc_scratch_buffer_grow gl_scratch_buffer_grow #define __libc_scratch_buffer_grow_preserve gl_scratch_buffer_grow_preserve #define __libc_scratch_buffer_set_array_size gl_scratch_buffer_set_array_size diff --git a/lib/stat-time.h b/lib/stat-time.h index 6b0088e3285..b661196ea58 100644 --- a/lib/stat-time.h +++ b/lib/stat-time.h @@ -20,9 +20,8 @@ #ifndef STAT_TIME_H #define STAT_TIME_H 1 -#include "intprops.h" - #include <errno.h> +#include <stdckdint.h> #include <stddef.h> #include <sys/stat.h> #include <time.h> @@ -232,7 +231,7 @@ stat_time_normalize (int result, _GL_UNUSED struct stat *st) /* Overflow is possible, as Solaris 11 stat can yield tv_sec == TYPE_MINIMUM (time_t) && tv_nsec == -1000000000. INT_ADD_WRAPV is OK, since time_t is signed on Solaris. */ - if (INT_ADD_WRAPV (q, ts->tv_sec, &ts->tv_sec)) + if (ckd_add (&ts->tv_sec, q, ts->tv_sec)) { errno = EOVERFLOW; return -1; diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9 index 4cb10d2d55e..469d0970f82 100644 --- a/lisp/ChangeLog.9 +++ b/lisp/ChangeLog.9 @@ -1888,7 +1888,7 @@ (uniquify-item-greaterp): Substitutes uniquify-item-lessp. This is equivalent to what the old code did. (uniquify-rationalize-a-list): Never recompute the proposed - name. Sort the conflicting sublist before rationalising it: this + name. Sort the conflicting sublist before rationalizing it: this is equivalent to what the old code did, but one directory element at a time, and only when necessary. (uniquify-rationalize-conflicting-sublist): Recompute here the diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index dc274843e10..74d38084480 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -55,12 +55,13 @@ :type 'string :version "27.1") -(defcustom auth-source-pass-extra-query-keywords t +(defcustom auth-source-pass-extra-query-keywords nil "Whether to consider additional keywords when performing a query. Specifically, when the value is t, recognize the `:max' and `:require' keywords and accept lists of query parameters for -certain keywords, such as `:host' and `:user'. Also, wrap all -returned secrets in a function and forgo any further results +certain keywords, such as `:host' and `:user'. Beyond that, wrap +all returned secrets in a function and don't bother considering +subdomains when matching hosts. Also, forgo any further results filtering unless given an applicable `:require' argument. When this option is nil, do none of that, and enact the narrowing behavior described toward the bottom of the Info node `(auth) The @@ -110,7 +111,7 @@ HOSTS can be a string or a list of strings." (defun auth-source-pass--match-regexp (s) (rx-to-string ; autoloaded `(: (or bot "/") - (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") + (or (: (? (group-n 20 (+ (not (in ?\ ?/ ,s)))) "@") (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index aa5f70edf23..588fe599a46 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -24,8 +24,8 @@ ;;; Commentary: ;; The Buffer Menu is used to view, edit, delete, or change attributes -;; of buffers. The entry points are C-x C-b (`list-buffers') and -;; M-x buffer-menu. +;; of buffers. The entry points are `C-x C-b' (`list-buffers') and +;; `M-x buffer-menu'. ;;; Code: @@ -135,6 +135,7 @@ then the buffer will be displayed in the buffer list.") "%" #'Buffer-menu-toggle-read-only "b" #'Buffer-menu-bury "V" #'Buffer-menu-view + "O" #'Buffer-menu-view-other-window "T" #'Buffer-menu-toggle-files-only "M-s a C-s" #'Buffer-menu-isearch-buffers "M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp @@ -208,26 +209,25 @@ See `buffer-menu' for a description of its contents. In Buffer Menu mode, the following commands are defined: \\<Buffer-menu-mode-map> \\[quit-window] Remove the Buffer Menu from the display. -\\[Buffer-menu-this-window] Select current line's buffer in place of the buffer menu. +\\[Buffer-menu-this-window] Select current line's buffer in place of the buffer menu. \\[Buffer-menu-other-window] Select that buffer in another window, so the Buffer Menu remains visible in its window. -\\[Buffer-menu-view] Select current line's buffer, in View mode. -\\[Buffer-menu-view-other-window] Select that buffer in - another window, in `view-mode'. +\\[Buffer-menu-view] Select current line's buffer, in `view-mode'. +\\[Buffer-menu-view-other-window] Select that buffer in another window, in `view-mode'. \\[Buffer-menu-switch-other-window] Make another window display that buffer. \\[Buffer-menu-mark] Mark current line's buffer to be displayed. \\[Buffer-menu-select] Select current line's buffer. - Also show buffers marked with m, in other windows. + Also show buffers marked with \"m\", in other windows. \\[Buffer-menu-1-window] Select that buffer in full-frame window. \\[Buffer-menu-2-window] Select that buffer in one window, together with the buffer selected before this one in another window. \\[Buffer-menu-isearch-buffers] Incremental search in the marked buffers. \\[Buffer-menu-isearch-buffers-regexp] Isearch for regexp in the marked buffers. -\\[Buffer-menu-multi-occur] Show lines matching regexp in the marked buffers. +\\[Buffer-menu-multi-occur] Show lines matching regexp in the marked buffers. \\[Buffer-menu-visit-tags-table] `visit-tags-table' this buffer. \\[Buffer-menu-not-modified] Clear modified-flag on that buffer. \\[Buffer-menu-save] Mark that buffer to be saved, and move down. -\\[Buffer-menu-delete] Mark that buffer to be deleted, and move down. +\\[Buffer-menu-delete] Mark that buffer to be deleted, and move down. \\[Buffer-menu-delete-backwards] Mark that buffer to be deleted, and move up. \\[Buffer-menu-execute] Delete or save marked buffers. \\[Buffer-menu-unmark] Remove all marks from current line. diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index c8405c7d1a0..42156b94606 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -317,7 +317,9 @@ If you change this, be sure to set `math-units-table' to nil to ensure that the combined units table will be rebuilt.") (defvar math-unit-prefixes - '( ( ?Y (^ 10 24) "Yotta" ) + '( ( ?Q (^ 10 30) "quetta" ) + ( ?R (^ 10 27) "ronna" ) + ( ?Y (^ 10 24) "Yotta" ) ( ?Z (^ 10 21) "Zetta" ) ( ?E (^ 10 18) "Exa" ) ( ?P (^ 10 15) "Peta" ) @@ -340,7 +342,10 @@ that the combined units table will be rebuilt.") ( ?f (^ 10 -15) "Femto" ) ( ?a (^ 10 -18) "Atto" ) ( ?z (^ 10 -21) "zepto" ) - ( ?y (^ 10 -24) "yocto" ))) + ( ?y (^ 10 -24) "yocto" ) + ( ?r (^ 10 -27) "ronto" ) + ( ?q (^ 10 -30) "quecto" ) + )) (defvar math-standard-units-systems '( ( base nil ) diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index cf542939897..55757400406 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -1641,9 +1641,11 @@ enumeration, given as a Lisp time value -- used for test purposes." entry-main) ;; regular sexp entry (icalendar--dmsg "diary-sexp %s" entry-main) - (let ((p1 (substring entry-main (match-beginning 1) (match-end 1))) - (p2 (substring entry-main (match-beginning 2) (match-end 2))) - (now (or start (current-time)))) + (let* ((entry-main (substring entry-main 2)) + (res (read-from-string entry-main)) + (p1 (prin1-to-string (car res))) + (p2 (substring entry-main (cdr res))) + (now (or start (current-time)))) (delete nil (mapcar (lambda (offset) diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 0260ad4a50e..69ed2087a78 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -64,13 +64,17 @@ Do not call this mode function yourself. It is meant for internal use." variable-pitch escape-glyph homoglyph minibuffer-prompt highlight region shadow secondary-selection trailing-whitespace - font-lock-builtin-face font-lock-comment-delimiter-face - font-lock-comment-face font-lock-constant-face - font-lock-doc-face font-lock-doc-markup-face font-lock-function-name-face + font-lock-bracket-face font-lock-builtin-face + font-lock-comment-delimiter-face font-lock-comment-face + font-lock-constant-face font-lock-delimiter-face + font-lock-doc-face font-lock-doc-markup-face + font-lock-escape-face font-lock-function-name-face font-lock-keyword-face font-lock-negation-char-face - font-lock-preprocessor-face font-lock-regexp-grouping-backslash - font-lock-regexp-grouping-construct font-lock-string-face - font-lock-type-face font-lock-variable-name-face + font-lock-number-face font-lock-misc-punctuation-face + font-lock-operator-face font-lock-preprocessor-face + font-lock-property-face font-lock-punctuation-face + font-lock-regexp-grouping-backslash font-lock-regexp-grouping-construct + font-lock-string-face font-lock-type-face font-lock-variable-name-face font-lock-warning-face button link link-visited fringe header-line tooltip mode-line mode-line-buffer-id mode-line-emphasis mode-line-highlight mode-line-inactive diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 94f9654b239..dbe20f92028 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -78,6 +78,9 @@ (font-spec atom) (font-entity atom) (font-object atom) (vector array sequence atom) (user-ptr atom) + (tree-sitter-parser atom) + (tree-sitter-node atom) + (tree-sitter-compiled-query atom) ;; Plus, really hand made: (null symbol list sequence atom)) "Alist of supertypes. diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 41e3a197af4..2a45c1ab1cc 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -390,10 +390,13 @@ ITEM defines an item as in `easy-menu-define'." (let ((key (easy-menu-intern name))) (cons key (and (not remove) - (cons 'menu-item - (cons label - (and name - (cons command prop))))))))) + (if (and (stringp label) + (seq-every-p (lambda (c) (char-equal c ?-)) label)) + menu-bar-separator + (cons 'menu-item + (cons label + (and name + (cons command prop)))))))))) (defun easy-menu-define-key (menu key item &optional before) "Add binding in MENU for KEY => ITEM. Similar to `define-key-after'. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index c25ade22d6f..67cbe62538c 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -673,8 +673,11 @@ Bound dynamically. This is a list of (PREFIX . MESSAGE) pairs.") To be used within ERT tests. MESSAGE-FORM should evaluate to a string that will be displayed together with the test result if -the test fails. PREFIX-FORM should evaluate to a string as well -and is displayed in front of the value of MESSAGE-FORM." +the test fails. MESSAGE-FORM can also evaluate to a function; in +this case, it will be called when displaying the info. + +PREFIX-FORM should evaluate to a string as well and is displayed +in front of the value of MESSAGE-FORM." (declare (debug ((form &rest [sexp form]) body)) (indent 1)) `(let ((ert--infos (cons (cons ,prefix-form ,message-form) ert--infos))) @@ -1352,6 +1355,8 @@ RESULT must be an `ert-test-result-with-condition'." (end nil)) (unwind-protect (progn + (when (functionp message) + (setq message (funcall message))) (insert message "\n") (setq end (point-marker)) (goto-char begin) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index acae1a0b0a9..c8d05a084bb 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -375,7 +375,10 @@ does not move to the beginning of the line when `defun-prompt-regexp' is non-nil. If variable `beginning-of-defun-function' is non-nil, its value -is called as a function to find the defun's beginning." +is called as a function to find the defun's beginning. + +Return non-nil if this function successfully found the beginning +of a defun, nil if it failed to find one." (interactive "^p") ; change this to "P", maybe, if we ever come to pass ARG ; to beginning-of-defun-function. (unless arg (setq arg 1)) @@ -543,6 +546,7 @@ report errors as appropriate for this kind of usage." (push-mark)) (if (or (null arg) (= arg 0)) (setq arg 1)) (let ((pos (point)) + (success nil) (beg (progn (when end-of-defun-moves-to-eol (end-of-line 1)) (beginning-of-defun-raw 1) (point))) @@ -567,9 +571,12 @@ report errors as appropriate for this kind of usage." (setq arg (1- arg)) ;; We started from after the end of the previous function. (goto-char pos)) + ;; At this point, point either didn't move (because we started + ;; in between two defun's), or is at the end of a defun + ;; (because we started in the middle of a defun). (unless (zerop arg) - (beginning-of-defun-raw (- arg)) - (funcall end-of-defun-function))) + (when (setq success (beginning-of-defun-raw (- arg))) + (funcall end-of-defun-function)))) ((< arg 0) ;; Moving backward. (if (< (point) pos) @@ -579,16 +586,18 @@ report errors as appropriate for this kind of usage." ;; We started from inside a function. (goto-char beg)) (unless (zerop arg) - (beginning-of-defun-raw (- arg)) - (setq beg (point)) - (funcall end-of-defun-function)))) + (when (setq success (beginning-of-defun-raw (- arg))) + (setq beg (point)) + (funcall end-of-defun-function))))) (funcall skip) - (while (and (< arg 0) (>= (point) pos)) + (while (and (< arg 0) (>= (point) pos) success) ;; We intended to move backward, but this ended up not doing so: ;; Try harder! (goto-char beg) - (beginning-of-defun-raw (- arg)) - (if (>= (point) beg) + (setq success (beginning-of-defun-raw (- arg))) + ;; If we successfully moved pass point, or there is no further + ;; defun beginnings anymore, stop. + (if (or (>= (point) beg) (not success)) (setq arg 0) (setq beg (point)) (funcall end-of-defun-function) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index ecc5f7e47bd..2dd04174f54 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -108,21 +108,26 @@ scanning for autoloads and will be in the `load-path'." (let* ((name (file-relative-name file (file-name-directory outfile))) (names '()) (dir (file-name-directory outfile))) - ;; If `name' has directory components, only keep the - ;; last few that are really needed. - (while name - (setq name (directory-file-name name)) - (push (file-name-nondirectory name) names) - (setq name (file-name-directory name))) - (while (not name) - (cond - ((null (cdr names)) (setq name (car names))) - ((file-exists-p (expand-file-name "subdirs.el" dir)) - ;; FIXME: here we only check the existence of subdirs.el, - ;; without checking its content. This makes it generate wrong load - ;; names for cases like lisp/term which is not added to load-path. - (setq dir (expand-file-name (pop names) dir))) - (t (setq name (mapconcat #'identity names "/"))))) + ;; If `name' lives inside an ancestor directory of OUTFILE, only + ;; keep the last few leading directories that are really needed. + ;; (It will always live in an ancestor directory of OUTFILE on + ;; Posix systems, but on DOS/Windows it could not be, if FILE and + ;; OUTFILE are on different drives.) + (when (not (file-name-absolute-p name)) + (while name + (setq name (directory-file-name name)) + (push (file-name-nondirectory name) names) + (setq name (file-name-directory name))) + (while (not name) + (cond + ((null (cdr names)) (setq name (car names))) + ((file-exists-p (expand-file-name "subdirs.el" dir)) + ;; FIXME: here we only check the existence of subdirs.el, + ;; without checking its content. This makes it generate + ;; wrong load names for cases like lisp/term which is not + ;; added to load-path. + (setq dir (expand-file-name (pop names) dir))) + (t (setq name (mapconcat #'identity names "/")))))) (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name) (substring name 0 (match-beginning 0)) name))) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index a999596785b..deb0debab4d 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -334,7 +334,7 @@ asynchronously." (nconc (list 'define-package (symbol-name name) - (cons 'vc (package-vc--version pkg-desc)) + (package-vc--version pkg-desc) (package-desc-summary pkg-desc) (let ((requires (package-desc-reqs pkg-desc))) (list 'quote @@ -344,6 +344,7 @@ asynchronously." (list (car elt) (package-version-join (cadr elt)))) requires)))) + (list :kind 'vc) (package--alist-to-plist-args (package-desc-extras pkg-desc)))) "\n") @@ -522,7 +523,7 @@ checkout. This overrides the `:branch' attribute in PKG-SPEC." (pkg-dir (expand-file-name dirname package-user-dir))) (setf (package-desc-dir pkg-desc) pkg-dir) (when (file-exists-p pkg-dir) - (if (yes-or-no-p "Overwrite previous checkout?") + (if (yes-or-no-p (format "Overwrite previous checkout for package `%s'?" name)) (package--delete-directory pkg-dir) (error "There already exists a checkout for %s" name))) (package-vc--clone pkg-desc pkg-spec pkg-dir rev) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index d21d03192b4..2e6927f9004 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -484,9 +484,7 @@ synchronously." (if (eq 'quote (car requirements)) (nth 1 requirements) requirements))) - (kind (if (eq (car-safe version-string) 'vc) - 'vc - (plist-get rest-plist :kind))) + (kind (plist-get rest-plist :kind)) (archive (plist-get rest-plist :archive)) (extras (let (alist) (while rest-plist diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 10bd4bc6886..762cc8eb4f9 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -395,7 +395,7 @@ how many time this CODEGEN is called." (push (setq prev (list case)) seen)) ;; Put a counter in the cdr just so that not ;; all branches look identical (to avoid things - ;; like `macroexp--if' optimizing them too + ;; like `macroexp-if' optimizing them too ;; optimistically). (let ((ph (cons 'pcase--placeholder (setq phcounter (1+ phcounter))))) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 15fd6ac50f5..43c5faad638 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -205,7 +205,8 @@ ;;;; Variables and options (defvar-local erc-session-password nil - "The password used for the current session.") + "The password used for the current session. +This should be a string or a function returning a string.") (defvar erc-server-responses (make-hash-table :test #'equal) "Hash table mapping server responses to their handler hooks.") @@ -311,8 +312,13 @@ current IRC process is still alive.") (make-obsolete-variable 'erc-server-reconnecting "see `erc--server-reconnecting'" "29.1") -(defvar-local erc--server-reconnecting nil - "Non-nil when reconnecting.") +(defvar erc--server-reconnecting nil + "An alist of buffer-local vars and their values when reconnecting. +This is for the benefit of local modules and `erc-mode-hook' +members so they can access buffer-local data from the previous +session when reconnecting. Once `erc-reuse-buffers' is retired +and fully removed, modules can switch to leveraging the +`permanent-local' property instead.") (defvar-local erc-server-timed-out nil "Non-nil if the IRC server failed to respond to a ping.") @@ -638,6 +644,10 @@ The current buffer is given by BUFFER." (let ((p (plist-put parameters :nowait t))) (apply #'open-network-stream name buffer host service p))) +(cl-defmethod erc--register-connection () + "Perform opening IRC protocol exchange with server." + (erc-login)) + (defvar erc--server-connect-dumb-ipv6-regexp ;; Not for validation (gives false positives). (rx bot "[" (group (+ (any xdigit digit ":.")) (? "%" (+ alnum))) "]" eot)) @@ -664,7 +674,6 @@ TLS (see `erc-session-client-certificate' for more details)." (setq erc-server-process process) (setq erc-server-quitting nil) (setq erc-server-reconnecting nil - erc--server-reconnecting nil erc--server-reconnect-timer nil) (setq erc-server-timed-out nil) (setq erc-server-banned nil) @@ -693,7 +702,7 @@ TLS (see `erc-session-client-certificate' for more details)." ;; waiting for a non-blocking connect - keep the user informed (erc-display-message nil nil buffer "Opening connection..\n") (message "%s...done" msg) - (erc-login)) )) + (erc--register-connection)))) (defun erc-server-reconnect () "Reestablish the current IRC connection. @@ -706,11 +715,11 @@ Make sure you are in an ERC buffer when running this." (with-current-buffer buffer (erc-update-mode-line) (erc-set-active-buffer (current-buffer)) - (setq erc--server-reconnecting t) (setq erc-server-last-sent-time 0) (setq erc-server-lines-sent 0) (let ((erc-server-connect-function (or erc-session-connector - #'erc-open-network-stream))) + #'erc-open-network-stream)) + (erc--server-reconnecting (buffer-local-variables))) (erc-open erc-session-server erc-session-port erc-server-current-nick erc-session-user-full-name t erc-session-password nil nil nil erc-session-client-certificate @@ -824,8 +833,7 @@ When `erc-server-reconnect-attempts' is a number, increment (if (not reconnect-p) ;; terminate, do not reconnect (progn - (setq erc--server-reconnecting nil - erc--server-reconnect-timer nil) + (setq erc--server-reconnect-timer nil) (erc-display-message nil 'error (current-buffer) 'terminated ?e event) (set-buffer-modified-p nil)) @@ -894,7 +902,7 @@ Conditionally try to reconnect and take appropriate action." cproc (process-status cproc) event erc-server-quitting)) (if (string-match "^open" event) ;; newly opened connection (no wait) - (erc-login) + (erc--register-connection) ;; assume event is 'failed (erc-with-all-buffers-of-server cproc nil (setq erc-server-connected nil)) @@ -1619,7 +1627,7 @@ add things to `%s' instead." (cl-pushnew (erc-server-buffer) bufs) (erc-set-current-nick nn) ;; Rename session, possibly rename server buf and all targets - (when (erc-network) + (when erc-server-connected (erc-networks--id-reload erc-networks--id proc parsed)) (erc-update-mode-line) (setq erc-nick-change-attempt-count 0) @@ -1629,6 +1637,8 @@ add things to `%s' instead." 'NICK-you ?n nick ?N nn) (run-hook-with-args 'erc-nick-changed-functions nn nick)) (t + (when erc-server-connected + (erc-networks--id-reload erc-networks--id proc parsed)) (erc-handle-user-status-change 'nick (list nick login host) (list nn)) (erc-display-message parsed 'notice bufs 'NICK ?n nick ?u login ?h host ?N nn)))))) @@ -2255,6 +2265,8 @@ See `erc-display-server-message'." nil (define-erc-response-handler (433) "Login-time \"nick in use\"." nil + (when erc-server-connected + (erc-networks--id-reload erc-networks--id proc parsed)) (erc-nickname-in-use (cadr (erc-response.command-args parsed)) "already in use")) @@ -2323,6 +2335,15 @@ See `erc-display-server-message'." nil (erc-display-message parsed 'notice 'active 's671 ?n nick ?a securemsg))) +(define-erc-response-handler (900) + "Handle a \"RPL_LOGGEDIN\" server command. +Some servers don't consider this SASL-specific but rather just an +indication of a server-side state change from logged-out to +logged-in." nil + ;; Whenever ERC starts caring about user accounts, it should record + ;; the session as being logged here. + (erc-display-message parsed 'notice proc (erc-response.contents parsed))) + (define-erc-response-handler (431 445 446 451 462 463 464 481 483 484 485 491 501 502) ;; 431 - No nickname given diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 23a19337986..a4046ba9b39 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -88,6 +88,65 @@ (contents "" :type string) (tags '() :type list)) +;; TODO move goodies modules here after 29 is released. +(defconst erc--features-to-modules + '((erc-pcomplete completion pcomplete) + (erc-capab capab-identify) + (erc-join autojoin) + (erc-page page ctcp-page) + (erc-sound sound ctcp-sound) + (erc-stamp stamp timestamp) + (erc-services services nickserv)) + "Migration alist mapping a library feature to module names. +Keys need not be unique: a library may define more than one +module. Sometimes a module's downcased alias will be its +canonical name.") + +(defconst erc--modules-to-features + (let (pairs) + (pcase-dolist (`(,feature . ,names) erc--features-to-modules) + (dolist (name names) + (push (cons name feature) pairs))) + (nreverse pairs)) + "Migration alist mapping a module's name to its home library feature.") + +(defconst erc--module-name-migrations + (let (pairs) + (pcase-dolist (`(,_ ,canonical . ,rest) erc--features-to-modules) + (dolist (obsolete rest) + (push (cons obsolete canonical) pairs))) + pairs) + "Association list of obsolete module names to canonical names.") + +(defun erc--normalize-module-symbol (symbol) + "Return preferred SYMBOL for `erc-modules'." + (setq symbol (intern (downcase (symbol-name symbol)))) + (or (cdr (assq symbol erc--module-name-migrations)) symbol)) + +(defun erc--assemble-toggle (localp name ablsym mode val body) + (let ((arg (make-symbol "arg"))) + `(defun ,ablsym ,(if localp `(&optional ,arg) '()) + ,(concat + (if val "Enable" "Disable") + " ERC " (symbol-name name) " mode." + (when localp + "\nWith ARG, do so in all buffers for the current connection.")) + (interactive ,@(when localp '("p"))) + ,@(if localp + `((when (derived-mode-p 'erc-mode) + (if ,arg + (erc-with-all-buffers-of-server erc-server-process nil + (,ablsym)) + (setq ,mode ,val) + ,@body))) + `(,(if val + `(cl-pushnew ',(erc--normalize-module-symbol name) + erc-modules) + `(setq erc-modules (delq ',(erc--normalize-module-symbol name) + erc-modules))) + (setq ,mode ,val) + ,@body))))) + (defmacro define-erc-module (name alias doc enable-body disable-body &optional local-p) "Define a new minor mode using ERC conventions. @@ -103,6 +162,13 @@ This will define a minor mode called erc-NAME-mode, possibly an alias erc-ALIAS-mode, as well as the helper functions erc-NAME-enable, and erc-NAME-disable. +With LOCAL-P, these helpers take on an optional argument that, +when non-nil, causes them to act on all buffers of a connection. +This feature is mainly intended for interactive use and does not +carry over to their respective minor-mode toggles. Beware that +for global modules, these helpers and toggles all mutate +`erc-modules'. + Example: ;;;###autoload(autoload \\='erc-replace-mode \"erc-replace\") @@ -133,20 +199,8 @@ if ARG is omitted or nil. (if ,mode (,enable) (,disable))) - (defun ,enable () - ,(format "Enable ERC %S mode." - name) - (interactive) - (add-to-list 'erc-modules (quote ,name)) - (setq ,mode t) - ,@enable-body) - (defun ,disable () - ,(format "Disable ERC %S mode." - name) - (interactive) - (setq erc-modules (delq (quote ,name) erc-modules)) - (setq ,mode nil) - ,@disable-body) + ,(erc--assemble-toggle local-p name enable mode t enable-body) + ,(erc--assemble-toggle local-p name disable mode nil disable-body) ,(when (and alias (not (eq name alias))) `(defalias ',(intern diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index d23703394be..abbaafcd936 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -176,7 +176,7 @@ If START or END is negative, it counts from the end." ;; This hard codes `auth-source-pass-port-separator' to ":" (defun erc-compat--29-auth-source-pass--retrieve-parsed (seen e port-number-p) (when (string-match (rx (or bot "/") - (or (: (? (group-n 20 (+ (not (in " /@")))) "@") + (or (: (? (group-n 20 (+ (not (in " /:")))) "@") (group-n 10 (+ (not (in " /:@")))) (? ":" (group-n 30 (+ (not (in " /:")))))) (: (group-n 11 (+ (not (in " /:@")))) @@ -252,8 +252,18 @@ If START or END is negative, it counts from the end." ;; From `auth-source-pass-search' (cl-assert (and host (not (eq host t))) t "Invalid password-store search: %s %s") - (erc-compat--29-auth-source-pass--build-result-many - host user port require max)) + (let ((rv (erc-compat--29-auth-source-pass--build-result-many + host user port require max))) + (if (and (fboundp 'auth-source--obfuscate) + (fboundp 'auth-source--deobfuscate)) + (let (out) + (dolist (e rv out) + (when-let* ((s (plist-get e :secret)) + (v (auth-source--obfuscate s))) + (setf (plist-get e :secret) + (byte-compile (lambda () (auth-source--deobfuscate v))))) + (push e out))) + rv))) (defun erc-compat--29-auth-source-pass-backend-parse (entry) (when (eq entry 'password-store) @@ -273,6 +283,89 @@ If START or END is negative, it counts from the end." auth-source-backend-parser-functions)) +;;;; SASL + +(declare-function sasl-step-data "sasl" (step)) +(declare-function sasl-error "sasl" (datum)) +(declare-function sasl-client-property "sasl" (client property)) +(declare-function sasl-client-set-property "sasl" (client property value)) +(declare-function sasl-mechanism-name "sasl" (mechanism)) +(declare-function sasl-client-name "sasl" (client)) +(declare-function sasl-client-mechanism "sasl" (client)) +(declare-function sasl-read-passphrase "sasl" (prompt)) +(declare-function sasl-unique-id "sasl" nil) +(declare-function decode-hex-string "hex-util" (string)) +(declare-function rfc2104-hash "rfc2104" (hash block-length hash-length + key text)) +(declare-function sasl-scram--client-first-message-bare "sasl-scram-rfc" + (client)) +(declare-function cl-mapcar "cl-lib" (cl-func cl-x &rest cl-rest)) + +(defun erc-compat--29-sasl-scram-construct-gs2-header (client) + (let ((authzid (sasl-client-property client 'authenticator-name))) + (concat "n," (and authzid "a=") authzid ","))) + +(defun erc-compat--29-sasl-scram-client-first-message (client _step) + (let ((c-nonce (sasl-unique-id))) + (sasl-client-set-property client 'c-nonce c-nonce)) + (concat (erc-compat--29-sasl-scram-construct-gs2-header client) + (sasl-scram--client-first-message-bare client))) + +(defun erc-compat--29-sasl-scram--client-final-message + (hash-fun block-length hash-length client step) + (unless (string-match + "^r=\\([^,]+\\),s=\\([^,]+\\),i=\\([0-9]+\\)\\(?:$\\|,\\)" + (sasl-step-data step)) + (sasl-error "Unexpected server response")) + (let* ((hmac-fun + (lambda (text key) + (decode-hex-string + (rfc2104-hash hash-fun block-length hash-length key text)))) + (step-data (sasl-step-data step)) + (nonce (match-string 1 step-data)) + (salt-base64 (match-string 2 step-data)) + (iteration-count (string-to-number (match-string 3 step-data))) + (c-nonce (sasl-client-property client 'c-nonce)) + (cbind-input + (if (string-prefix-p c-nonce nonce) + (erc-compat--29-sasl-scram-construct-gs2-header client) ; *1 + (sasl-error "Invalid nonce from server"))) + (client-final-message-without-proof + (concat "c=" (base64-encode-string cbind-input t) "," ; *2 + "r=" nonce)) + (password + (sasl-read-passphrase + (format "%s passphrase for %s: " + (sasl-mechanism-name (sasl-client-mechanism client)) + (sasl-client-name client)))) + (salt (base64-decode-string salt-base64)) + (string-xor (lambda (a b) + (apply #'unibyte-string (cl-mapcar #'logxor a b)))) + (salted-password (let ((digest (concat salt (string 0 0 0 1))) + (xored nil)) + (dotimes (_i iteration-count xored) + (setq digest (funcall hmac-fun digest password)) + (setq xored (if (null xored) + digest + (funcall string-xor xored + digest)))))) + (client-key (funcall hmac-fun "Client Key" salted-password)) + (stored-key (decode-hex-string (funcall hash-fun client-key))) + (auth-message (concat "n=" (sasl-client-name client) + ",r=" c-nonce "," step-data + "," client-final-message-without-proof)) + (client-signature (funcall hmac-fun + (encode-coding-string auth-message 'utf-8) + stored-key)) + (client-proof (funcall string-xor client-key client-signature)) + (client-final-message + (concat client-final-message-without-proof "," + "p=" (base64-encode-string client-proof t)))) ; *3 + (sasl-client-set-property client 'auth-message auth-message) + (sasl-client-set-property client 'salted-password salted-password) + client-final-message)) + + ;;;; Misc 29.1 (defmacro erc-compat--with-memoization (table &rest forms) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 59b5f01f236..1af83b58ba7 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -31,6 +31,7 @@ ;;; Imenu support +(eval-when-compile (require 'cl-lib)) (require 'erc-common) (defvar erc-controls-highlight-regexp) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index b3e5fcf1a30..19a7ab86437 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -826,12 +826,11 @@ respectively. The separator is given by `erc-networks--id-sep'." ;; For now, please use this instead of `erc-networks--id-fixed-p'. (cl-defgeneric erc-networks--id-given (net-id) - "Return the preassigned identifier for a network presence, if any. -This may have originated from an `:id' arg to entry-point commands -`erc-tls' or `erc'.") + "Return the preassigned identifier for a network context, if any. +When non-nil, assume NET-ID originated from an `:id' argument to +entry-point commands `erc-tls' or `erc'.") -(cl-defmethod erc-networks--id-given ((_ erc-networks--id)) - nil) +(cl-defmethod erc-networks--id-given (_) nil) ; _ may be nil (cl-defmethod erc-networks--id-given ((nid erc-networks--id-fixed)) (erc-networks--id-symbol nid)) @@ -866,22 +865,15 @@ This may have originated from an `:id' arg to entry-point commands ((_ symbol) &context (erc-obsolete-var erc-reuse-buffers null)) (erc-networks--id-fixed-create (intern (buffer-name)))) -(cl-defgeneric erc-networks--id-on-connect (net-id) - "Update NET-ID `erc-networks--id' after connection params known. -This is typically during or just after MOTD.") - -(cl-defmethod erc-networks--id-on-connect ((_ erc-networks--id)) - nil) - -(cl-defmethod erc-networks--id-on-connect ((id erc-networks--id-qualifying)) - (erc-networks--id-qualifying-update id (erc-networks--id-qualifying-create))) - (cl-defgeneric erc-networks--id-equal-p (self other) - "Return non-nil when two network identities exhibit underlying equality. -SELF and OTHER are `erc-networks--id' struct instances. This -should normally be used only for ID recovery or merging, after -which no two identities should be `equal' (timestamps aside) that -aren't also `eq'.") + "Return non-nil when two network IDs exhibit underlying equality. +Expect SELF and OTHER to be `erc-networks--id' struct instances +and that this will only be called for ID recovery or merging, +after which no two identities should be `equal' (timestamps +aside) that aren't also `eq'.") + +(cl-defmethod erc-networks--id-equal-p ((_ null) (_ erc-networks--id)) nil) +(cl-defmethod erc-networks--id-equal-p ((_ erc-networks--id) (_ null)) nil) (cl-defmethod erc-networks--id-equal-p ((self erc-networks--id) (other erc-networks--id)) @@ -1382,7 +1374,8 @@ considered as well because server buffers are often killed." (let* ((identity erc-networks--id) (buffer (current-buffer)) (f (lambda () - (unless (or (eq (current-buffer) buffer) + (unless (or (not erc-networks--id) + (eq (current-buffer) buffer) (eq erc-networks--id identity)) (if (erc-networks--id-equal-p identity erc-networks--id) (throw 'buffer erc-networks--id) @@ -1397,16 +1390,17 @@ considered as well because server buffers are often killed." ;; server buffer, whereas `erc-networks--rename-server-buffer' can run ;; mid-session, after an identity's core components have changed. -(defun erc-networks--init-identity (_proc _parsed) +(defun erc-networks--init-identity (proc parsed) "Update identity with real network name." ;; Initialize identity for real now that we know the network (cl-assert erc-network) - (unless (erc-networks--id-symbol erc-networks--id) ; unless just reconnected - (erc-networks--id-on-connect erc-networks--id)) - ;; Find duplicate identities or other conflicting ones and act - ;; accordingly. - (erc-networks--update-server-identity) - ;; + (if erc-networks--id + (erc-networks--id-reload erc-networks--id proc parsed) + (setq erc-networks--id (erc-networks--id-create nil)) + ;; Find duplicate identities or other conflicting ones and act + ;; accordingly. + (erc-networks--update-server-identity) + (erc-networks--rename-server-buffer proc parsed)) nil) (defun erc-networks--rename-server-buffer (new-proc &optional _parsed) @@ -1474,8 +1468,7 @@ This must run before `erc-server-connected' is set." ;; For now, retain compatibility with erc-server-NNN-functions. (or (erc-networks--ensure-announced proc parsed) (erc-networks--set-name proc parsed) - (erc-networks--init-identity proc parsed) - (erc-networks--rename-server-buffer proc parsed))) + (erc-networks--init-identity proc parsed))) (define-erc-module networks nil "Provide data about IRC networks." diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el new file mode 100644 index 00000000000..9084d873ce4 --- /dev/null +++ b/lisp/erc/erc-sasl.el @@ -0,0 +1,417 @@ +;;; erc-sasl.el --- SASL for ERC -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This "non-IRCv3" implementation resembles others that have surfaced +;; over the years, the first possibly being from Joseph Gay: +;; +;; https://lists.gnu.org/archive/html/erc-discuss/2012-02/msg00001.html +;; +;; See options and Info manual for usage. +;; +;; TODO: +;; +;; - Find a way to obfuscate the password in memory (via something +;; like `auth-source--obfuscate'); it's currently visible in +;; backtraces. +;; +;; - Implement a proxy mechanism that chooses the strongest available +;; mechanism for you. Requires CAP 3.2 (see bug#49860). +;; +;; - Integrate with whatever solution ERC eventually settles on to +;; handle user options for different network contexts. At the +;; moment, this does its own thing for stashing and restoring +;; session options, but ERC should make abstractions available for +;; all local modules to use, possibly based on connection-local +;; variables. + +;;; Code: +(require 'erc) +(require 'rx) +(require 'sasl) +(require 'sasl-scram-rfc) +(require 'sasl-scram-sha256 nil t) ; not present in Emacs 27 + +(defgroup erc-sasl nil + "SASL for ERC." + :group 'erc + :package-version '(ERC . "5.4.1")) ; FIXME increment on next release + +(defcustom erc-sasl-mechanism 'plain + "SASL mechanism to connect with. +Note that any value other than nil or `external' likely requires +`erc-sasl-user' and `erc-sasl-password'." + :type '(choice (const plain) + (const external) + (const scram-sha-1) + (const scram-sha-256) + (const scram-sha-512) + (const ecdsa-nist256p-challenge))) + +(defcustom erc-sasl-user :user + "Account username to send when authenticating. +This is also referred to as the authentication identity or +\"authcid\". A value of `:user' or `:nick' indicates that the +corresponding connection parameter on file should be used. These +are most often derived from arguments provided to the `erc' and +`erc-tls' entry points. In the case of `:nick', a downcased +version is used." + :type '(choice string (const :user) (const :nick))) + +(defcustom erc-sasl-password :password + "Optional account password to send when authenticating. +When the value is a string, ERC will use it unconditionally for +most mechanisms. Likewise with `:password', except ERC will +instead use the \"session password\" on file, which often +originates from the entry-point commands `erc' or `erc-tls'. +Otherwise, when `erc-sasl-auth-source-function' is a function, +ERC will attempt an auth-source query, possibly using a non-nil +symbol for the suggested `:host' parameter if set as this +option's value or passed as an `:id' to `erc-tls'. Failing that, +ERC will prompt for input. + +Note that, with `:password', ERC will forgo sending a traditional +server password via the IRC \"PASS\" command. Also, when +`erc-sasl-mechanism' is set to `ecdsa-nist256p-challenge', this +option should hold the file name of the key." + :type '(choice (const nil) (const :password) string symbol)) + +(defcustom erc-sasl-auth-source-function nil + "Function to query auth-source for an SASL password. +Called with keyword params known to `auth-source-search', which +includes `erc-sasl-user' for the `:user' field and +`erc-sasl-password' for the `:host' field, when the latter option +is a non-nil, non-keyword symbol. In return, ERC expects a +string to send as the SASL password, or nil, to move on to the +next approach, as described in the doc string for the option +`erc-sasl-password'. See info node `(erc) Connecting' for +details on ERC's auth-source integration." + :type '(choice (function-item erc-auth-source-search) + (const nil) + function)) + +(defcustom erc-sasl-authzid nil + "SASL authorization identity, likely unneeded for everyday use." + :type '(choice (const nil) string)) + + +;; Analogous to what erc-backend does to persist opening params. +(defvar-local erc-sasl--options nil) + +;; Session-local (server buffer) SASL subproto state +(defvar-local erc-sasl--state nil) + +(cl-defstruct erc-sasl--state + "Holder for client object and subproto state." + (client nil :type vector) + (step nil :type vector) + (pending nil :type string)) + +(defun erc-sasl--get-user () + (pcase (alist-get 'user erc-sasl--options) + (:user erc-session-username) + (:nick (erc-downcase (erc-current-nick))) + (v v))) + +(defun erc-sasl--read-password (prompt) + "Return configured option or server password. +PROMPT is passed to `read-passwd' if necessary." + (if-let + ((found (pcase (alist-get 'password erc-sasl--options) + (:password erc-session-password) + ((and (pred stringp) v) (unless (string-empty-p v) v)) + ((and (guard erc-sasl-auth-source-function) + v (let host + (or v (erc-networks--id-given erc-networks--id)))) + (apply erc-sasl-auth-source-function + :user (erc-sasl--get-user) + (and host (list :host (symbol-name host)))))))) + (copy-sequence (erc--unfun found)) + (read-passwd prompt))) + +(defun erc-sasl--plain-response (client steps) + (let ((sasl-read-passphrase #'erc-sasl--read-password)) + (sasl-plain-response client steps))) + +(declare-function erc-compat--29-sasl-scram--client-final-message "erc-compat" + (hash-fun block-length hash-length client step)) + +(defun erc-sasl--scram-sha-hack-client-final-message (&rest args) + ;; In the future (29+), we'll hopefully be able to call + ;; `sasl-scram--client-final-message' directly + (require 'erc-compat) + (let ((sasl-read-passphrase #'erc-sasl--read-password)) + (apply #'erc-compat--29-sasl-scram--client-final-message args))) + +(defun erc-sasl--scram-sha-1-client-final-message (client step) + (erc-sasl--scram-sha-hack-client-final-message 'sha1 64 20 client step)) + +(defun erc-sasl--scram-sha-256-client-final-message (client step) + (erc-sasl--scram-sha-hack-client-final-message 'sasl-scram-sha256 64 32 + client step)) + +(defun erc-sasl--scram-sha512 (object &optional start end binary) + (secure-hash 'sha512 object start end binary)) + +(defun erc-sasl--scram-sha-512-client-final-message (client step) + (erc-sasl--scram-sha-hack-client-final-message #'erc-sasl--scram-sha512 + 128 64 client step)) + +(defun erc-sasl--scram-sha-512-authenticate-server (client step) + (sasl-scram--authenticate-server #'erc-sasl--scram-sha512 + 128 64 client step)) + +(defun erc-sasl--ecdsa-first (client _step) + "Return CLIENT name." + (sasl-client-name client)) + +;; FIXME do this with gnutls somehow +(defun erc-sasl--ecdsa-sign (client step) + "Return signed challenge for CLIENT and current STEP." + (let ((challenge (sasl-step-data step))) + (with-temp-buffer + (set-buffer-multibyte nil) + (insert challenge) + (call-process-region (point-min) (point-max) + "openssl" 'delete t nil "pkeyutl" "-inkey" + (sasl-client-property client 'ecdsa-keyfile) + "-sign") + (buffer-string)))) + +(pcase-dolist + (`(,name . ,steps) + '(("PLAIN" + erc-sasl--plain-response) + ("EXTERNAL" + ignore) + ("SCRAM-SHA-1" + erc-compat--29-sasl-scram-client-first-message + erc-sasl--scram-sha-1-client-final-message + sasl-scram-sha-1-authenticate-server) + ("SCRAM-SHA-256" + erc-compat--29-sasl-scram-client-first-message + erc-sasl--scram-sha-256-client-final-message + sasl-scram-sha-256-authenticate-server) + ("SCRAM-SHA-512" + erc-compat--29-sasl-scram-client-first-message + erc-sasl--scram-sha-512-client-final-message + erc-sasl--scram-sha-512-authenticate-server) + ("ECDSA-NIST256P-CHALLENGE" + erc-sasl--ecdsa-first + erc-sasl--ecdsa-sign))) + (let ((feature (intern (concat "erc-sasl-" (downcase name))))) + (put feature 'sasl-mechanism (sasl-make-mechanism name steps)) + (provide feature))) + +(cl-defgeneric erc-sasl--create-client (mechanism) + "Create and return a new SASL client object for MECHANISM." + (let ((sasl-mechanism-alist (copy-sequence sasl-mechanism-alist)) + (sasl-mechanisms sasl-mechanisms) + (name (upcase (symbol-name mechanism))) + (feature (intern-soft (concat "erc-sasl-" (symbol-name mechanism)))) + client) + (when feature + (setf (alist-get name sasl-mechanism-alist nil nil #'equal) `(,feature)) + (cl-pushnew name sasl-mechanisms :test #'equal) + (setq client (sasl-make-client (sasl-find-mechanism (list name)) + (erc-sasl--get-user) + "N/A" "N/A")) + (sasl-client-set-property client 'authenticator-name + (alist-get 'authzid erc-sasl--options)) + client))) + +(cl-defmethod erc-sasl--create-client ((_ (eql plain))) + "Create and return a new PLAIN client object." + ;; https://tools.ietf.org/html/rfc4616#section-2. + (let* ((sans (remq (assoc "PLAIN" sasl-mechanism-alist) + sasl-mechanism-alist)) + (sasl-mechanism-alist (cons '("PLAIN" erc-sasl-plain) sans)) + (authc (erc-sasl--get-user)) + (port (if (numberp erc-session-port) + (number-to-string erc-session-port) + "0")) + ;; In most cases, `erc-server-announced-name' won't be known. + (host (or erc-server-announced-name erc-session-server)) + (mech (sasl-find-mechanism '("PLAIN"))) + (client (sasl-make-client mech authc port host))) + (sasl-client-set-property client 'authenticator-name + (alist-get 'authzid erc-sasl--options)) + client)) + +(cl-defmethod erc-sasl--create-client ((_ (eql scram-sha-256))) + "Create and return a new SCRAM-SHA-256 client." + (when (featurep 'sasl-scram-sha256) + (cl-call-next-method))) + +(cl-defmethod erc-sasl--create-client ((_ (eql scram-sha-512))) + "Create and return a new SCRAM-SHA-512 client." + (when (featurep 'sasl-scram-sha256) + (cl-call-next-method))) + +(cl-defmethod erc-sasl--create-client ((_ (eql ecdsa-nist256p-challenge))) + "Create and return a new ECDSA-NIST256P-CHALLENGE client." + (let ((keyfile (cdr (assq 'password erc-sasl--options)))) + ;; Better to signal usage errors now than inside a process filter. + (cond ((or (not (stringp keyfile)) (not (file-readable-p keyfile))) + (erc-display-error-notice + nil "`erc-sasl-password' not accessible as a file") + nil) + ((not (executable-find "openssl")) + (erc-display-error-notice nil "Could not find openssl program") + nil) + (t + (let ((client (cl-call-next-method))) + (sasl-client-set-property client 'ecdsa-keyfile keyfile) + client))))) + +;; This stands alone because it's also used by bug#49860. +(defun erc-sasl--init () + (setq erc-sasl--state (make-erc-sasl--state)) + ;; If the previous attempt failed during registration, this may be + ;; non-nil and contain erroneous values, but how can we detect that? + ;; What if the server dropped the connection for some other reason? + (setq erc-sasl--options + (or (and erc--server-reconnecting + (alist-get 'erc-sasl--options erc--server-reconnecting)) + `((user . ,erc-sasl-user) + (password . ,erc-sasl-password) + (mechanism . ,erc-sasl-mechanism) + (authzid . ,erc-sasl-authzid))))) + +(defun erc-sasl--mechanism-offered-p (offered) + "Return non-nil when OFFERED appears among a list of mechanisms." + (string-match-p (rx-to-string + `(: (| bot ",") + ,(symbol-name (alist-get 'mechanism erc-sasl--options)) + (| eot ","))) + (downcase offered))) + +(erc-define-catalog + 'english + '((s902 . "ERR_NICKLOCKED nick %n unavailable: %s") + (s904 . "ERR_SASLFAIL (authentication failed) %s") + (s905 . "ERR SASLTOOLONG (credentials too long) %s") + (s906 . "ERR_SASLABORTED (authentication aborted) %s") + (s907 . "ERR_SASLALREADY (already authenticated) %s") + (s908 . "RPL_SASLMECHS (unsupported mechanism: %m) %s"))) + +(define-erc-module sasl nil + "Non-IRCv3 SASL support for ERC. +This doesn't solicit or validate a suite of supported mechanisms." + ;; See bug#49860 for a CAP 3.2-aware WIP implementation. + ((unless erc--target + (erc-sasl--init) + (let* ((mech (alist-get 'mechanism erc-sasl--options)) + (client (erc-sasl--create-client mech))) + (unless client + (erc-display-error-notice + nil (format "Unknown or unsupported SASL mechanism: %s" mech)) + (erc-error "Unknown or unsupported SASL mechanism: %s" mech)) + (setf (erc-sasl--state-client erc-sasl--state) client)))) + ((kill-local-variable 'erc-sasl--state) + (kill-local-variable 'erc-sasl--options)) + 'local) + +(define-erc-response-handler (AUTHENTICATE) + "Begin or resume an SASL session." nil + (if-let* ((response (car (erc-response.command-args parsed))) + ((= 400 (length response)))) + (cl-callf (lambda (s) (concat s response)) + (erc-sasl--state-pending erc-sasl--state)) + (cl-assert response t) + (when (string= "+" response) + (setq response "")) + (setf response (base64-decode-string + (concat (erc-sasl--state-pending erc-sasl--state) + response)) + (erc-sasl--state-pending erc-sasl--state) nil) + (let ((client (erc-sasl--state-client erc-sasl--state)) + (step (erc-sasl--state-step erc-sasl--state)) + data) + (when step + (sasl-step-set-data step response)) + (setq step (setf (erc-sasl--state-step erc-sasl--state) + (sasl-next-step client step)) + data (sasl-step-data step)) + (when (string= data "") + (setq data nil)) + (when data + (setq data (erc--unfun (base64-encode-string data t)))) + (erc-server-send (concat "AUTHENTICATE " (or data "+")))))) + +(defun erc-sasl--destroy (proc) + (run-hook-with-args 'erc-quit-hook proc) + (delete-process proc) + (erc-error "Disconnected from %s; please review SASL settings" proc)) + +(define-erc-response-handler (902) + "Handle an ERR_NICKLOCKED response." nil + (erc-display-message parsed '(notice error) 'active 's902 + ?n (car (erc-response.command-args parsed)) + ?s (erc-response.contents parsed)) + (erc-sasl--destroy proc)) + +(define-erc-response-handler (903) + "Handle a RPL_SASLSUCCESS response." nil + (when erc-sasl-mode + (unless erc-server-connected + (erc-server-send "CAP END"))) + (erc-display-message parsed 'notice proc (erc-response.contents parsed))) + +(define-erc-response-handler (907) + "Handle a RPL_SASLALREADY response." nil + (erc-display-message parsed '(notice error) 'active 's907 + ?s (erc-response.contents parsed))) + +(define-erc-response-handler (904 905 906) + "Handle various SASL-related error responses." nil + (erc-display-message parsed '(notice error) 'active + (intern (format "s%s" (erc-response.command parsed))) + ?s (erc-response.contents parsed)) + (erc-sasl--destroy proc)) + +(define-erc-response-handler (908) + "Handle a RPL_SASLALREADY response." nil + (erc-display-message parsed '(notice error) 'active 's908 + ?m (alist-get 'mechanism erc-sasl--options) + ?s (string-join (cdr (erc-response.command-args parsed)) + " ")) + (erc-sasl--destroy proc)) + +(cl-defmethod erc--register-connection (&context (erc-sasl-mode (eql t))) + "Send speculative/pipelined CAP and AUTHENTICATE and hope for the best." + (if-let* ((c (erc-sasl--state-client erc-sasl--state)) + (m (sasl-mechanism-name (sasl-client-mechanism c)))) + (progn + (erc-server-send "CAP REQ :sasl") + (if (and erc-session-password + (eq :password (alist-get 'password erc-sasl--options))) + (let (erc-session-password) + (erc-login)) + (erc-login)) + (erc-server-send (format "AUTHENTICATE %s" m))) + (erc-sasl--destroy erc-server-process))) + +(provide 'erc-sasl) +;;; erc-sasl.el ends here +;; +;; Local Variables: +;; generated-autoload-file: "erc-loaddefs.el" +;; End: diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index fe9cb5b5f17..48953288d17 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -455,7 +455,7 @@ it returns nil." (read-passwd (format "NickServ password for %s on %s (RET to cancel): " nick nid))))) - ((not (string-empty-p ret)))) + ((not (string-empty-p (erc--unfun ret))))) ret)) (defvar erc-auto-discard-away) @@ -477,7 +477,8 @@ Returns t if the message could be sent, nil otherwise." (msgtype (or (erc-nickserv-alist-ident-command nil nickserv-info) "PRIVMSG"))) (erc-message msgtype - (concat nickserv " " identify-word " " nick password)))) + (concat nickserv " " identify-word " " nick + (erc--unfun password))))) (defun erc-nickserv-call-identify-function (nickname) "Call `erc-nickserv-identify' with NICKNAME." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2312246e3ee..268d83dc449 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1791,10 +1791,7 @@ buffer rather than a server buffer.") "Migrate old names of ERC modules to new ones." ;; modify `transforms' to specify what needs to be changed ;; each item is in the format '(old . new) - (let ((transforms '((pcomplete . completion)))) - (delete-dups - (mapcar (lambda (m) (or (cdr (assoc m transforms)) m)) - mods)))) + (delete-dups (mapcar #'erc--normalize-module-symbol mods))) (defcustom erc-modules '(netsplit fill button match track completion readonly networks ring autojoin noncommands irccontrols @@ -1813,9 +1810,16 @@ removed from the list will be disabled." (dolist (module erc-modules) (unless (member module val) (let ((f (intern-soft (format "erc-%s-mode" module)))) - (when (and (fboundp f) (boundp f) (symbol-value f)) - (message "Disabling `erc-%s'" module) - (funcall f 0)))))) + (when (and (fboundp f) (boundp f)) + (when (symbol-value f) + (message "Disabling `erc-%s'" module) + (funcall f 0)) + (unless (or (custom-variable-p f) + (not (fboundp 'erc-buffer-filter))) + (erc-buffer-filter (lambda () + (when (symbol-value f) + (funcall f 0)) + (kill-local-variable f))))))))) (set sym val) ;; this test is for the case where erc hasn't been loaded yet (when (fboundp 'erc-update-modules) @@ -1856,6 +1860,7 @@ removed from the list will be disabled." (const :tag "readonly: Make displayed lines read-only" readonly) (const :tag "replace: Replace text in messages" replace) (const :tag "ring: Enable an input history" ring) + (const :tag "sasl: Enable SASL authentication" sasl) (const :tag "scrolltobottom: Scroll to the bottom of the buffer" scrolltobottom) (const :tag "services: Identify to Nickserv (IRC Services) automatically" @@ -1873,27 +1878,23 @@ removed from the list will be disabled." :group 'erc) (defun erc-update-modules () - "Run this to enable erc-foo-mode for all modules in `erc-modules'." - (let (req) - (dolist (mod erc-modules) - (setq req (concat "erc-" (symbol-name mod))) - (cond - ;; yuck. perhaps we should bring the filenames into sync? - ((string= req "erc-capab-identify") - (setq req "erc-capab")) - ((string= req "erc-completion") - (setq req "erc-pcomplete")) - ((string= req "erc-pcomplete") - (setq mod 'completion)) - ((string= req "erc-autojoin") - (setq req "erc-join"))) - (condition-case nil - (require (intern req)) - (error nil)) - (let ((sym (intern-soft (concat "erc-" (symbol-name mod) "-mode")))) - (if (fboundp sym) - (funcall sym 1) - (error "`%s' is not a known ERC module" mod)))))) + "Enable minor mode for every module in `erc-modules'. +Except ignore all local modules, which were introduced in ERC 5.5." + (erc--update-modules) + nil) + +(defun erc--update-modules () + (let (local-modes) + (dolist (module erc-modules local-modes) + (require (or (alist-get module erc--modules-to-features) + (intern (concat "erc-" (symbol-name module)))) + nil 'noerror) ; some modules don't have a corresponding feature + (let ((mode (intern-soft (concat "erc-" (symbol-name module) "-mode")))) + (unless (and mode (fboundp mode)) + (error "`%s' is not a known ERC module" module)) + (if (custom-variable-p mode) + (funcall mode 1) + (push mode local-modes)))))) (defun erc-setup-buffer (buffer) "Consults `erc-join-buffer' to find out how to display `BUFFER'." @@ -1924,6 +1925,24 @@ removed from the list will be disabled." (display-buffer buffer) (switch-to-buffer buffer))))) +(defun erc--merge-local-modes (new-modes old-vars) + "Return a cons of two lists, each containing local-module modes. +In the first, put modes to be enabled in a new ERC buffer by +calling their associated functions. In the second, put modes to +be marked as disabled by setting their associated variables to +nil." + (if old-vars + (let ((out (list (reverse new-modes)))) + (pcase-dolist (`(,k . ,v) old-vars) + (when (and (string-prefix-p "erc-" (symbol-name k)) + (string-suffix-p "-mode" (symbol-name k))) + (if v + (cl-pushnew k (car out)) + (setf (car out) (delq k (car out))) + (cl-pushnew k (cdr out))))) + (cons (nreverse (car out)) (nreverse (cdr out)))) + (list new-modes))) + (defun erc-open (&optional server port nick full-name connect passwd tgt-list channel process client-certificate user id) @@ -1951,18 +1970,25 @@ Returns the buffer for the given server or channel." (let* ((target (and channel (erc--target-from-string channel))) (buffer (erc-get-buffer-create server port nil target id)) (old-buffer (current-buffer)) - old-point + (old-vars (and (not connect) (buffer-local-variables))) + (old-recon-count erc-server-reconnect-count) + (old-point nil) + (delayed-modules nil) (continued-session (and erc--server-reconnecting (with-suppressed-warnings ((obsolete erc-reuse-buffers)) erc-reuse-buffers)))) (when connect (run-hook-with-args 'erc-before-connect server port nick)) - (erc-update-modules) (set-buffer buffer) (setq old-point (point)) - (let ((old-recon-count erc-server-reconnect-count)) - (erc-mode) - (setq erc-server-reconnect-count old-recon-count)) + (setq delayed-modules + (erc--merge-local-modes (erc--update-modules) + (or erc--server-reconnecting old-vars))) + + (delay-mode-hooks (erc-mode)) + + (setq erc-server-reconnect-count old-recon-count) + (when (setq erc-server-connected (not connect)) (setq erc-server-announced-name (buffer-local-value 'erc-server-announced-name old-buffer))) @@ -2017,14 +2043,23 @@ Returns the buffer for the given server or channel." (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick))) ;; client certificate (only useful if connecting over TLS) (setq erc-session-client-certificate client-certificate) - (setq erc-networks--id (if connect - (erc-networks--id-create id) - (buffer-local-value 'erc-networks--id - old-buffer))) + (setq erc-networks--id + (if connect + (or (and erc--server-reconnecting + (alist-get 'erc-networks--id erc--server-reconnecting)) + (and id (erc-networks--id-create id))) + (buffer-local-value 'erc-networks--id old-buffer))) ;; debug output buffer (setq erc-dbuf (when erc-log-p (get-buffer-create (concat "*ERC-DEBUG: " server "*")))) + + (erc-determine-parameters server port nick full-name user passwd) + + (save-excursion (run-mode-hooks)) + (dolist (mod (car delayed-modules)) (funcall mod +1)) + (dolist (var (cdr delayed-modules)) (set var nil)) + ;; set up prompt (unless continued-session (goto-char (point-max)) @@ -2036,8 +2071,6 @@ Returns the buffer for the given server or channel." (erc-display-prompt) (goto-char (point-max))) - (erc-determine-parameters server port nick full-name user passwd) - ;; Saving log file on exit (run-hook-with-args 'erc-connect-pre-hook buffer) @@ -2302,6 +2335,23 @@ but you won't see it. WARNING: Do not set this variable directly! Instead, use the function `erc-toggle-debug-irc-protocol' to toggle its value.") +(defvar erc--debug-irc-protocol-mask-secrets t + "Whether to hide secrets in a debug log. +They are still visible on screen but are replaced by question +marks when yanked.") + +(defun erc--mask-secrets (string) + (when-let* ((eot (length string)) + (beg (text-property-any 0 eot 'erc-secret t string)) + (end (text-property-not-all beg eot 'erc-secret t string)) + (sec (substring string beg end))) + (setq string (concat (substring string 0 beg) + (make-string 10 ??) + (substring string end eot))) + (put-text-property beg (+ 10 beg) 'face 'erc-inverse-face string) + (put-text-property beg (+ 10 beg) 'display sec string)) + string) + (defun erc-log-irc-protocol (string &optional outbound) "Append STRING to the buffer *erc-protocol*. @@ -2327,6 +2377,8 @@ workaround." (format "%s:%s" erc-session-server erc-session-port)))) (ts (when erc-debug-irc-protocol-time-format (format-time-string erc-debug-irc-protocol-time-format)))) + (when erc--debug-irc-protocol-mask-secrets + (setq string (erc--mask-secrets string))) (with-current-buffer (get-buffer-create "*erc-protocol*") (save-excursion (goto-char (point-max)) @@ -3179,7 +3231,8 @@ node `(erc) Connecting'." function)) (defun erc--auth-source-determine-params-defaults () - (let* ((net (and-let* ((esid (erc-networks--id-symbol erc-networks--id)) + (let* ((net (and-let* ((erc-networks--id) + (esid (erc-networks--id-symbol erc-networks--id)) ((symbol-name esid))))) (localp (and erc--target (erc--target-channel-local-p erc--target))) (hosts (if localp @@ -3251,9 +3304,8 @@ the one with host foo would win." (setq plist (plist-put plist :max 5000))) ; `auth-source-netrc-parse' (unless (plist-get defaults :require) (setq plist (plist-put plist :require '(:secret)))) - (when-let* ((sorted (sort (apply #'auth-source-search plist) test)) - (secret (plist-get (car sorted) :secret))) - (if (functionp secret) (funcall secret) secret)))) + (when-let* ((sorted (sort (apply #'auth-source-search plist) test))) + (plist-get (car sorted) :secret)))) (defun erc-auth-source-search (&rest plist) "Call `auth-source-search', possibly with keyword params in PLIST." @@ -3274,7 +3326,8 @@ Without SECRET, consult auth-source, possibly passing SERVER as the (setq secret (apply erc-auth-source-join-function `(,@(and server (list :host server)) :user ,channel)))) (erc-log (format "cmd: JOIN: %s" channel)) - (erc-server-send (concat "JOIN " channel (and secret (concat " " secret))))) + (erc-server-send (concat "JOIN " channel + (and secret (concat " " (erc--unfun secret)))))) (defun erc--valid-local-channel-p (channel) "Non-nil when channel is server-local on a network that allows them." @@ -3831,10 +3884,8 @@ the message given by REASON." (with-suppressed-warnings ((obsolete erc-server-reconnecting) (obsolete erc-reuse-buffers)) (if erc-reuse-buffers - (progn (cl-assert (not erc--server-reconnecting)) - (cl-assert (not erc-server-reconnecting))) - (setq erc--server-reconnecting nil - erc-server-reconnecting nil))))) + (cl-assert (not erc-server-reconnecting)) + (setq erc-server-reconnecting nil))))) t) (defun erc-cmd-RECONNECT (&rest args) @@ -5904,7 +5955,13 @@ strings over to the next call." (with-current-buffer (if (buffer-live-p (erc-server-buffer)) (erc-server-buffer) (current-buffer)) - (setq erc-server-current-nick nick))) + (unless (equal erc-server-current-nick nick) + (setq erc-server-current-nick nick) + ;; This seems sensible but may well be superfluous. Should + ;; really prove that it's actually needed via test scenario. + (when erc-server-connected + (erc-networks--id-reload erc-networks--id))) + nick)) (defun erc-current-nick () "Return the current nickname." @@ -6306,6 +6363,15 @@ user input." ;; authentication +(defun erc--unfun (maybe-fn) + "Return MAYBE-FN or whatever it returns." + (let ((s (if (functionp maybe-fn) (funcall maybe-fn) maybe-fn))) + (when (and erc-debug-irc-protocol + erc--debug-irc-protocol-mask-secrets + (stringp s)) + (put-text-property 0 (length s) 'erc-secret t s)) + s)) + (defun erc-login () "Perform user authentication at the IRC server." (erc-log (format "login: nick: %s, user: %s %s %s :%s" @@ -6315,7 +6381,7 @@ user input." erc-session-server erc-session-user-full-name)) (if erc-session-password - (erc-server-send (concat "PASS :" erc-session-password)) + (erc-server-send (concat "PASS :" (erc--unfun erc-session-password))) (message "Logging in without password")) (erc-server-send (format "NICK %s" (erc-current-nick))) (erc-server-send diff --git a/lisp/files.el b/lisp/files.el index b947451369c..f1f890430f1 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1533,7 +1533,7 @@ in all cases, since that is the standard symbol for byte." (let ((power (if (or (null flavor) (eq flavor 'iec)) 1024.0 1000.0)) - (prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y"))) + (prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y" "R" "Q"))) (while (and (>= file-size power) (cdr prefixes)) (setq file-size (/ file-size power) prefixes (cdr prefixes))) @@ -8566,7 +8566,8 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, ;; Make a .trashinfo file. Use O_EXCL, as per trash-spec 1.0. (let* ((files-base (file-name-nondirectory fn)) - (is-directory (file-directory-p fn)) + (is-directory (and (file-directory-p fn) + (not (file-symlink-p fn)))) (overwrite nil) info-fn) ;; We're checking further down whether the info file @@ -8596,10 +8597,27 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, (setq files-base (substring (file-name-nondirectory info-fn) 0 (- (length ".trashinfo")))) (write-region nil nil info-fn nil 'quiet info-fn))) - ;; Finally, try to move the file to the trashcan. + ;; Finally, try to move the item to the trashcan. If + ;; it's a file, just move it. Things are more + ;; complicated for directories. If the target + ;; directory already exists (due to uniquification) + ;; and the trash directory is in a different + ;; filesystem, rename-file will error out, even when + ;; 'overwrite' is non-nil. Rather than worry about + ;; whether we're crossing filesystems, just check if + ;; we've moving a directory and the target directory + ;; already exists. That handles both the + ;; same-filesystem and cross-filesystem cases. (let ((delete-by-moving-to-trash nil) (new-fn (file-name-concat trash-files-dir files-base))) - (rename-file fn new-fn overwrite))))))))) + (if (or (not is-directory) + (not (file-exists-p new-fn))) + (rename-file fn new-fn overwrite) + (copy-directory fn + (file-name-as-directory new-fn) + t nil t) + (delete-directory fn t)))))))))) + (defsubst file-attribute-type (attributes) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index d132de3a322..bf9a179d6ae 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -614,6 +614,14 @@ If it fontifies a larger region, it should ideally return a list of the form \(jit-lock-bounds BEG . END) indicating the bounds of the region actually fontified.") +(defvar font-lock-fontify-syntactically-function + #'font-lock-default-fontify-syntactically + "Function to use for syntactically fontifying a region. + +It should take two args, the beginning and end of the region, and +an optional third arg VERBOSE. If VERBOSE is non-nil, the +function should print status messages.") + (defvar font-lock-unfontify-region-function #'font-lock-default-unfontify-region "Function to use for unfontifying a region. It should take two args, the beginning and end of the region. @@ -932,7 +940,7 @@ The value of this variable is used when Font Lock mode is turned on.") ;; A further reason to use the fontification indirection feature is when the ;; default syntactic fontification, or the default fontification in general, ;; is not flexible enough for a particular major mode. For example, perhaps -;; comments are just too hairy for `font-lock-fontify-syntactically-region' to +;; comments are just too hairy for `font-lock-default-fontify-syntactically' to ;; cope with. You need to write your own version of that function, e.g., ;; `hairy-fontify-syntactically-region', and make your own version of ;; `hairy-fontify-region' call that function before calling @@ -942,6 +950,10 @@ The value of this variable is used when Font Lock mode is turned on.") ;; example, TeX modes could fontify {\foo ...} and \bar{...} etc. multi-line ;; directives correctly and cleanly. (It is the same problem as fontifying ;; multi-line strings and comments; regexps are not appropriate for the job.) +;; (This comment is written before `font-lock-default-fontify-syntactically' +;; can be replaced. Now you can obviously replace +;; `font-lock-default-fontify-syntactically' with a custom function.) + (defvar-local font-lock-extend-after-change-region-function nil "A function that determines the region to refontify after a change. @@ -1171,7 +1183,7 @@ This function is the default `font-lock-fontify-region-function'." (setq font-lock-syntactically-fontified end)) (font-lock-fontify-syntactic-keywords-region start end))) (unless font-lock-keywords-only - (font-lock-fontify-syntactically-region beg end loudly)) + (funcall font-lock-fontify-syntactically-function beg end loudly)) (font-lock-fontify-keywords-region beg end loudly) `(jit-lock-bounds ,beg . ,end)))) @@ -1519,7 +1531,7 @@ START should be at the beginning of a line." (defvar font-lock-comment-end-skip nil "If non-nil, Font Lock mode uses this instead of `comment-end-skip'.") -(defun font-lock-fontify-syntactically-region (start end &optional loudly) +(defun font-lock-default-fontify-syntactically (start end &optional loudly) "Put proper face on each string and comment between START and END. START should be at the beginning of a line." (syntax-propertize end) ; Apply any needed syntax-table properties. @@ -2071,6 +2083,55 @@ as the constructs of Haddock, Javadoc and similar systems." "Font Lock mode face used to highlight grouping constructs in Lisp regexps." :group 'font-lock-faces) +(defface font-lock-escape-face + '((t :inherit font-lock-regexp-grouping-backslash)) + "Font Lock mode face used to highlight escape sequences in strings." + :group 'font-lock-faces + :version "29.1") + +(defface font-lock-number-face + '((t nil)) + "Font Lock mode face used to highlight numbers." + :group 'font-lock-faces + :version "29.1") + +(defface font-lock-operator-face + '((t nil)) + "Font Lock mode face used to highlight operators." + :group 'font-lock-faces + :version "29.1") + +(defface font-lock-property-face + '((t :inherit font-lock-variable-name-face)) + "Font Lock mode face used to highlight properties of an object. +For example, the declaration and use of fields in a struct." + :group 'font-lock-faces + :version "29.1") + +(defface font-lock-punctuation-face + '((t nil)) + "Font Lock mode face used to highlight punctuation." + :group 'font-lock-faces + :version "29.1") + +(defface font-lock-bracket-face + '((t :inherit font-lock-punctuation-face)) + "Font Lock mode face used to highlight brackets, braces, and parens." + :group 'font-lock-faces + :version "29.1") + +(defface font-lock-delimiter-face + '((t :inherit font-lock-punctuation-face)) + "Font Lock mode face used to highlight delimiters." + :group 'font-lock-faces + :version "29.1") + +(defface font-lock-misc-punctuation-face + '((t :inherit font-lock-punctuation-face)) + "Font Lock mode face used to highlight miscellaneous punctuation." + :group 'font-lock-faces + :version "29.1") + ;; End of Color etc. support. ;;; Menu support. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 814d21823dc..75ea34e1352 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -89,8 +89,8 @@ :group 'gnus-article) (defgroup gnus-article-emphasis nil - "Fontisizing articles." - :link '(custom-manual "(gnus)Article Fontisizing") + "Fontifying articles." + :link '(custom-manual "(gnus)Article Fontifying") :group 'gnus-article) (defgroup gnus-article-saving nil @@ -2008,9 +2008,9 @@ always hide." (gnus-article-hide-header "reply-to"))))) ((eq elem 'date) (let ((date (with-current-buffer gnus-original-article-buffer - ;; If date in `gnus-article-buffer' is localized - ;; (`gnus-treat-date-user-defined'), - ;; `days-between' might fail. + ;; If date in `gnus-article-buffer' is localized + ;; (`gnus-article-date-headers'), + ;; `days-between' might fail. (message-fetch-field "date")))) (when (and date (< (days-between (current-time-string) date) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index ceeb1848542..cf5ca628cff 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -119,7 +119,7 @@ "List of registry marks and their options. -`gnus-registry-mark-article' will offer symbols from this list +`gnus-registry-set-article-mark' will offer symbols from this list for completion. Each entry must have a character to be useful for summary mode diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 7941496be61..142070e4665 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -48,7 +48,7 @@ ;; The general flow is: ;; 1. The user calls one of `gnus-group-make-search-group' or -;; `gnus-group-make-permanent-search-group' (or a few other entry +;; `gnus-group-read-ephemeral-search-group' (or a few other entry ;; points). These functions prompt for a search query, and collect ;; the groups to search, then create an nnselect group, setting an ;; 'nnselect-specs group parameter where 'nnselect-function is diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 13263dddc9c..1acbe0bc938 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -427,7 +427,7 @@ inheritance." (defun gnus-group-prepare-topics (level &optional predicate lowest regexp list-topic topic-level) "List all newsgroups with unread articles of level LEVEL or lower. -Use the `gnus-group-topics' to sort the groups. +Use the `gnus-group-prepare-topics' to sort the groups. If PREDICATE is a function, list groups that the function returns non-nil; if it is t, list groups that have no unread articles. If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 9cafc78ab89..654cc1cc51a 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -1622,7 +1622,7 @@ Gnus might fail to display all of it.") state)) ;; `gnus-uu-choose-action' chooses what action to perform given the name -;; and `gnus-uu-file-action-list'. Returns either nil if no action is +;; and FILE-ACTION-LIST. Return either nil if no action is ;; found, or the name of the command to run if such a rule is found. (defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) (let ((action-list (copy-sequence file-action-list)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 3bbd68bdcd7..55899087642 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8811,8 +8811,6 @@ headers. If FORCE, insert new field even if NEW-VALUE is empty." "bug-gnu-emacs@gnu.org") "Mail addresses that have no full name. Used in `message-simplify-recipients'." - ;; Maybe the addresses could be extracted from - ;; `gnus-parameter-to-list-alist'? :type '(choice (const :tag "None" nil) (repeat string)) :version "23.1" ;; No Gnus diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 4d1ecbf8642..faa288934d1 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -670,7 +670,7 @@ This variable is set by `nnmaildir-request-article'.") (defun nnmaildir-open-server (server-string &optional defs) (let ((server (alist-get server-string nnmaildir--servers nil nil #'equal)) - dir size x) + dir size x prefix) (catch 'return (if server (and (nnmaildir--srv-groups server) @@ -710,20 +710,11 @@ This variable is set by `nnmaildir-request-article'.") (car x) (setf (nnmaildir--srv-gnm server) t) (require 'nnmail)) - (setq x (assq 'target-prefix defs)) - (if x - (progn - (setq x (cadr x) - x (eval x t)) ;FIXME: Why `eval'? - (setf (nnmaildir--srv-target-prefix server) x)) - (setq x (assq 'create-directory defs)) - (if x - (progn - (setq x (cadr x) - x (eval x t) ;FIXME: Why `eval'? - x (file-name-as-directory x)) - (setf (nnmaildir--srv-target-prefix server) x)) - (setf (nnmaildir--srv-target-prefix server) ""))) + (setf prefix (cl-second (assq 'target-prefix defs)) + (nnmaildir--srv-target-prefix server) + (if prefix + (eval prefix t) + "")) (setf (nnmaildir--srv-groups server) (gnus-make-hashtable size)) (setq nnmaildir--cur-server server) diff --git a/lisp/help.el b/lisp/help.el index f956111a52f..8e1b325141e 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -747,14 +747,15 @@ or a buffer name." (setq-local outline-level (lambda () 1)) (setq-local outline-minor-mode-cycle t outline-minor-mode-highlight t - outline-minor-mode-use-buttons 'insert) + outline-minor-mode-use-buttons 'insert + ;; Hide the longest body. + outline-default-state 1 + outline-default-rules + '((match-regexp . "Key translations"))) (outline-minor-mode 1) (save-excursion (goto-char (point-min)) (let ((inhibit-read-only t)) - ;; Hide the longest body. - (when (re-search-forward "Key translations" nil t) - (outline-hide-subtree)) ;; Hide ^Ls. (while (search-forward "\n\f\n" nil t) (put-text-property (1+ (match-beginning 0)) (1- (match-end 0)) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 6b5cccec515..adffef43259 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -1336,10 +1336,12 @@ against '/a/b'. For a buffer not associated with a file, this matches against the value of `default-directory' in that buffer." ( :description "directory name" :reader (read-from-minibuffer "Filter by directory name (regex): ")) - (if-let ((it (with-current-buffer buf (ibuffer-buffer-file-name)))) - (when-let ((dirname (file-name-directory it))) - (string-match qualifier dirname)) - (when default-directory (string-match qualifier default-directory)))) + (with-current-buffer buf + (if-let* ((filename (ibuffer-buffer-file-name)) + (dirname (file-name-directory filename))) + (string-match qualifier dirname) + (when default-directory + (string-match qualifier default-directory))))) ;;;###autoload (autoload 'ibuffer-filter-by-size-gt "ibuf-ext") (define-ibuffer-filter size-gt diff --git a/lisp/info.el b/lisp/info.el index 8860a664bd7..7d44a1cec1d 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -3329,6 +3329,12 @@ If FILE is nil, check the current Info file." (or node (error "No index")) (Info-goto-node node))) +(defun info--ensure-not-in-directory-node () + (if (equal Info-current-file "dir") + (error (substitute-command-keys + (concat "The Info directory node has no index; " + "type \\[Info-menu] to select a manual"))))) + ;;;###autoload (defun Info-index (topic) "Look up a string TOPIC in the index for this manual and go to that entry. @@ -3342,15 +3348,13 @@ Give an empty topic name to go to the Index node itself." (Info-complete-menu-buffer (clone-buffer)) (Info-complete-nodes (Info-index-nodes)) (Info-history-list nil)) - (if (equal Info-current-file "dir") - (error "The Info directory node has no index; use m to select a manual")) + (info--ensure-not-in-directory-node) (unwind-protect (with-current-buffer Info-complete-menu-buffer (Info-goto-index) (completing-read "Index topic: " #'Info-complete-menu-item)) (kill-buffer Info-complete-menu-buffer))))) - (if (equal Info-current-file "dir") - (error "The Info directory node has no index; use m to select a manual")) + (info--ensure-not-in-directory-node) ;; Strip leading colon in topic; index format does not allow them. (if (and (stringp topic) (> (length topic) 0) @@ -3533,8 +3537,7 @@ search results." (Info-complete-menu-buffer (clone-buffer)) (Info-complete-nodes (Info-index-nodes)) (Info-history-list nil)) - (if (equal Info-current-file "dir") - (error "The Info directory node has no index; use m to select a manual")) + (info--ensure-not-in-directory-node) (unwind-protect (with-current-buffer Info-complete-menu-buffer (Info-goto-index) diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el index bc32b4f0737..b6545faf807 100644 --- a/lisp/international/ucs-normalize.el +++ b/lisp/international/ucs-normalize.el @@ -531,6 +531,7 @@ COMPOSITION-PREDICATE will be used to compose region." ;; -------------------------------------------------------------------------------- (defmacro ucs-normalize-string (ucs-normalize-region) + "Normalize string STR using the function UCS-NORMALIZE-REGION." `(with-temp-buffer (insert str) (,ucs-normalize-region (point-min) (point-max)) diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index 1dfeb79c172..f7655d2efc0 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -483,6 +483,7 @@ system, including many technical ones. Examples: ("\\rhd" ?▷) ("\\ll" ?≪) ("\\llcorner" ?⌞) + ("\\lll" ?⋘) ("\\lnapprox" ?⋦) ("\\lneq" ?≨) ("\\lneqq" ?≨) diff --git a/lisp/mouse.el b/lisp/mouse.el index e38a4f8a71a..f72ab4fc642 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1579,6 +1579,7 @@ its value is returned." ;; `category' property at PT while doing the (get-char-property ;; pt property w)! (or (and str + (< (cdr str) (length (car str))) (get-text-property (cdr str) property (car str))) ;; Mouse clicks in the fringe come with a position in ;; (nth 5). This is useful but is not exactly where we clicked, so diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index 86cf98004ba..5b850b258c7 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -222,25 +222,28 @@ and `goto-address-fontify-p'." ;;;###autoload (defun goto-address-at-point (&optional event) - "Send to the e-mail address or load the URL at point. -Send mail to address at point. See documentation for -`goto-address-find-address-at-point'. If no address is found -there, then load the URL at or before point." + "Compose a new message to the e-mail address or open URL at point. + +Compose message to address at point. See documentation for +`goto-address-find-address-at-point'. + +If no e-mail address is found at point, open the URL at or before +point using `browse-url'. With a prefix argument, open the URL +using `browse-url-secondary-browser-function' instead." (interactive (list last-input-event)) (save-excursion (if event (posn-set-point (event-end event))) (let ((address (save-excursion (goto-address-find-address-at-point)))) (if (and address - (save-excursion - (goto-char (previous-single-char-property-change - (point) 'goto-address nil - (line-beginning-position))) - (not (looking-at goto-address-url-regexp)))) - (compose-mail address) - (let ((url (browse-url-url-at-point))) - (if url - (browse-url url) - (error "No e-mail address or URL found"))))))) + (save-excursion + (goto-char (previous-single-char-property-change + (point) 'goto-address nil + (line-beginning-position))) + (not (looking-at goto-address-url-regexp)))) + (compose-mail address) + (if-let ((url (browse-url-url-at-point))) + (browse-url-button-open-url url) + (error "No e-mail address or URL found")))))) (defun goto-address-find-address-at-point () "Find e-mail address around or before point. diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el index ee52ed6e071..f7a2e425412 100644 --- a/lisp/net/sasl-scram-rfc.el +++ b/lisp/net/sasl-scram-rfc.el @@ -45,14 +45,21 @@ ;;; Generic for SCRAM-* +(defvar sasl-scram-gs2-header-function 'sasl-scram-construct-gs2-header + "Function to create GS2 header. +See https://www.rfc-editor.org/rfc/rfc5801#section-4.") + +(defun sasl-scram-construct-gs2-header (client) + ;; The "n," means the client doesn't support channel binding, and + ;; the trailing comma is included as per RFC 5801. + (let ((authzid (sasl-client-property client 'authenticator-name))) + (concat "n," (and authzid "a=") authzid ","))) + (defun sasl-scram-client-first-message (client _step) (let ((c-nonce (sasl-unique-id))) (sasl-client-set-property client 'c-nonce c-nonce)) (concat - ;; n = client doesn't support channel binding - "n," - ;; TODO: where would we get authorization id from? - "," + (funcall sasl-scram-gs2-header-function client) (sasl-scram--client-first-message-bare client))) (defun sasl-scram--client-first-message-bare (client) @@ -77,11 +84,11 @@ (c-nonce (sasl-client-property client 'c-nonce)) ;; no channel binding, no authorization id - (cbind-input "n,,")) + (cbind-input (funcall sasl-scram-gs2-header-function client))) (unless (string-prefix-p c-nonce nonce) (sasl-error "Invalid nonce from server")) (let* ((client-final-message-without-proof - (concat "c=" (base64-encode-string cbind-input) "," + (concat "c=" (base64-encode-string cbind-input t) "," "r=" nonce)) (password ;; TODO: either apply saslprep or disallow non-ASCII characters @@ -113,7 +120,7 @@ (client-proof (funcall string-xor client-key client-signature)) (client-final-message (concat client-final-message-without-proof "," - "p=" (base64-encode-string client-proof)))) + "p=" (base64-encode-string client-proof t)))) (sasl-client-set-property client 'auth-message auth-message) (sasl-client-set-property client 'salted-password salted-password) client-final-message))) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 5b2af7c6b21..0a8c574d84c 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -183,23 +183,32 @@ It must be supported by libarchive(3).") ;; The definition of `tramp-archive-file-name-regexp' contains calls ;; to `regexp-opt', which cannot be autoloaded while loading ;; loaddefs.el. So we use a macro, which is evaluated only when needed. -;; When tramp-archive.el is unloaded and reloaded, it gripes about -;; missing `tramp-archive{-compression]-suffixes'. We protect this. +;; Emacs 26 and earlier cannot use the autoload form +;; `tramp-compat-rx'. So we refrain from using `rx'. ;;;###autoload (progn (defmacro tramp-archive-autoload-file-name-regexp () "Regular expression matching archive file names." - `(tramp-compat-rx + (if (<= emacs-major-version 26) + '(concat + "\\`" "\\(" ".+" "\\." + ;; Default suffixes ... + (regexp-opt tramp-archive-suffixes) + ;; ... with compression. + "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" + "\\)" ;; \1 + "\\(" "/" ".*" "\\)" "\\'") ;; \2 + `(rx bos ;; This group is used in `tramp-archive-file-name-archive'. (group (+ nonl) ;; Default suffixes ... - "." ,(cons '| (bound-and-true-p tramp-archive-suffixes)) + "." (| ,@tramp-archive-suffixes) ;; ... with compression. - (? "." ,(cons '| (bound-and-true-p tramp-archive-compression-suffixes)))) + (? "." (| ,@tramp-archive-compression-suffixes))) ;; This group is used in `tramp-archive-file-name-localname'. (group "/" (* nonl)) - eos))) + eos)))) (put #'tramp-archive-autoload-file-name-regexp 'tramp-autoload t) diff --git a/lisp/outline.el b/lisp/outline.el index 2465a4963ab..86ac19aa415 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -1777,7 +1777,12 @@ With a prefix argument, show headings up to that LEVEL." (propertize (icon-string icon-name) 'mouse-face 'default 'follow-link 'mouse-face - 'keymap (define-keymap "<mouse-2>" #'outline-cycle))) + 'keymap (define-keymap + "<mouse-2>" #'outline-cycle + ;; Need to override the global binding + ;; `mouse-appearance-menu' with <down->: + "S-<down-mouse-1>" #'ignore + "S-<mouse-1>" #'outline-cycle-buffer))) (list 'outline-open (if outline--use-rtl 'outline-close-rtl 'outline-close)))))) @@ -1805,10 +1810,11 @@ With a prefix argument, show headings up to that LEVEL." (overlay-put o 'mouse-face 'highlight) (overlay-put o 'keymap (define-keymap "RET" #'outline-cycle - "<mouse-2>" #'outline-cycle)) - (overlay-put o 'help-echo (if (eq type 'close) - "Click to show" - "Click to hide"))) + "<mouse-2>" #'outline-cycle + ;; Need to override the global binding + ;; `mouse-appearance-menu' with <down->: + "S-<down-mouse-1>" #'ignore + "S-<mouse-1>" #'outline-cycle-buffer))) ('in-margins (overlay-put o 'before-string icon) (overlay-put o 'keymap (define-keymap "RET" #'outline-cycle))) diff --git a/lisp/paren.el b/lisp/paren.el index e2c060ceb96..1d7fb1c4625 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -410,6 +410,10 @@ It is the default value of `show-paren-data-function'." (line-end-position)))) (setq show-paren--context-overlay (make-overlay beg end))) (overlay-put show-paren--context-overlay 'display text) + ;; Use the (default very high) `show-paren-priority' ensuring that + ;; not other overlays shine through (bug#59527). + (overlay-put show-paren--context-overlay 'priority + show-paren-priority) (overlay-put show-paren--context-overlay 'face `(:box ( :line-width (1 . -1) diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 1aee1107e62..b722790334d 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -169,7 +169,7 @@ greater than this number." (defcustom antlr-indent-comment 'tab "Non-nil, if the indentation should touch lines in block comments. If nil, no continuation line of a block comment is changed. If t, they -are changed according to `c-indentation-line'. When not nil and not t, +are changed according to `c-indent-line'. When not nil and not t, they are only changed by \\[antlr-indent-command]." :type '(radio (const :tag "No" nil) (const :tag "Always" t) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el new file mode 100644 index 00000000000..fc35d9aedda --- /dev/null +++ b/lisp/progmodes/c-ts-mode.el @@ -0,0 +1,586 @@ +;;; c-ts-mode.el --- tree-sitter support for C and C++ -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author : Theodor Thornhill <theo@thornhill.no> +;; Maintainer : Theodor Thornhill <theo@thornhill.no> +;; Created : November 2022 +;; Keywords : c c++ cpp languages tree-sitter + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + + +;;; Commentary: +;; + +;;; Code: + +(require 'treesit) +(require 'rx) + +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-induce-sparse-tree "treesit.c") +(declare-function treesit-node-parent "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-end "treesit.c") +(declare-function treesit-node-child "treesit.c") +(declare-function treesit-node-child-by-field-name "treesit.c") +(declare-function treesit-node-type "treesit.c") + +(defcustom c-ts-mode-indent-offset 2 + "Number of spaces for each indentation step in `c-ts-mode'." + :version "29.1" + :type 'integer + :safe 'integerp + :group 'c) + +(defcustom c-ts-mode-indent-style 'gnu + "Style used for indentation. + +The selected style could be one of GNU, K&R, LINUX or BSD. If +one of the supplied styles doesn't suffice a function could be +set instead. This function is expected return a list that +follows the form of `treesit-simple-indent-rules'." + :version "29.1" + :type '(choice (symbol :tag "Gnu" 'gnu) + (symbol :tag "K&R" 'k&r) + (symbol :tag "Linux" 'linux) + (symbol :tag "BSD" 'bsd) + (function :tag "A function for user customized style" ignore)) + :group 'c) + +(defvar c-ts-mode--syntax-table + (let ((table (make-syntax-table))) + ;; Taken from the cc-langs version + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?% "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?\' "\"" table) + (modify-syntax-entry ?\240 "." table) + (modify-syntax-entry ?/ ". 124b" table) + (modify-syntax-entry ?* ". 23" table) + table) + "Syntax table for `c-ts-mode'.") + +(defun c-ts-mode--indent-styles (mode) + "Indent rules supported by `c-ts-mode'. +MODE is either `c' or `cpp'." + (let ((common + `(((parent-is "translation_unit") parent-bol 0) + ((node-is ")") parent 1) + ((node-is "]") parent-bol 0) + ((node-is "}") (and parent parent-bol) 0) + ((node-is "else") parent-bol 0) + ((node-is "case") parent-bol 0) + ((node-is "preproc_arg") no-indent) + ((and (parent-is "comment") comment-end) comment-start -1) + ((parent-is "comment") comment-start-skip 0) + ((node-is "labeled_statement") parent-bol 0) + ((parent-is "labeled_statement") parent-bol c-ts-mode-indent-offset) + ((match "preproc_ifdef" "compound_statement") point-min 0) + ((match "#endif" "preproc_ifdef") point-min 0) + ((match "preproc_if" "compound_statement") point-min 0) + ((match "#endif" "preproc_if") point-min 0) + ((match "preproc_function_def" "compound_statement") point-min 0) + ((match "preproc_call" "compound_statement") point-min 0) + ((parent-is "compound_statement") (and parent parent-bol) c-ts-mode-indent-offset) + ((parent-is "function_definition") parent-bol 0) + ((parent-is "conditional_expression") first-sibling 0) + ((parent-is "assignment_expression") parent-bol c-ts-mode-indent-offset) + ((parent-is "comma_expression") first-sibling 0) + ((parent-is "init_declarator") parent-bol c-ts-mode-indent-offset) + ((parent-is "parenthesized_expression") first-sibling 1) + ((parent-is "argument_list") first-sibling 1) + ((parent-is "parameter_list") first-sibling 1) + ((parent-is "binary_expression") parent 0) + ((query "(for_statement initializer: (_) @indent)") parent-bol 5) + ((query "(for_statement condition: (_) @indent)") parent-bol 5) + ((query "(for_statement update: (_) @indent)") parent-bol 5) + ((query "(call_expression arguments: (_) @indent)") parent c-ts-mode-indent-offset) + ((parent-is "call_expression") parent 0) + ((parent-is "enumerator_list") parent-bol c-ts-mode-indent-offset) + ((parent-is "field_declaration_list") parent-bol c-ts-mode-indent-offset) + ((parent-is "initializer_list") parent-bol c-ts-mode-indent-offset) + ((parent-is "if_statement") parent-bol c-ts-mode-indent-offset) + ((parent-is "for_statement") parent-bol c-ts-mode-indent-offset) + ((parent-is "while_statement") parent-bol c-ts-mode-indent-offset) + ((parent-is "switch_statement") parent-bol c-ts-mode-indent-offset) + ((parent-is "case_statement") parent-bol c-ts-mode-indent-offset) + ((parent-is "do_statement") parent-bol c-ts-mode-indent-offset) + ,@(when (eq mode 'cpp) + `(((node-is "field_initializer_list") parent-bol ,(* c-ts-mode-indent-offset 2))))))) + `((gnu + ;; Prepend rules to set highest priority + ((match "while" "do_statement") parent 0) + ,@common) + (k&r ,@common) + (linux ,@common) + (bsd + ((parent-is "if_statement") parent-bol 0) + ((parent-is "for_statement") parent-bol 0) + ((parent-is "while_statement") parent-bol 0) + ((parent-is "switch_statement") parent-bol 0) + ((parent-is "case_statement") parent-bol 0) + ((parent-is "do_statement") parent-bol 0) + ,@common)))) + +(defun c-ts-mode--set-indent-style (mode) + "Helper function to set indentation style. +MODE is either `c' or `cpp'." + (let ((style + (if (functionp c-ts-mode-indent-style) + (funcall c-ts-mode-indent-style) + (pcase c-ts-mode-indent-style + ('gnu (alist-get 'gnu (c-ts-mode--indent-styles mode))) + ('k&r (alist-get 'k&r (c-ts-mode--indent-styles mode))) + ('bsd (alist-get 'bsd (c-ts-mode--indent-styles mode))) + ('linux (alist-get 'linux (c-ts-mode--indent-styles mode))))))) + `((,mode ,@style)))) + +(defvar c-ts-mode--preproc-keywords + '("#define" "#if" "#ifdef" "#ifndef" + "#else" "#elif" "#endif" "#include") + "C/C++ keywords for tree-sitter font-locking.") + +(defun c-ts-mode--keywords (mode) + "C/C++ keywords for tree-sitter font-locking. +MODE is either `c' or `cpp'." + (let ((c-keywords + '("break" "case" "const" "continue" + "default" "do" "else" "enum" + "extern" "for" "goto" "if" + "long" "register" "return" "short" + "signed" "sizeof" "static" "struct" + "switch" "typedef" "union" "unsigned" + "volatile" "while"))) + (if (eq mode 'cpp) + (append c-keywords + '("and" "and_eq" "bitand" "bitor" + "catch" "class" "co_await" "co_return" + "co_yield" "compl" "concept" "consteval" + "constexpr" "constinit" "decltype" "delete" + "explicit" "final" "friend" "friend" + "mutable" "namespace" "new" "noexcept" + "not" "not_eq" "operator" "or" + "or_eq" "override" "private" "protected" + "public" "requires" "template" "throw" + "try" "typename" "using" "virtual" + "xor" "xor_eq")) + (append '("auto") c-keywords)))) + +(defvar c-ts-mode--operators + '("=" "-" "*" "/" "+" "%" "~" "|" "&" "^" "<<" ">>" "->" + "." "<" "<=" ">=" ">" "==" "!=" "!" "&&" "||" "-=" + "+=" "*=" "/=" "%=" "|=" "&=" "^=" ">>=" "<<=" "--" "++") + "C/C++ operators for tree-sitter font-locking.") + +(defun c-ts-mode--font-lock-settings (mode) + "Tree-sitter font-lock settings. +MODE is either `c' or `cpp'." + (treesit-font-lock-rules + :language mode + :feature 'comment + `((comment) @font-lock-comment-face + (comment) @contextual) + + :language mode + :feature 'preprocessor + `((preproc_directive) @font-lock-preprocessor-face + + (preproc_def + name: (identifier) @font-lock-variable-name-face) + + (preproc_ifdef + name: (identifier) @font-lock-variable-name-face) + + (preproc_function_def + name: (identifier) @font-lock-function-name-face) + + (preproc_params + (identifier) @font-lock-variable-name-face) + + (preproc_defined) @font-lock-preprocessor-face + (preproc_defined (identifier) @font-lock-variable-name-face) + [,@c-ts-mode--preproc-keywords] @font-lock-preprocessor-face) + + :language mode + :feature 'constant + `((true) @font-lock-constant-face + (false) @font-lock-constant-face + (null) @font-lock-constant-face + ,@(when (eq mode 'cpp) + '((this) @font-lock-constant-face))) + + :language mode + :feature 'keyword + `([,@(c-ts-mode--keywords mode)] @font-lock-keyword-face + ,@(when (eq mode 'cpp) + '((auto) @font-lock-keyword-face))) + + :language mode + :feature 'operator + `([,@c-ts-mode--operators] @font-lock-operator-face + "!" @font-lock-negation-char-face) + + :language mode + :feature 'string + `((string_literal) @font-lock-string-face + (system_lib_string) @font-lock-string-face) + + :language mode + :feature 'literal + `((number_literal) @font-lock-number-face + (char_literal) @font-lock-constant-face) + + :language mode + :feature 'type + `((primitive_type) @font-lock-type-face + (type_identifier) @font-lock-type-face + (sized_type_specifier) @font-lock-type-face + ,@(when (eq mode 'cpp) + '((type_qualifier) @font-lock-type-face + + (qualified_identifier + scope: (namespace_identifier) @font-lock-type-face) + + (operator_cast) type: (type_identifier) @font-lock-type-face))) + + :language mode + :feature 'definition + ;; Highlights identifiers in declarations. + `((declaration + declarator: (_) @c-ts-mode--fontify-declarator) + + (field_declaration + declarator: (_) @c-ts-mode--fontify-declarator) + + (function_definition + declarator: (_) @c-ts-mode--fontify-declarator)) + + ;; Should we highlight identifiers in the parameter list? + ;; (parameter_declaration + ;; declarator: (_) @c-ts-mode--fontify-declarator)) + + :language mode + :feature 'assignment + ;; TODO: Recursively highlight identifiers in parenthesized + ;; expressions, see `c-ts-mode--fontify-struct-declarator' for + ;; inspiration. + '((assignment_expression + left: (identifier) @font-lock-variable-name-face) + (assignment_expression + left: (field_expression field: (_) @font-lock-property-face)) + (assignment_expression + left: (pointer_expression + (identifier) @font-lock-variable-name-face)) + (assignment_expression + left: (subscript_expression + (identifier) @font-lock-variable-name-face)) + (init_declarator declarator: (_) @c-ts-mode--fontify-declarator)) + + :language mode + :feature 'function + '((call_expression + function: (identifier) @font-lock-function-name-face)) + + :language mode + :feature 'variable + '((identifier) @c-ts-mode--fontify-variable) + + :language mode + :feature 'label + '((labeled_statement + label: (statement_identifier) @font-lock-constant-face)) + + :language mode + :feature 'error + '((ERROR) @c-ts-fontify-error) + + :feature 'escape-sequence + :language mode + :override t + '((escape_sequence) @font-lock-escape-face) + + :language mode + :feature 'property + '((field_identifier) @font-lock-property-face + (enumerator + name: (identifier) @font-lock-property-face)) + + :language mode + :feature 'bracket + '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) + + :language mode + :feature 'delimiter + '((["," ":" ";"]) @font-lock-delimiter-face) + + :language mode + :feature 'emacs-devel + :override t + '(((call_expression + (call_expression function: (identifier) @fn) + @c-ts-mode--fontify-defun) + (:match "^DEFUN$" @fn))))) + +(defun c-ts-mode--fontify-declarator (node override start end &rest args) + "Fontify a declarator (whatever under the \"declarator\" field). +For NODE, OVERRIDE, START, END, and ARGS, see +`treesit-font-lock-rules'." + (pcase (treesit-node-type node) + ((or "attributed_declarator" "parenthesized_declarator") + (apply #'c-ts-mode--fontify-declarator + (treesit-node-child node 0 t) override start end args)) + ("pointer_declarator" + (apply #'c-ts-mode--fontify-declarator + (treesit-node-child node -1) override start end args)) + ((or "function_declarator" "array_declarator" "init_declarator") + (apply #'c-ts-mode--fontify-declarator + (treesit-node-child-by-field-name node "declarator") + override start end args)) + ((or "identifier" "field_identifier") + (treesit-fontify-with-override + (max (treesit-node-start node) start) + (min (treesit-node-end node) end) + (pcase (treesit-node-type (treesit-node-parent node)) + ("function_declarator" 'font-lock-function-name-face) + (_ 'font-lock-variable-name-face)) + override)))) + +(defun c-ts-mode--fontify-variable (node override start end &rest _) + "Fontify an identifier node. +Fontify it if NODE is not a function identifier. For NODE, +OVERRIDE, START, END, and ARGS, see `treesit-font-lock-rules'." + (when (not (equal (treesit-node-type + (treesit-node-parent node)) + "call_expression")) + (treesit-fontify-with-override + (max (treesit-node-start node) start) + (min (treesit-node-end node) end) + 'font-lock-variable-name-face + override))) + +(defun c-ts-mode--fontify-defun (node override start end &rest _) + "Correctly fontify the DEFUN macro. +For NODE, OVERRIDE, START, and END, see +`treesit-font-lock-rules'. The captured NODE is a +call_expression where DEFUN is the function. + +This function corrects the fontification on the colon in +\"doc:\", and the parameter list." + (let* ((parent (treesit-node-parent node)) + ;; ARG-LIST-1 and 2 are like this: + ;; + ;; DEFUN (ARG-LIST-1) + ;; (ARG-LIST-2) + (arg-list-1 (treesit-node-children + (treesit-node-child-by-field-name + node "arguments"))) + ;; ARG-LIST-2 is the + (arg-list-2 (treesit-node-children + (treesit-node-child-by-field-name + parent "arguments") t))) + ;; Fix the colon. + (dolist (node arg-list-1) + (when (equal (treesit-node-text node t) ":") + (treesit-fontify-with-override + (treesit-node-start node) (treesit-node-end node) + 'default override))) + ;; Fix the parameter list. + (while arg-list-2 + (let ((type (and arg-list-2 (pop arg-list-2))) + (arg (and arg-list-2 (pop arg-list-2)))) + (when type + (treesit-fontify-with-override + (max start (treesit-node-start type)) + (min end (treesit-node-end type)) + 'font-lock-type-face override)) + (when arg + (treesit-fontify-with-override + (max start (treesit-node-start arg)) + (min end (treesit-node-end arg)) + 'default override)))))) + +(defun c-ts-fontify-error (node override start end &rest _) + "Fontify the error nodes. +For NODE, OVERRIDE, START, and END, see +`treesit-font-lock-rules'." + (let ((parent (treesit-node-parent node)) + (child (treesit-node-child node 0))) + (treesit-fontify-with-override + (max start (treesit-node-start node)) + (min end (treesit-node-end node)) + (cond + ;; This matches the case MACRO(struct a, b, c) + ;; where struct is seen as error. + ((and (equal (treesit-node-type child) "identifier") + (equal (treesit-node-type parent) "argument_list") + (member (treesit-node-text child) + '("struct" "long" "short" "enum" "union"))) + 'font-lock-keyword-face) + (t 'font-lock-warning-face)) + override))) + +(defun c-ts-mode--imenu-1 (node) + "Helper for `c-ts-mode--imenu'. +Find string representation for NODE and set marker, then recurse +the subtrees." + (let* ((ts-node (car node)) + (subtrees (mapcan #'c-ts-mode--imenu-1 (cdr node))) + (name (when ts-node + (treesit-node-text + (pcase (treesit-node-type ts-node) + ("function_definition" + (treesit-node-child-by-field-name + (treesit-node-child-by-field-name + ts-node "declarator") + "declarator")) + ("declaration" + (let ((child (treesit-node-child ts-node -1 t))) + (pcase (treesit-node-type child) + ("identifier" child) + (_ (treesit-node-child-by-field-name + child "declarator"))))) + ("struct_specifier" + (treesit-node-child-by-field-name + ts-node "name")))))) + (marker (when ts-node + (set-marker (make-marker) + (treesit-node-start ts-node))))) + (cond + ;; A struct_specifier could be inside a parameter list, another + ;; struct definition, a variable declaration, a function + ;; declaration. In those cases we don't include it. + ((string-match-p + (rx (or "parameter_declaration" "field_declaration" + "declaration" "function_definition")) + (or (treesit-node-type (treesit-node-parent ts-node)) + "")) + nil) + ;; Ignore function local variable declarations. + ((and (equal (treesit-node-type ts-node) "declaration") + (not (equal (treesit-node-type (treesit-node-parent ts-node)) + "translation_unit"))) + nil) + ((or (null ts-node) (null name)) subtrees) + (subtrees + `((,name ,(cons name marker) ,@subtrees))) + (t + `((,name . ,marker)))))) + +(defun c-ts-mode--imenu () + "Return Imenu alist for the current buffer." + (let* ((node (treesit-buffer-root-node)) + (func-tree (treesit-induce-sparse-tree + node "^function_definition$" nil 1000)) + (var-tree (treesit-induce-sparse-tree + node "^declaration$" nil 1000)) + (struct-tree (treesit-induce-sparse-tree + node "^struct_specifier$" nil 1000)) + (func-index (c-ts-mode--imenu-1 func-tree)) + (var-index (c-ts-mode--imenu-1 var-tree)) + (struct-index (c-ts-mode--imenu-1 struct-tree))) + (append + (when struct-index `(("Struct" . ,struct-index))) + (when var-index `(("Variable" . ,var-index))) + (when func-index `(("Function" . ,func-index)))))) + +;;;###autoload +(define-derived-mode c-ts-mode--base-mode prog-mode "C" + "Major mode for editing C, powered by tree-sitter." + :syntax-table c-ts-mode--syntax-table + + ;; Navigation. + (setq-local treesit-defun-type-regexp + (rx (or "specifier" + "definition"))) + + ;; Indent. + (when (eq c-ts-mode-indent-style 'linux) + (setq-local indent-tabs-mode t)) + + ;; Electric + (setq-local electric-indent-chars + (append "{}():;," electric-indent-chars)) + + ;; Imenu. + (setq-local imenu-create-index-function #'c-ts-mode--imenu) + (setq-local which-func-functions nil) + + (setq-local treesit-font-lock-feature-list + '(( comment constant keyword literal preprocessor string) + ( assignment definition label property type) + ( delimiter error escape-sequence function + operator variable bracket)))) + +;;;###autoload +(define-derived-mode c-ts-mode c-ts-mode--base-mode "C" + "Major mode for editing C, powered by tree-sitter." + :group 'c + + (unless (treesit-ready-p 'c) + (error "Tree-sitter for C isn't available")) + + (treesit-parser-create 'c) + + ;; Comments. + (setq-local comment-start "/* ") + (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *") + (setq-local comment-end " */") + (setq-local treesit-comment-start (rx "/" (or (+ "/") (+ "*")))) + (setq-local treesit-comment-end (rx (+ (or "*")) "/")) + + (setq-local treesit-simple-indent-rules + (c-ts-mode--set-indent-style 'c)) + + ;; Font-lock. + (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c)) + + (treesit-major-mode-setup)) + +;;;###autoload +(define-derived-mode c++-ts-mode c-ts-mode--base-mode "C++" + "Major mode for editing C++, powered by tree-sitter." + :group 'c++ + + (unless (treesit-ready-p 'cpp) + (error "Tree-sitter for C++ isn't available")) + + ;; Comments. + (setq-local comment-start "// ") + (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *") + (setq-local comment-end "") + + (treesit-parser-create 'cpp) + + (setq-local treesit-simple-indent-rules + (c-ts-mode--set-indent-style 'cpp)) + + ;; Font-lock. + (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'cpp)) + + (treesit-major-mode-setup)) + +(provide 'c-ts-mode) + +;;; c-ts-mode.el ends here diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 7e6dd431756..11ddb39ed91 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -4017,7 +4017,7 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (t from)))))) (defun c-remove-stale-state-cache (start-point here pps-point) - ;; Remove stale entries from the `c-cache-state', i.e. those which will + ;; Remove stale entries from the `c-state-cache', i.e. those which will ;; not be in it when it is amended for position HERE. This may involve ;; replacing a CONS element for a brace pair containing HERE with its car. ;; Additionally, the "outermost" open-brace entry before HERE will be @@ -4951,30 +4951,31 @@ comment at the start of cc-engine.el for more info." "\\w\\|\\s_\\|\\s\"\\|\\s|" "\\w\\|\\s_\\|\\s\"")) -(defun c-forward-over-token (&optional balanced) +(defun c-forward-over-token (&optional balanced limit) "Move forward over a token. Return t if we moved, nil otherwise (i.e. we were at EOB, or a non-token or BALANCED is non-nil and we can't move). If we are at syntactic whitespace, move over this in place of a token. If BALANCED is non-nil move over any balanced parens we are at, and never move -out of an enclosing paren." +out of an enclosing paren. LIMIT is the limit to where we might move to." (let ((jump-syntax (if balanced c-jump-syntax-balanced c-jump-syntax-unbalanced)) - (here (point))) + (here (point)) + (limit (or limit (point-max)))) (condition-case nil (cond ((/= (point) - (progn (c-forward-syntactic-ws) (point))) + (progn (c-forward-syntactic-ws limit) (point))) ;; If we're at whitespace, count this as the token. t) ((eobp) nil) ((looking-at jump-syntax) - (goto-char (scan-sexps (point) 1)) + (goto-char (min limit (scan-sexps (point) 1))) t) ((looking-at c-nonsymbol-token-regexp) - (goto-char (match-end 0)) + (goto-char (min (match-end 0) limit)) t) ((save-restriction (widen) @@ -10103,7 +10104,7 @@ This function might do hidden buffer changes." ;; Specifically it is nil, or a three element list (A B C) where C is t ;; when context is '<> and the "identifier" is a found type, B is t when a ;; `c-typedef-kwds' ("typedef") is present, and A is t when some other - ;; `c-typedef-declkwds' (e.g. class, struct, enum) specifier is present. + ;; `c-typedef-decl-kwds' (e.g. class, struct, enum) specifier is present. ;; I.e., (some of) the declared identifier(s) are types. ;; ;; The third element of the return value is non-nil when the declaration @@ -11076,8 +11077,9 @@ This function might do hidden buffer changes." at-decl-start)) (let ((space-before-id (save-excursion - (goto-char name-start) - (or (bolp) (memq (char-before) '(?\ ?\t))))) + (goto-char id-start) ; Position of "*". + (and (> (skip-chars-forward "* \t\n\r") 0) + (memq (char-before) '(?\ ?\t ?\n ?\r))))) (space-after-type (save-excursion (goto-char type-start) @@ -11087,6 +11089,8 @@ This function might do hidden buffer changes." (memq (char-after) '(?\ ?\t))))))) (when (not (eq (not space-before-id) (not space-after-type))) + (when (eq at-type 'maybe) + (setq unsafe-maybe t)) (setq maybe-expression t) (throw 'at-decl-or-cast t))))) @@ -15518,7 +15522,7 @@ Cannot combine absolute offsets %S and %S in `add' method" (defun c-get-syntactic-indentation (langelems) ;; Calculate the syntactic indentation from a syntactic description - ;; as returned by `c-guess-syntax'. + ;; as returned by `c-guess-basic-syntax'. ;; ;; Note that topmost-intro always has an anchor position at bol, for ;; historical reasons. It's often used together with other symbols diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 561aa0f7e5b..581685cad70 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1188,7 +1188,7 @@ definition, or nil if the language doesn't have any." t (if (c-lang-const c-opt-cpp-macro-define) (concat (c-lang-const c-anchored-cpp-prefix) (c-lang-const c-opt-cpp-macro-define) - "[ \t]+\\(\\sw\\|_\\)+\\([^(a-zA-Z0-9_]\\|$\\)"))) + "[ \t]+[a-zA-Z0-9_]+\\([^(a-zA-Z0-9_]\\|$\\)"))) (c-lang-defconst c-cpp-expr-directives "List of cpp directives (without the prefix) that are followed by an @@ -1440,7 +1440,7 @@ since CC Mode treats every identifier as an expression." (c-lang-defconst c-overloadable-operators "List of the operators that are overloadable, in their \"identifier -form\". See also `c-op-identifier-prefix'." +form\". See also `c-opt-op-identifier-prefix'." t nil c++ '("new" "delete" ;; Can be followed by "[]" but we ignore that. "+" "-" "*" "/" "%" @@ -2526,7 +2526,7 @@ their matching \"in\" syntactic symbols.") (c-lang-const c-brace-list-decl-kwds))) (c-lang-defconst c-defun-type-name-decl-key - ;; Regexp matching a keyword in `c-defun-name-decl-kwds'. + ;; Regexp matching a keyword in `c-defun-type-name-decl-kwds'. t (c-make-keywords-re t (c-lang-const c-defun-type-name-decl-kwds))) (c-lang-defvar c-defun-type-name-decl-key (c-lang-const c-defun-type-name-decl-key)) @@ -2620,7 +2620,7 @@ type." (c-lang-defconst c-equals-nontype-decl-key ;; An unadorned regular expression which matches any member of - ;; `c-equals-decl-kwds', or nil if such don't exist in the current language. + ;; `c-equals-nontype-decl-kwds', or nil if such don't exist in the current language. t (when (c-lang-const c-equals-nontype-decl-kwds) (c-make-keywords-re nil (c-lang-const c-equals-nontype-decl-kwds)))) (c-lang-defvar c-equals-nontype-decl-key @@ -4486,7 +4486,7 @@ accomplish that conveniently." (error (if current-var (message - "Eval error in the `c-lang-defvar' or `c-lang-setver' for `%s' (source eval): %S" + "Eval error in the `c-lang-defvar' or `c-lang-setvar' for `%s' (source eval): %S" current-var err) (signal (car err) (cdr err))))))) )) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 5a610253e01..6a2c2f2911e 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1391,7 +1391,7 @@ Note that the style variables are always made local to the buffer." (defvar c-bc-changed-stringiness nil) ;; Non-nil when, in a before-change function, the deletion of a range of text ;; will change the "stringiness" of the subsequent text. Only used when -;; `c-multiline-sting-start-char' is a non-nil value which isn't a character. +;; `c-multiline-string-start-char' is a non-nil value which isn't a character. (defun c-remove-string-fences (&optional here) ;; The character after HERE (default point) is either a string delimiter or @@ -1713,7 +1713,7 @@ position of `after-change-functions'.") ;; ;; This function is called exclusively as an after-change function via ;; `c-before-font-lock-functions'. In C++ Mode, it should come before - ;; `c-after-change-unmark-raw-strings' in that lang variable. + ;; `c-after-change-unmark-ml-strings' in that lang variable. (let (lit-start ; Don't calculate this till we have to. lim) (when @@ -2482,7 +2482,8 @@ with // and /*, not more generic line and block comments." (let* ((lim1 (save-excursion (and (c-beginning-of-macro) (progn (c-end-of-macro) (point))))) - (decl-res (c-forward-declarator))) + (lim+ (c-determine-+ve-limit 200)) + (decl-res (c-forward-declarator lim+))) (if (or (cadr (cddr (cddr decl-res))) ; We scanned an arglist. (and (eq (char-after) ?\() ; Move over a non arglist (...). (prog1 (c-go-list-forward) @@ -2499,7 +2500,7 @@ with // and /*, not more generic line and block comments." (c-backward-syntactic-ws lim1) (eq (char-before) ?\()) (c-fl-decl-end (1- (point)))) - (c-forward-over-token) + (c-forward-over-token nil lim+) ; The , or ) after the declarator. (point)) (if (progn (c-forward-syntactic-ws) (not (eobp))) diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el new file mode 100644 index 00000000000..a544a4b5cbd --- /dev/null +++ b/lisp/progmodes/csharp-mode.el @@ -0,0 +1,988 @@ +;;; csharp-mode.el --- Support for editing C# -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author : Theodor Thornhill <theo@thornhill.no> +;; Jostein Kjønigsen <jostein@kjonigsen.net> +;; Maintainer : Theodor Thornhill <theo@thornhill.no> +;; Jostein Kjønigsen <jostein@kjonigsen.net> +;; Created : September 2022 +;; Keywords : c# languages oop + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Support for editing C#. + +;;; Code: + +(require 'compile) +(require 'cc-mode) +(require 'cc-langs) +(require 'treesit) + +(eval-when-compile + (require 'cc-fonts)) + +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-induce-sparse-tree "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-child-by-field-name "treesit.c") + +(defgroup csharp nil + "Major mode for editing C# code." + :group 'prog-mode) + +(eval-and-compile + (defconst csharp--regex-identifier + "[A-Za-z][A-Za-z0-9_]*" + "Regex describing an identifier in C#.") + + (defconst csharp--regex-identifier-matcher + (concat "\\(" csharp--regex-identifier "\\)") + "Regex matching an identifier in C#.") + + (defconst csharp--regex-type-name + "[A-Z][A-Za-z0-9_]*" + "Regex describing a type identifier in C#.") + + (defconst csharp--regex-type-name-matcher + (concat "\\(" csharp--regex-type-name "\\)") + "Regex matching a type identifier in C#.") + + (defconst csharp--regex-using-or-namespace + (concat "^using" "\\|" "namespace" + "\\s *" + csharp--regex-type-name-matcher) + "Regex matching identifiers after a using or namespace + declaration.")) + +(eval-and-compile + (c-add-language 'csharp-mode 'java-mode) + + (defun csharp--make-mode-syntax-table () + (let ((table (make-syntax-table))) + (c-populate-syntax-table table) + (modify-syntax-entry ?@ "_" table) + table)) + (defvar csharp--make-mode-syntax-table #'csharp--make-mode-syntax-table + "Workaround for Emacs bug#57065.")) + +(c-lang-defconst c-make-mode-syntax-table + csharp #'csharp--make-mode-syntax-table) + +(c-lang-defconst c-identifier-syntax-modifications + csharp (append '((?@ . "w")) + (c-lang-const c-identifier-syntax-modifications))) + +(c-lang-defconst c-symbol-start + csharp (concat "[" c-alpha "_@]")) + +(c-lang-defconst c-opt-type-suffix-key + csharp (concat "\\(\\[" (c-lang-const c-simple-ws) "*\\]\\|\\?\\)")) + +(c-lang-defconst c-identifier-ops + csharp '((left-assoc "."))) + +(c-lang-defconst c-overloadable-operators + csharp '("+" "-" "*" "/" "%" "&" "|" "^" "<<" ">>" "==" + "!=" ">" "<" ">=" "<=")) + +(c-lang-defconst c-multiline-string-start-char + csharp ?@) + +(c-lang-defconst c-ml-string-opener-re + ;; "\\(\\(?:@\\$?\\)\\(\"\\)\\)" + csharp + (rx + (group + (or "@" "@$") + (group "\"")))) + +(c-lang-defconst c-ml-string-max-opener-len + csharp 3) + +(c-lang-defconst c-ml-string-max-closer-len + csharp 2) + +(c-lang-defconst c-ml-string-any-closer-re + ;; "\\(?:\"\"\\)*\\(\\(\"\\)\\)\\(?:[^\"]\\|\\'\\)" + csharp + (rx + (seq + (zero-or-more "\"\"") + (group + (group "\"")) + (or (not (any "\"")) eos)))) + +(c-lang-defconst c-ml-string-back-closer-re + ;; "\\(?:\\`\\|[^\"]\\)\"*" + csharp + (rx + (seq + (or bos + (not (any "\""))) + (zero-or-more "\"")))) + +(c-lang-defconst c-type-prefix-kwds + csharp '("class" "interface" "struct")) + +(c-lang-defconst c-class-decl-kwds + csharp '("class" "interface" "struct")) + +;;; Keyword lists + +(c-lang-defconst c-primitive-type-kwds + csharp '("bool" "byte" "sbyte" "char" "decimal" "double" "float" "int" "uint" + "long" "ulong" "short" "ushort" "void" "object" "string" "var")) + +(c-lang-defconst c-other-decl-kwds + csharp nil) + +(c-lang-defconst c-type-list-kwds + csharp nil) + +(c-lang-defconst c-other-block-decl-kwds + csharp nil) + +(c-lang-defconst c-return-kwds + csharp '("return")) + +(c-lang-defconst c-typedef-kwds + csharp nil) + +(c-lang-defconst c-typeof-kwds + csharp '("typeof" "is" "as")) + +(c-lang-defconst c-type-modifier-prefix-kwds + csharp '("volatile")) + +(c-lang-defconst c-type-modifier-kwds + csharp '("readonly" "new")) + +(c-lang-defconst c-brace-list-decl-kwds + csharp '("enum" "new")) + +(c-lang-defconst c-recognize-post-brace-list-type-p + csharp t) + +(c-lang-defconst c-ref-list-kwds + csharp nil) + +(c-lang-defconst c-using-kwds + csharp '("using")) + +(c-lang-defconst c-equals-type-clause-kwds + csharp '("using")) + +(defun csharp-at-vsemi-p (&optional pos) + (if pos (goto-char pos)) + (save-excursion + (beginning-of-line) + (c-forward-syntactic-ws) + (looking-at "using\\s *("))) + +(c-lang-defconst c-at-vsemi-p-fn + csharp 'csharp-at-vsemi-p) + +(defun csharp-vsemi-status-unknown () t) + +(c-lang-defconst c-vsemi-status-unknown-p-fn + csharp 'csharp-vsemi-status-unknown-p) + + +(c-lang-defconst c-modifier-kwds + csharp '("abstract" "default" "final" "native" "private" "protected" + "public" "partial" "internal" "readonly" "static" "event" "transient" + "volatile" "sealed" "ref" "out" "virtual" "implicit" "explicit" + "fixed" "override" "params" "async" "await" "extern" "unsafe" + "get" "set" "this" "const" "delegate")) + +(c-lang-defconst c-other-kwds + csharp '("select" "from" "where" "join" "in" "on" "equals" "into" + "orderby" "ascending" "descending" "group" "when" + "let" "by" "namespace")) + +(c-lang-defconst c-colon-type-list-kwds + csharp '("class" "struct" "interface")) + +(c-lang-defconst c-block-stmt-1-kwds + csharp '("do" "else" "finally" "try")) + +(c-lang-defconst c-block-stmt-1-2-kwds + csharp '("try")) + +(c-lang-defconst c-block-stmt-2-kwds + csharp '("for" "if" "switch" "while" "catch" "foreach" "fixed" "checked" + "unchecked" "using" "lock")) + +(c-lang-defconst c-simple-stmt-kwds + csharp '("break" "continue" "goto" "throw" "return" "yield")) + +(c-lang-defconst c-constant-kwds + csharp '("true" "false" "null" "value")) + +(c-lang-defconst c-primary-expr-kwds + csharp '("this" "base" "operator")) + +(c-lang-defconst c-inexpr-class-kwds + csharp nil) + +(c-lang-defconst c-class-decl-kwds + csharp '("class" "struct" "interface")) + +(c-lang-defconst c-std-abbrev-keywords + csharp (append (c-lang-const c-std-abbrev-keywords) '("catch" "finally"))) + +(c-lang-defconst c-decl-prefix-re + csharp "\\([{}(;,<]+\\)") + +(c-lang-defconst c-recognize-typeless-decls + csharp t) + +(c-lang-defconst c-recognize-<>-arglists + csharp t) + +(c-lang-defconst c-opt-cpp-prefix + csharp "\\s *#\\s *") + +(c-lang-defconst c-opt-cpp-macro-define + csharp (if (c-lang-const c-opt-cpp-prefix) + "define")) + +(c-lang-defconst c-cpp-message-directives + csharp '("error" "warning" "region")) + +(c-lang-defconst c-cpp-expr-directives + csharp '("if" "elif")) + +(c-lang-defconst c-other-op-syntax-tokens + csharp (append '("#") + (c-lang-const c-other-op-syntax-tokens))) + +(c-lang-defconst c-line-comment-starter + csharp "//") + +(c-lang-defconst c-doc-comment-start-regexp + csharp "///") + +(c-add-style "csharp" + '("java" + (c-basic-offset . 4) + (c-comment-only-line-offset . (0 . 0)) + (c-offsets-alist . ((inline-open . 0) + (arglist-intro . +) + (arglist-close . 0) + (inexpr-class . 0) + (case-label . +) + (cpp-macro . c-lineup-dont-change) + (substatement-open . 0))))) + +(eval-and-compile + (unless (or (stringp c-default-style) + (assoc 'csharp-mode c-default-style)) + (setq c-default-style + (cons '(csharp-mode . "csharp") + c-default-style)))) + +(defun csharp--color-forwards (font-lock-face) + (let (id-beginning) + (goto-char (match-beginning 0)) + (forward-word) + (while (and (not (or (eq (char-after) ?\;) + (eq (char-after) ?\{))) + (progn + (forward-char) + (c-forward-syntactic-ws) + (setq id-beginning (point)) + (> (skip-chars-forward + (c-lang-const c-symbol-chars)) + 0)) + (not (get-text-property (point) 'face))) + (c-put-font-lock-face id-beginning (point) font-lock-face) + (c-forward-syntactic-ws)))) + +(c-lang-defconst c-basic-matchers-before + csharp `( + ;; Warning face on unclosed strings + ,@(if (version< emacs-version "27.0") + ;; Taken from 26.1 branch + `(,(c-make-font-lock-search-function + (concat ".\\(" c-string-limit-regexp "\\)") + '((c-font-lock-invalid-string)))) + `(("\\s|" 0 font-lock-warning-face t nil))) + + ;; Invalid single quotes + c-font-lock-invalid-single-quotes + + ;; Keyword constants + ,@(when (c-lang-const c-constant-kwds) + (let ((re (c-make-keywords-re nil (c-lang-const c-constant-kwds)))) + `((eval . (list ,(concat "\\<\\(" re "\\)\\>") + 1 c-constant-face-name))))) + + ;; Keywords except the primitive types. + ,`(,(concat "\\<" (c-lang-const c-regular-keywords-regexp)) + 1 font-lock-keyword-face) + + ;; Chained identifiers in using/namespace statements + ,`(,(c-make-font-lock-search-function + csharp--regex-using-or-namespace + `((csharp--color-forwards font-lock-variable-name-face) + nil + (goto-char (match-end 0))))) + + + ;; Negation character + (eval . (list "\\(!\\)[^=]" 1 c-negation-char-face-name)) + + ;; Types after 'new' + (eval . (list (concat "\\<new\\> *" csharp--regex-type-name-matcher) + 1 font-lock-type-face)) + + ;; Single identifier in attribute + (eval . (list (concat "\\[" csharp--regex-type-name-matcher "\\][^;]") + 1 font-lock-variable-name-face t)) + + ;; Function names + (eval . (list "\\([A-Za-z0-9_]+\\)\\(<[a-zA-Z0-9, ]+>\\)?(" + 1 font-lock-function-name-face)) + + ;; Nameof + (eval . (list (concat "\\(\\<nameof\\>\\) *(") + 1 font-lock-function-name-face)) + + (eval . (list (concat "\\<nameof\\> *( *" + csharp--regex-identifier-matcher + " *) *") + 1 font-lock-variable-name-face)) + + ;; Catch statements with type only + (eval . (list (concat "\\<catch\\> *( *" + csharp--regex-type-name-matcher + " *) *") + 1 font-lock-type-face)) + )) + +(c-lang-defconst c-basic-matchers-after + csharp (append + ;; Merge with cc-mode defaults - enables us to add more later + (c-lang-const c-basic-matchers-after))) + +(defcustom csharp-codedoc-tag-face 'c-doc-markup-face-name + "Face to be used on the codedoc docstring tags. + +Should be one of the font lock faces, such as +`font-lock-variable-name-face' and friends. + +Needs to be set before `csharp-mode' is loaded, because of +compilation and evaluation time conflicts." + :type 'symbol) + +(defcustom csharp-font-lock-extra-types + (list csharp--regex-type-name) + (c-make-font-lock-extra-types-blurb "C#" "csharp-mode" (concat)) + :type 'c-extra-types-widget + :group 'c) + +(defconst csharp-font-lock-keywords-1 (c-lang-const c-matchers-1 csharp) + "Minimal font locking for C# mode.") + +(defconst csharp-font-lock-keywords-2 (c-lang-const c-matchers-2 csharp) + "Fast normal font locking for C# mode.") + +(defconst csharp-font-lock-keywords-3 (c-lang-const c-matchers-3 csharp) + "Accurate normal font locking for C# mode.") + +(defvar csharp-font-lock-keywords csharp-font-lock-keywords-3 + "Default expressions to highlight in C# mode.") + +(defun csharp-font-lock-keywords-2 () + (c-compose-keywords-list csharp-font-lock-keywords-2)) +(defun csharp-font-lock-keywords-3 () + (c-compose-keywords-list csharp-font-lock-keywords-3)) +(defun csharp-font-lock-keywords () + (c-compose-keywords-list csharp-font-lock-keywords)) + +;;; Doc comments + +(defconst codedoc-font-lock-doc-comments + ;; Most of this is taken from the javadoc example, however, we don't use the + ;; '@foo' syntax, so I removed that. Supports the XML tags only + `((,(concat "</?\\sw" ; XML tags. + "\\(" + (concat "\\sw\\|\\s \\|[=\n\r*.:]\\|" + "\"[^\"]*\"\\|'[^']*'") + "\\)*/?>") + 0 ,csharp-codedoc-tag-face prepend nil) + ;; ("\\([a-zA-Z0-9_]+\\)=" 0 font-lock-variable-name-face prepend nil) + ;; ("\".*\"" 0 font-lock-string-face prepend nil) + ("&\\(\\sw\\|[.:]\\)+;" ; XML entities. + 0 ,csharp-codedoc-tag-face prepend nil))) + +(defconst codedoc-font-lock-keywords + `((,(lambda (limit) + (c-font-lock-doc-comments "///" limit + codedoc-font-lock-doc-comments))))) + +;;; End of doc comments + +;;; Adding syntax constructs + +(advice-add 'c-looking-at-inexpr-block + :around #'csharp-looking-at-inexpr-block) + +(defun csharp-looking-at-inexpr-block (orig-fun &rest args) + (let ((res (csharp-at-lambda-header))) + (if res + res + (apply orig-fun args)))) + +(defun csharp-at-lambda-header () + (save-excursion + (c-backward-syntactic-ws) + (unless (bobp) + (backward-char) + (c-safe (goto-char (scan-sexps (point) -1))) + (when (or (looking-at "([[:alnum:][:space:]_,]*)[ \t\n]*=>[ \t\n]*{") + (looking-at "[[:alnum:]_]+[ \t\n]*=>[ \t\n]*{")) + ;; If we are at a C# lambda header + (cons 'inexpr (point)))))) + +(advice-add 'c-guess-basic-syntax + :around #'csharp-guess-basic-syntax) + +(defun csharp-guess-basic-syntax (orig-fun &rest args) + (cond + (;; Attributes + (save-excursion + (goto-char (c-point 'iopl)) + (and + (eq (char-after) ?\[) + (save-excursion + (c-go-list-forward) + (and (eq (char-before) ?\]) + (not (eq (char-after) ?\;)))))) + `((annotation-top-cont ,(c-point 'iopl)))) + + ((and + ;; Heuristics to find object initializers + (save-excursion + ;; Next non-whitespace character should be '{' + (goto-char (c-point 'boi)) + (eq (char-after) ?{)) + (save-excursion + ;; 'new' should be part of the line + (goto-char (c-point 'iopl)) + (looking-at ".*new.*")) + ;; Line should not already be terminated + (save-excursion + (goto-char (c-point 'eopl)) + (or (not (eq (char-before) ?\;)) + (not (eq (char-before) ?\{))))) + (if (save-excursion + ;; if we have a hanging brace on line before + (goto-char (c-point 'eopl)) + (eq (char-before) ?\{)) + `((brace-list-intro ,(c-point 'iopl))) + `((block-open) (statement ,(c-point 'iopl))))) + (t + (apply orig-fun args)))) + +;;; End of new syntax constructs + + + +;;; Fix for strings on version 27.1 + +(when (version= emacs-version "27.1") + ;; See: + ;; https://github.com/emacs-csharp/csharp-mode/issues/175 + ;; https://github.com/emacs-csharp/csharp-mode/issues/151 + ;; for the full story. + (defun c-pps-to-string-delim (end) + (let* ((start (point)) + (no-st-s `(0 nil nil ?\" nil nil 0 nil ,start nil nil)) + (st-s `(0 nil nil t nil nil 0 nil ,start nil nil)) + no-st-pos st-pos + ) + (parse-partial-sexp start end nil nil no-st-s 'syntax-table) + (setq no-st-pos (point)) + (goto-char start) + (while (progn + (parse-partial-sexp (point) end nil nil st-s 'syntax-table) + (unless (bobp) + (c-clear-syn-tab (1- (point)))) + (setq st-pos (point)) + (and (< (point) end) + (not (eq (char-before) ?\"))))) + (goto-char (min no-st-pos st-pos)) + nil)) + + (defun c-multiline-string-check-final-quote () + (let (pos-ll pos-lt) + (save-excursion + (goto-char (point-max)) + (skip-chars-backward "^\"") + (while + (and + (not (bobp)) + (cond + ((progn + (setq pos-ll (c-literal-limits) + pos-lt (c-literal-type pos-ll)) + (memq pos-lt '(c c++))) + ;; In a comment. + (goto-char (car pos-ll))) + ((save-excursion + (backward-char) ; over " + (c-is-escaped (point))) + ;; At an escaped string. + (backward-char) + t) + (t + ;; At a significant " + (c-clear-syn-tab (1- (point))) + (setq pos-ll (c-literal-limits) + pos-lt (c-literal-type pos-ll)) + nil))) + (skip-chars-backward "^\"")) + (cond + ((bobp)) + ((eq pos-lt 'string) + (c-put-syn-tab (1- (point)) '(15))) + (t nil)))))) + +;;; End of fix for strings on version 27.1 + +;; When invoked by MSBuild, csc’s errors look like this: +;; subfolder\file.cs(6,18): error CS1006: Name of constructor must +;; match name of class [c:\Users\user\project.csproj] + +(defun csharp--compilation-error-file-resolve () + "Resolve an msbuild error to a (filename . dirname) cons cell." + ;; http://stackoverflow.com/a/18049590/429091 + (cons (match-string 1) (file-name-directory (match-string 4)))) + +(defconst csharp-compilation-re-msbuild-error + (concat + "^[[:blank:]]*\\(?:[[:digit:]]+>\\)?" + "\\([^(\r\n)]+\\)(\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?): " + "error [[:alnum:]]+: [^\r\n]+\\[\\([^]\r\n]+\\)\\]$") + "Regexp to match compilation error from msbuild.") + +(defconst csharp-compilation-re-msbuild-warning + (concat + "^[[:blank:]]*\\(?:[[:digit:]]+>\\)?" + "\\([^(\r\n)]+\\)(\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?): " + "warning [[:alnum:]]+: [^\r\n]+\\[\\([^]\r\n]+\\)\\]$") + "Regexp to match compilation warning from msbuild.") + +;; Notes on xbuild and devenv commonalities +;; +;; These regexes were tailored for xbuild, but apart from the concurrent +;; build-marker ("1>") they share exactly the same match-markers. +;; +;; If we don't exclude the match-markers explicitly, these regexes +;; will also be used to match for devenv as well, including the build-marker +;; in the file-name, causing the lookup to fail. +;; +;; So if we don't want devenv to fail, we actually need to handle it in our +;; xbuild-regexes, but then we automatically get devenv-support for free. + +(defconst csharp-compilation-re-xbuild-error + (concat + "^[[:blank:]]*\\(?:[[:digit:]]+>\\)?" + "\\([^(\r\n)]+\\)(\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?" + ;; handle weird devenv output format with 4 numbers, not 2 by having optional + ;; extra capture-groups. + "\\(?:,\\([0-9]+\\)\\)*): " + "error [[:alnum:]]+: .+$") + "Regexp to match compilation error from xbuild.") + +(defconst csharp-compilation-re-xbuild-warning + (concat + "^[[:blank:]]*\\(?:[[:digit:]]+>\\)?" + "\\([^(\r\n)]+\\)(\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?" + ;; handle weird devenv output format with 4 numbers, not 2 by having optional + ;; extra capture-groups. + "\\(?:,\\([0-9]+\\)\\)*): " + "warning [[:alnum:]]+: .+$") + "Regexp to match compilation warning from xbuild.") + +(defconst csharp-compilation-re-dotnet-error + "\\([^\r\n]+\\) : error [A-Z]+[0-9]+:") + +(defconst csharp-compilation-re-dotnet-warning + "\\([^\r\n]+\\) : warning [A-Z]+[0-9]+:") + +(defconst csharp-compilation-re-dotnet-testfail + (concat + "[[:blank:]]+Stack Trace:\n" + "[[:blank:]]+at [^\n]+ in \\([^\n]+\\):line \\([0-9]+\\)")) + + +(eval-after-load 'compile + (lambda () + (dolist + (regexp + `((dotnet-testfail + ,csharp-compilation-re-dotnet-testfail + 1 2) + (xbuild-error + ,csharp-compilation-re-xbuild-error + 1 2 3 2) + (xbuild-warning + ,csharp-compilation-re-xbuild-warning + 1 2 3 1) + (msbuild-error + ,csharp-compilation-re-msbuild-error + csharp--compilation-error-file-resolve + 2 + 3 + 2 + nil + (1 compilation-error-face) + (4 compilation-error-face)) + (msbuild-warning + ,csharp-compilation-re-msbuild-warning + csharp--compilation-error-file-resolve + 2 + 3 + 1 + nil + (1 compilation-warning-face) + (4 compilation-warning-face)) + (dotnet-error + ,csharp-compilation-re-dotnet-error + 1) + (dotnet-warning + ,csharp-compilation-re-dotnet-warning + 1 nil nil 1))) + (add-to-list 'compilation-error-regexp-alist-alist regexp) + (add-to-list 'compilation-error-regexp-alist (car regexp))))) + +(defvar csharp-mode-syntax-table + (funcall (c-lang-const c-make-mode-syntax-table csharp)) + "Syntax table used in `csharp-mode' buffers.") + +(defvar csharp-mode-map + (let ((map (c-make-inherited-keymap))) + map) + "Keymap used in `csharp-mode' buffers.") + +(easy-menu-define csharp-mode-menu csharp-mode-map "C# Mode Commands." + (cons "C#" (c-lang-const c-mode-menu csharp))) + +;;; Tree-sitter support + +(defcustom csharp-ts-mode-indent-offset 4 + "Number of spaces for each indentation step in `csharp-ts-mode'." + :type 'integer + :safe 'integerp + :group 'csharp) + +(defvar csharp-ts-mode--indent-rules + `((c-sharp + ((parent-is "compilation_unit") parent-bol 0) + ((node-is "}") parent-bol 0) + ((node-is ")") parent-bol 0) + ((node-is "]") parent-bol 0) + ((parent-is "namespace_declaration") parent-bol 0) + ((parent-is "class_declaration") parent-bol 0) + ((parent-is "constructor_declaration") parent-bol 0) + ((parent-is "method_declaration") parent-bol 0) + ((parent-is "enum_declaration") parent-bol 0) + ((parent-is "operator_declaration") parent-bol 0) + ((parent-is "field_declaration") parent-bol 0) + ((parent-is "struct_declaration") parent-bol 0) + ((parent-is "declaration_list") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "argument_list") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "interpolation") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "binary_expression") parent 0) + ((parent-is "block") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "local_function_statement") parent-bol 0) + ((parent-is "if_statement") parent-bol 0) + ((parent-is "for_statement") parent-bol 0) + ((parent-is "for_each_statement") parent-bol 0) + ((parent-is "while_statement") parent-bol 0) + ((match "{" "switch_expression") parent-bol 0) + ((parent-is "switch_statement") parent-bol 0) + ((parent-is "switch_body") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "switch_section") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "switch_expression") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "case_statement") parent-bol 0) + ((parent-is "do_statement") parent-bol 0) + ((parent-is "equals_value_clause") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "ternary_expression") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "conditional_expression") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "statement_block") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "type_arguments") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "variable_declarator") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "arguments") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "array") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "formal_parameters") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "template_substitution") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "object_pattern") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "object") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "object_type") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "enum_body") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "arrow_function") parent-bol csharp-ts-mode-indent-offset) + ((parent-is "parenthesized_expression") parent-bol csharp-ts-mode-indent-offset)))) + +(defvar csharp-ts-mode--keywords + '("using" "namespace" "class" "if" "else" "throw" "new" "for" + "return" "await" "struct" "enum" "switch" "case" + "default" "typeof" "try" "catch" "finally" "break" + "foreach" "in" "yield" "get" "set" "when" "as" "out" + "is" "while" "continue" "this" "ref" "goto" "interface" + "from" "where" "select" "lock" "base" "record" "init" + "with" "let" "static" "var" "do" "public" "private" + "readonly" "unmanaged") + "C# keywords for tree-sitter font-locking.") + +(defvar csharp-ts-mode--font-lock-settings + (treesit-font-lock-rules + :language 'c-sharp + :override t + :feature 'comment + '((comment) @font-lock-comment-face) + :language 'c-sharp + :override t + :feature 'keyword + `([,@csharp-ts-mode--keywords] @font-lock-keyword-face + (modifier) @font-lock-keyword-face + (this_expression) @font-lock-keyword-face) + :language 'c-sharp + :override t + :feature 'attribute + `((attribute (identifier) @font-lock-property-face (attribute_argument_list)) + (attribute (identifier) @font-lock-property-face)) + :language 'c-sharp + :override t + :feature 'escape-sequence + '((escape_sequence) @font-lock-escape-face) + :language 'c-sharp + :override t + :feature 'literal + `((integer_literal) @font-lock-constant-face + (real_literal) @font-lock-constant-face + (null_literal) @font-lock-constant-face + (boolean_literal) @font-lock-constant-face) + :language 'c-sharp + :override t + :feature 'string + `([(string_literal) + (verbatim_string_literal) + (interpolated_string_text) + (interpolated_verbatim_string_text) + (character_literal) + "\"" + "$\"" + "@$\"" + "$@\""] @font-lock-string-face) + :language 'c-sharp + :override t + :feature 'type + '((predefined_type) @font-lock-type-face + (implicit_type) @font-lock-type-face + (nullable_type) @font-lock-type-face + (type_parameter + (identifier) @font-lock-type-face) + (type_argument_list + (identifier) @font-lock-type-face) + (generic_name + (identifier) @font-lock-type-face) + (array_type + (identifier) @font-lock-type-face) + (cast_expression (identifier) @font-lock-type-face) + ["operator"] @font-lock-type-face + (type_parameter_constraints_clause + target: (identifier) @font-lock-type-face)) + :language 'c-sharp + :feature 'definition + :override t + '((qualified_name (identifier) @font-lock-variable-name-face) + (using_directive (identifier) @font-lock-type-face) + + (enum_declaration (identifier) @font-lock-type-face) + (enum_member_declaration (identifier) @font-lock-variable-name-face) + + (interface_declaration (identifier) @font-lock-type-face) + + (struct_declaration (identifier) @font-lock-type-face) + + (record_declaration (identifier) @font-lock-type-face) + (namespace_declaration (identifier) @font-lock-type-face) + (base_list (identifier) @font-lock-type-face) + (property_declaration (generic_name)) + (property_declaration + type: (nullable_type) @font-lock-type-face + name: (identifier) @font-lock-variable-name-face) + (property_declaration + type: (predefined_type) @font-lock-type-face + name: (identifier) @font-lock-variable-name-face) + (property_declaration + type: (identifier) @font-lock-type-face + name: (identifier) @font-lock-variable-name-face) + (class_declaration (identifier) @font-lock-type-face) + + (constructor_declaration name: (_) @font-lock-type-face) + + (method_declaration type: (_) @font-lock-type-face) + (method_declaration name: (_) @font-lock-function-name-face) + + (invocation_expression + (member_access_expression + (generic_name (identifier) @font-lock-function-name-face))) + (invocation_expression + (member_access_expression + ((identifier) @font-lock-variable-name-face + (identifier) @font-lock-function-name-face))) + (invocation_expression + (identifier) @font-lock-function-name-face) + (invocation_expression + (member_access_expression (identifier) @font-lock-function-name-face)) + + (variable_declaration (identifier) @font-lock-type-face) + (variable_declarator (identifier) @font-lock-variable-name-face) + + (parameter type: (identifier) @font-lock-type-face) + (parameter name: (identifier) @font-lock-variable-name-face)) + :language 'c-sharp + :feature 'expression + '((conditional_expression (identifier) @font-lock-variable-name-face) + (postfix_unary_expression (identifier)* @font-lock-variable-name-face) + (assignment_expression (identifier) @font-lock-variable-name-face)) + :language 'c-sharp + :feature 'bracket + '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) + + :language 'c-sharp + :feature 'delimiter + '((["," ":" ";"]) @font-lock-delimiter-face))) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) + +(defun csharp-ts-mode--imenu-1 (node) + "Helper for `csharp-ts-mode--imenu'. +Find string representation for NODE and set marker, then recurse +the subtrees." + (let* ((ts-node (car node)) + (subtrees (mapcan #'csharp-ts-mode--imenu-1 (cdr node))) + (name (when ts-node + (or (treesit-node-text + (or (treesit-node-child-by-field-name + ts-node "name")) + t) + "Unnamed node"))) + (marker (when ts-node + (set-marker (make-marker) + (treesit-node-start ts-node))))) + (cond + ((null ts-node) subtrees) + (subtrees + `((,name ,(cons name marker) ,@subtrees))) + (t + `((,name . ,marker)))))) + +(defun csharp-ts-mode--imenu () + "Return Imenu alist for the current buffer." + (let* ((node (treesit-buffer-root-node)) + (class-tree (treesit-induce-sparse-tree + node "^class_declaration$" nil 1000)) + (interface-tree (treesit-induce-sparse-tree + node "^interface_declaration$" nil 1000)) + (enum-tree (treesit-induce-sparse-tree + node "^enum_declaration$" nil 1000)) + (struct-tree (treesit-induce-sparse-tree + node "^struct_declaration$" nil 1000)) + (record-tree (treesit-induce-sparse-tree + node "^record_declaration$" nil 1000)) + (method-tree (treesit-induce-sparse-tree + node "^method_declaration$" nil 1000)) + (class-index (csharp-ts-mode--imenu-1 class-tree)) + (interface-index (csharp-ts-mode--imenu-1 interface-tree)) + (enum-index (csharp-ts-mode--imenu-1 enum-tree)) + (record-index (csharp-ts-mode--imenu-1 record-tree)) + (struct-index (csharp-ts-mode--imenu-1 struct-tree)) + (method-index (csharp-ts-mode--imenu-1 method-tree))) + (append + (when class-index `(("Class" . ,class-index))) + (when interface-index `(("Interface" . ,interface-index))) + (when enum-index `(("Enum" . ,enum-index))) + (when record-index `(("Record" . ,record-index))) + (when struct-index `(("Struct" . ,struct-index))) + (when method-index `(("Method" . ,method-index)))))) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) + +;;;###autoload +(define-derived-mode csharp-mode prog-mode "C#" + "Major mode for editing Csharp code. + +Key bindings: +\\{csharp-mode-map}" + :after-hook (c-update-modeline) + (c-initialize-cc-mode t) + (c-init-language-vars csharp-mode) + (c-common-init 'csharp-mode) + (setq-local c-doc-comment-style '((csharp-mode . codedoc))) + (run-mode-hooks 'c-mode-common-hook)) + +;;;###autoload +(define-derived-mode csharp-ts-mode prog-mode "C#" + "Major mode for editing C# code." + + (unless (treesit-ready-p 'c-sharp) + (error "Tree-sitter for C# isn't available")) + + ;; Tree-sitter. + (treesit-parser-create 'c-sharp) + + ;; Comments. + (setq-local comment-start "// ") + (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *") + (setq-local comment-end "") + + ;; Indent. + (setq-local treesit-simple-indent-rules csharp-ts-mode--indent-rules) + + ;; Electric + (setq-local electric-indent-chars + (append "{}():;," electric-indent-chars)) + + ;; Navigation. + (setq-local treesit-defun-type-regexp "declaration") + + ;; Font-lock. + (setq-local treesit-font-lock-settings csharp-ts-mode--font-lock-settings) + (setq-local treesit-font-lock-feature-list + '((comment keyword constant string) + (type definition expression literal attribute) + (bracket delimiter))) + + ;; Imenu. + (setq-local imenu-create-index-function #'csharp-ts-mode--imenu) + (setq-local which-func-functions nil) ;; Piggyback on imenu + (treesit-major-mode-setup)) + +(provide 'csharp-mode) + +;;; csharp-mode.el ends here diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index bbd902c1c7d..120d4feb951 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -184,19 +184,22 @@ chosen (interactively or automatically)." (defvar eglot-server-programs `((rust-mode . ,(eglot-alternatives '("rust-analyzer" "rls"))) (cmake-mode . ("cmake-language-server")) (vimrc-mode . ("vim-language-server" "--stdio")) - (python-mode + ((python-mode python-ts-mode) . ,(eglot-alternatives '("pylsp" "pyls" ("pyright-langserver" "--stdio") "jedi-language-server"))) - ((js-json-mode json-mode) . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("json-languageserver" "--stdio")))) - ((js-mode ts-mode typescript-mode) + ((js-json-mode json-mode json-ts-mode) + . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") + ("json-languageserver" "--stdio")))) + ((js-mode typescript-ts-mode typescript-mode) . ("typescript-language-server" "--stdio")) - (sh-mode . ("bash-language-server" "start")) + ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) ((php-mode phps-mode) . ,(eglot-alternatives '(("phpactor" "language-server") ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) - ((c++-mode c-mode) . ,(eglot-alternatives - '("clangd" "ccls"))) + ((c-mode c-ts-mode c++-mode c++-ts-mode) + . ,(eglot-alternatives + '("clangd" "ccls"))) (((caml-mode :language-id "ocaml") (tuareg-mode :language-id "ocaml") reason-mode) . ("ocamllsp")) @@ -210,7 +213,7 @@ chosen (interactively or automatically)." ((go-mode go-dot-mod-mode go-dot-work-mode) . ("gopls")) ((R-mode ess-r-mode) . ("R" "--slave" "-e" "languageserver::run()")) - (java-mode . ("jdtls")) + ((java-mode java-ts-mode) . ("jdtls")) (dart-mode . ("dart" "language-server" "--client-id" "emacs.eglot-dart")) (elixir-mode . ("language_server.sh")) @@ -228,12 +231,15 @@ chosen (interactively or automatically)." (lua-mode . ,(eglot-alternatives '("lua-language-server" "lua-lsp"))) (zig-mode . ("zls")) - (css-mode . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") ("css-languageserver" "--stdio")))) + ((css-mode css-ts-mode) + . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") + ("css-languageserver" "--stdio")))) (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio")))) (dockerfile-mode . ("docker-langserver" "--stdio")) ((clojure-mode clojurescript-mode clojurec-mode) . ("clojure-lsp")) - (csharp-mode . ("omnisharp" "-lsp")) + ((csharp-mode csharp-ts-mode) + . ("omnisharp" "-lsp")) (purescript-mode . ("purescript-language-server" "--stdio")) ((perl-mode cperl-mode) . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) (markdown-mode . ("marksman" "server"))) @@ -737,6 +743,10 @@ treated as in `eglot--dbind'." t :json-false) :deprecatedSupport t + :resolveSupport (:properties + ["documentation" + "details" + "additionalTextEdits"]) :tagSupport (:valueSet [1])) :contextSupport t) :hover (list :dynamicRegistration :json-false @@ -1181,7 +1191,7 @@ Each function is passed the server as an argument") "Connect to MANAGED-MODES, LANGUAGE-ID, PROJECT, CLASS and CONTACT. This docstring appeases checkdoc, that's all." (let* ((default-directory (project-root project)) - (nickname (file-name-base (directory-file-name default-directory))) + (nickname (project-name project)) (readable-name (format "EGLOT (%s/%s)" nickname managed-modes)) autostart-inferior-process server-info @@ -1499,11 +1509,15 @@ If optional MARKER, return a marker instead" (defun eglot--path-to-uri (path) "URIfy PATH." (let ((truepath (file-truename path))) - (if (url-type (url-generic-parse-url truepath)) + (if (and (url-type (url-generic-parse-url path)) + ;; It might be MS Windows path which includes a drive + ;; letter that looks like a URL scheme (bug#59338) + (not (and (eq system-type 'windows-nt) + (file-name-absolute-p truepath)))) ;; Path is already a URI, so forward it to the LSP server ;; untouched. The server should be able to handle it, since ;; it provided this URI to clients in the first place. - truepath + path (concat "file://" ;; Add a leading "/" for local MS Windows-style paths. (if (and (eq system-type 'windows-nt) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 81f74dc1fa1..cd2fc7c7079 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -266,7 +266,7 @@ extends to the end of the match for the regular expression." :type 'regexp) (defcustom idlwave-use-last-hang-indent nil - "If non-nil then use last match on line for `idlwave-indent-regexp'." + "If non-nil then use last match on line for `idlwave-hang-indent-regexp'." :group 'idlwave-code-formatting :type 'boolean) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el new file mode 100644 index 00000000000..ee2934f53c6 --- /dev/null +++ b/lisp/progmodes/java-ts-mode.el @@ -0,0 +1,331 @@ +;;; java-ts-mode.el --- tree-sitter support for Java -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author : Theodor Thornhill <theo@thornhill.no> +;; Maintainer : Theodor Thornhill <theo@thornhill.no> +;; Created : November 2022 +;; Keywords : java languages tree-sitter + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + + +;;; Commentary: +;; + +;;; Code: + +(require 'treesit) + +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-induce-sparse-tree "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-child-by-field-name "treesit.c") + +(defcustom java-ts-mode-indent-offset 4 + "Number of spaces for each indentation step in `java-ts-mode'." + :version "29.1" + :type 'integer + :safe 'integerp + :group 'java) + +(defvar java-ts-mode--syntax-table + (let ((table (make-syntax-table))) + ;; Taken from the cc-langs version + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?% "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?\' "\"" table) + (modify-syntax-entry ?\240 "." table) + table) + "Syntax table for `java-ts-mode'.") + +(defvar java-ts-mode--indent-rules + `((java + ((parent-is "program") parent-bol 0) + ((node-is "}") (and parent parent-bol) 0) + ((node-is ")") parent-bol 0) + ((node-is "]") parent-bol 0) + ((and (parent-is "comment") comment-end) comment-start -1) + ((parent-is "comment") comment-start-skip 0) + ((parent-is "class_body") parent-bol java-ts-mode-indent-offset) + ((parent-is "interface_body") parent-bol java-ts-mode-indent-offset) + ((parent-is "constructor_body") parent-bol java-ts-mode-indent-offset) + ((parent-is "enum_body") parent-bol java-ts-mode-indent-offset) + ((parent-is "switch_block") parent-bol java-ts-mode-indent-offset) + ((parent-is "record_declaration_body") parent-bol java-ts-mode-indent-offset) + ((query "(method_declaration (block _ @indent))") parent-bol java-ts-mode-indent-offset) + ((query "(method_declaration (block (_) @indent))") parent-bol java-ts-mode-indent-offset) + ((parent-is "variable_declarator") parent-bol java-ts-mode-indent-offset) + ((parent-is "method_invocation") parent-bol java-ts-mode-indent-offset) + ((parent-is "switch_rule") parent-bol java-ts-mode-indent-offset) + ((parent-is "ternary_expression") parent-bol java-ts-mode-indent-offset) + ((parent-is "element_value_array_initializer") parent-bol java-ts-mode-indent-offset) + ((parent-is "function_definition") parent-bol 0) + ((parent-is "conditional_expression") first-sibling 0) + ((parent-is "assignment_expression") parent-bol 2) + ((parent-is "binary_expression") parent 0) + ((parent-is "parenthesized_expression") first-sibling 1) + ((parent-is "argument_list") parent-bol java-ts-mode-indent-offset) + ((parent-is "annotation_argument_list") parent-bol java-ts-mode-indent-offset) + ((parent-is "modifiers") parent-bol 0) + ((parent-is "formal_parameters") parent-bol java-ts-mode-indent-offset) + ((parent-is "formal_parameter") parent-bol 0) + ((parent-is "init_declarator") parent-bol java-ts-mode-indent-offset) + ((parent-is "if_statement") parent-bol java-ts-mode-indent-offset) + ((parent-is "for_statement") parent-bol java-ts-mode-indent-offset) + ((parent-is "while_statement") parent-bol java-ts-mode-indent-offset) + ((parent-is "switch_statement") parent-bol java-ts-mode-indent-offset) + ((parent-is "case_statement") parent-bol java-ts-mode-indent-offset) + ((parent-is "labeled_statement") parent-bol java-ts-mode-indent-offset) + ((parent-is "do_statement") parent-bol java-ts-mode-indent-offset) + ((parent-is "block") (and parent parent-bol) java-ts-mode-indent-offset))) + "Tree-sitter indent rules.") + +(defvar java-ts-mode--keywords + '("abstract" "assert" "break" "case" "catch" + "class" "continue" "default" "do" "else" + "enum" "exports" "extends" "final" "finally" + "for" "if" "implements" "import" "instanceof" + "interface" "module" "native" "new" "non-sealed" + "open" "opens" "package" "private" "protected" + "provides" "public" "requires" "return" "sealed" + "static" "strictfp" "switch" "synchronized" + "throw" "throws" "to" "transient" "transitive" + "try" "uses" "volatile" "while" "with" "record") + "C keywords for tree-sitter font-locking.") + +(defvar java-ts-mode--operators + '("+" ":" "++" "-" "--" "&" "&&" "|" "||" "=" + "!=" "==" "*" "/" "%" "<" "<=" ">" ">=" + "-=" "+=" "*=" "/=" "%=" "->" "^" "^=" + "|=" "~" ">>" ">>>" "<<" "::" "?" "&=") + "C operators for tree-sitter font-locking.") + +(defvar java-ts-mode--font-lock-settings + (treesit-font-lock-rules + :language 'java + :override t + :feature 'comment + `((line_comment) @font-lock-comment-face + (block_comment) @font-lock-comment-face) + :language 'java + :override t + :feature 'constant + `(((identifier) @font-lock-constant-face + (:match "^[A-Z_][A-Z_\\d]*$" @font-lock-constant-face)) + [(true) (false)] @font-lock-constant-face) + :language 'java + :override t + :feature 'keyword + `([,@java-ts-mode--keywords] @font-lock-keyword-face + (labeled_statement + (identifier) @font-lock-keyword-face)) + :language 'java + :override t + :feature 'operator + `([,@java-ts-mode--operators] @font-lock-operator-face + "@" @font-lock-constant-face) + :language 'java + :override t + :feature 'annotation + `((annotation + name: (identifier) @font-lock-constant-face) + + (marker_annotation + name: (identifier) @font-lock-constant-face)) + :language 'java + :override t + :feature 'string + `((string_literal) @font-lock-string-face) + :language 'java + :override t + :feature 'literal + `((null_literal) @font-lock-constant-face + (binary_integer_literal) @font-lock-number-face + (decimal_integer_literal) @font-lock-number-face + (hex_integer_literal) @font-lock-number-face + (octal_integer_literal) @font-lock-number-face + (decimal_floating_point_literal) @font-lock-number-face + (hex_floating_point_literal) @font-lock-number-face) + :language 'java + :override t + :feature 'type + '((interface_declaration + name: (identifier) @font-lock-type-face) + + (class_declaration + name: (identifier) @font-lock-type-face) + + (record_declaration + name: (identifier) @font-lock-type-face) + + (enum_declaration + name: (identifier) @font-lock-type-face) + + (constructor_declaration + name: (identifier) @font-lock-type-face) + + (field_access + object: (identifier) @font-lock-type-face) + + (method_reference (identifier) @font-lock-type-face) + + (scoped_identifier (identifier) @font-lock-variable-name-face) + + ((scoped_identifier name: (identifier) @font-lock-type-face) + (:match "^[A-Z]" @font-lock-type-face)) + + (type_identifier) @font-lock-type-face + + [(boolean_type) + (integral_type) + (floating_point_type) + (void_type)] @font-lock-type-face) + :language 'java + :override t + :feature 'definition + `((method_declaration + name: (identifier) @font-lock-function-name-face) + + (variable_declarator + name: (identifier) @font-lock-variable-name-face) + + (element_value_pair + key: (identifier) @font-lock-property-face) + + (formal_parameter + name: (identifier) @font-lock-variable-name-face) + + (catch_formal_parameter + name: (identifier) @font-lock-variable-name-face)) + :language 'java + :override t + :feature 'expression + '((method_invocation + object: (identifier) @font-lock-variable-name-face) + + (method_invocation + name: (identifier) @font-lock-function-name-face) + + (argument_list (identifier) @font-lock-variable-name-face)) + + :language 'java + :feature 'bracket + '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) + + :language 'java + :feature 'delimiter + '((["," ":" ";"]) @font-lock-delimiter-face)) + "Tree-sitter font-lock settings.") + +(defun java-ts-mode--imenu-1 (node) + "Helper for `java-ts-mode--imenu'. +Find string representation for NODE and set marker, then recurse +the subtrees." + (let* ((ts-node (car node)) + (subtrees (mapcan #'java-ts-mode--imenu-1 (cdr node))) + (name (when ts-node + (or (treesit-node-text + (or (treesit-node-child-by-field-name + ts-node "name")) + t) + "Unnamed node"))) + (marker (when ts-node + (set-marker (make-marker) + (treesit-node-start ts-node))))) + (cond + ((null ts-node) subtrees) + (subtrees + `((,name ,(cons name marker) ,@subtrees))) + (t + `((,name . ,marker)))))) + +(defun java-ts-mode--imenu () + "Return Imenu alist for the current buffer." + (let* ((node (treesit-buffer-root-node)) + (class-tree (treesit-induce-sparse-tree + node "^class_declaration$" nil 1000)) + (interface-tree (treesit-induce-sparse-tree + node "^interface_declaration$" nil 1000)) + (enum-tree (treesit-induce-sparse-tree + node "^enum_declaration$" nil 1000)) + (record-tree (treesit-induce-sparse-tree + node "^record_declaration$" nil 1000)) + (method-tree (treesit-induce-sparse-tree + node "^method_declaration$" nil 1000)) + (class-index (java-ts-mode--imenu-1 class-tree)) + (interface-index (java-ts-mode--imenu-1 interface-tree)) + (enum-index (java-ts-mode--imenu-1 enum-tree)) + (record-index (java-ts-mode--imenu-1 record-tree)) + (method-index (java-ts-mode--imenu-1 method-tree))) + (append + (when class-index `(("Class" . ,class-index))) + (when interface-index `(("Interface" . ,interface-index))) + (when enum-index `(("Enum" . ,enum-index))) + (when record-index `(("Record" . ,record-index))) + (when method-index `(("Method" . ,method-index)))))) + +;;;###autoload +(define-derived-mode java-ts-mode prog-mode "Java" + "Major mode for editing Java, powered by tree-sitter." + :group 'java + :syntax-table java-ts-mode--syntax-table + + (unless (treesit-ready-p 'java) + (error "Tree-sitter for Java isn't available")) + + (treesit-parser-create 'java) + + ;; Comments. + (setq-local comment-start "// ") + (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *") + (setq-local comment-end "") + (setq-local treesit-comment-start (rx "/" (or (+ "/") (+ "*")))) + (setq-local treesit-comment-end (rx (+ (or "*")) "/")) + + ;; Indent. + (setq-local treesit-simple-indent-rules java-ts-mode--indent-rules) + + ;; Electric + (setq-local electric-indent-chars + (append "{}():;," electric-indent-chars)) + + ;; Navigation. + (setq-local treesit-defun-type-regexp "declaration") + + ;; Font-lock. + (setq-local treesit-font-lock-settings java-ts-mode--font-lock-settings) + (setq-local treesit-font-lock-feature-list + '((comment constant keyword string) + (annotation definition expression literal type) + (bracket delimiter operator))) + + ;; Imenu. + (setq-local imenu-create-index-function #'java-ts-mode--imenu) + (setq-local which-func-functions nil) ;; Piggyback on imenu + (treesit-major-mode-setup)) + +(provide 'java-ts-mode) + +;;; java-ts-mode.el ends here diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index b920ef6c2cc..da05b7b364a 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -53,14 +53,26 @@ (require 'imenu) (require 'json) (require 'prog-mode) +(require 'treesit) (eval-when-compile (require 'cl-lib) - (require 'ido)) + (require 'ido) + (require 'rx)) (defvar ido-cur-list) (defvar electric-layout-rules) (declare-function ido-mode "ido" (&optional arg)) +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-induce-sparse-tree "treesit.c") +(declare-function treesit-search-subtree "treesit.c") +(declare-function treesit-node-parent "treesit.c") +(declare-function treesit-node-child "treesit.c") +(declare-function treesit-node-child-by-field-name "treesit.c") +(declare-function treesit-node-next-sibling "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-end "treesit.c") +(declare-function treesit-node-type "treesit.c") ;;; Constants @@ -663,6 +675,9 @@ This variable is like `sgml-attribute-offset'." :doc "Keymap for `js-mode'." "M-." #'js-find-symbol) +(defvar js-ts-mode-map (copy-keymap js-mode-map) + "Keymap used in `js-ts-mode'.") + ;;; Syntax table and parsing (defvar js-mode-syntax-table @@ -3400,10 +3415,341 @@ This function is intended for use in `after-change-functions'." (c-lang-defconst c-paragraph-start js-mode "\\(@[[:alpha:]]+\\>\\|$\\)") +;;; Tree sitter integration + +(defvar js--treesit-indent-rules + (let ((switch-case (rx "switch_" (or "case" "default")))) + `((javascript + ((parent-is "program") parent-bol 0) + ((node-is "}") parent-bol 0) + ((node-is ")") parent-bol 0) + ((node-is "]") parent-bol 0) + ((node-is ">") parent-bol 0) + ((parent-is "comment") comment-start 0) + ((and (parent-is "comment") comment-end) comment-start -1) + ((parent-is "comment") comment-start-skip 0) + ((parent-is "ternary_expression") parent-bol js-indent-level) + ((parent-is "member_expression") parent-bol js-indent-level) + ((node-is ,switch-case) parent-bol 0) + ;; "{" on the newline. + ((node-is "statement_block") parent-bol js-indent-level) + ((parent-is "named_imports") parent-bol js-indent-level) + ((parent-is "statement_block") parent-bol js-indent-level) + ((parent-is "variable_declarator") parent-bol js-indent-level) + ((parent-is "arguments") parent-bol js-indent-level) + ((parent-is "array") parent-bol js-indent-level) + ((parent-is "formal_parameters") parent-bol js-indent-level) + ((parent-is "template_substitution") parent-bol js-indent-level) + ((parent-is "object_pattern") parent-bol js-indent-level) + ((parent-is "object") parent-bol js-indent-level) + ((parent-is "pair") parent-bol js-indent-level) + ((parent-is "arrow_function") parent-bol js-indent-level) + ((parent-is "parenthesized_expression") parent-bol js-indent-level) + ((parent-is "class_body") parent-bol js-indent-level) + ((parent-is ,switch-case) parent-bol js-indent-level) + ((parent-is "statement_block") parent-bol js-indent-level) + + ;; JSX + ((parent-is "jsx_opening_element") parent js-indent-level) + ((node-is "jsx_closing_element") parent 0) + ((node-is "jsx_text") parent js-indent-level) + ((parent-is "jsx_element") parent js-indent-level) + ((node-is "/") parent 0) + ((parent-is "jsx_self_closing_element") parent js-indent-level))))) + +(defvar js--treesit-keywords + '("as" "async" "await" "break" "case" "catch" "class" "const" "continue" + "debugger" "default" "delete" "do" "else" "export" "extends" "finally" + "for" "from" "function" "get" "if" "import" "in" "instanceof" "let" "new" + "of" "return" "set" "static" "switch" "switch" "target" "throw" "try" + "typeof" "var" "void" "while" "with" "yield") + "JavaScript keywords for tree-sitter font-locking.") + +(defvar js--treesit-operators + '("=" "+=" "-=" "*=" "/=" "%=" "**=" "<<=" ">>=" ">>>=" "&=" "^=" + "|=" "&&=" "||=" "??=" "==" "!=" "===" "!==" ">" ">=" "<" "<=" "+" + "-" "*" "/" "%" "++" "--" "**" "&" "|" "^" "~" "<<" ">>" ">>>" + "&&" "||" "!") + "JavaScript operators for tree-sitter font-locking.") + +(defvar js--treesit-font-lock-settings + (treesit-font-lock-rules + + :language 'javascript + :override t + :feature 'comment + `((comment) @font-lock-comment-face) + + :language 'javascript + :override t + :feature 'constant + `(((identifier) @font-lock-constant-face + (:match "^[A-Z_][A-Z_\\d]*$" @font-lock-constant-face)) + + [(true) (false) (null)] @font-lock-constant-face) + + :language 'javascript + :override t + :feature 'keyword + `([,@js--treesit-keywords] @font-lock-keyword-face + [(this) (super)] @font-lock-keyword-face) + + :language 'javascript + :override t + :feature 'string + `((regex pattern: (regex_pattern)) @font-lock-string-face + (string) @font-lock-string-face + (template_string) @js--fontify-template-string + (template_substitution ["${" "}"] @font-lock-builtin-face)) + + :language 'javascript + :override t + :feature 'declaration + `((function + name: (identifier) @font-lock-function-name-face) + + (class_declaration + name: (identifier) @font-lock-type-face) + + (function_declaration + name: (identifier) @font-lock-function-name-face) + + (method_definition + name: (property_identifier) @font-lock-function-name-face) + + (variable_declarator + name: (identifier) @font-lock-variable-name-face) + + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(function) (arrow_function)]) + + (variable_declarator + name: (array_pattern + (identifier) + (identifier) + @font-lock-function-name-face) + value: (array (number) (function)))) + + :language 'javascript + :override t + :feature 'identifier + `((new_expression + constructor: (identifier) @font-lock-type-face) + + (for_in_statement + left: (identifier) @font-lock-variable-name-face) + + (arrow_function + parameter: (identifier) @font-lock-variable-name-face)) + + :language 'javascript + :override t + :feature 'expression + `((assignment_expression + left: [(identifier) @font-lock-function-name-face + (member_expression property: (property_identifier) + @font-lock-function-name-face)] + right: [(function) (arrow_function)]) + + (call_expression + function: [(identifier) @font-lock-function-name-face + (member_expression + property: + (property_identifier) @font-lock-function-name-face)]) + + (assignment_expression + left: [(identifier) @font-lock-variable-name-face + (member_expression + property: (property_identifier) @font-lock-variable-name-face)])) + + :language 'javascript + :override t + :feature 'pattern + `((pair_pattern key: (property_identifier) @font-lock-variable-name-face) + (array_pattern (identifier) @font-lock-variable-name-face)) + + :language 'javascript + :override t + :feature 'jsx + `( + (jsx_opening_element + [(nested_identifier (identifier)) (identifier)] + @font-lock-function-name-face) + + (jsx_closing_element + [(nested_identifier (identifier)) (identifier)] + @font-lock-function-name-face) + + (jsx_self_closing_element + [(nested_identifier (identifier)) (identifier)] + @font-lock-function-name-face) + + (jsx_attribute + (property_identifier) + @font-lock-constant-face)) + + :language 'javascript + :feature 'number + `((number) @font-lock-number-face + ((identifier) @font-lock-number-face + (:match "^\\(:?NaN\\|Infinity\\)$" @font-lock-number-face))) + + :language 'javascript + :feature 'operator + `([,@js--treesit-operators] @font-lock-operator-face + (ternary_expression ["?" ":"] @font-lock-operator-face)) + + :language 'javascript + :feature 'bracket + '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) + + :language 'javascript + :feature 'delimiter + '((["," "." ";" ":"]) @font-lock-delimiter-face) + + :language 'javascript + :feature 'escape-sequence + :override t + '((escape_sequence) @font-lock-escape-face) + + :language 'javascript + :override t + :feature 'property + `((property_identifier) @font-lock-property-face + + (pair value: (identifier) @font-lock-variable-name-face) + + ((shorthand_property_identifier) @font-lock-property-face) + + ((shorthand_property_identifier_pattern) @font-lock-property-face))) + "Tree-sitter font-lock settings.") + +(defun js--fontify-template-string (node override start end &rest _) + "Fontify template string but not substitution inside it. +NODE is the template_string node. START and END mark the region +to be fontified. + +OVERRIDE is the override flag described in +`treesit-font-lock-rules'." + ;; You would have thought that the children of the string node spans + ;; the whole string. No, the children of the template_string only + ;; includes the starting "`", any template_substitution, and the + ;; closing "`". That's why we have to track BEG instead of just + ;; fontifying each child. + (let ((child (treesit-node-child node 0)) + (font-beg (treesit-node-start node))) + (while child + (let ((font-end (if (equal (treesit-node-type child) + "template_substitution") + (treesit-node-start child) + (treesit-node-end child)))) + (setq font-beg (max start font-beg)) + (when (< font-beg end) + (treesit-fontify-with-override + font-beg font-end 'font-lock-string-face override))) + (setq font-beg (treesit-node-end child) + child (treesit-node-next-sibling child))))) + +(defun js-treesit-current-defun () + "Return name of surrounding function. +This function can be used as a value in `which-func-functions'" + (let ((node (treesit-node-at (point))) + (name-list ())) + (cl-loop while node + if (pcase (treesit-node-type node) + ("function_declaration" t) + ("method_definition" t) + ("class_declaration" t) + ("variable_declarator" t) + (_ nil)) + do (push (treesit-node-text + (treesit-node-child-by-field-name node "name") + t) + name-list) + do (setq node (treesit-node-parent node)) + finally return (string-join name-list ".")))) + +(defun js--treesit-imenu-1 (node) + "Given a sparse tree, create an imenu alist. + +NODE is the root node of the tree returned by +`treesit-induce-sparse-tree' (not a tree-sitter node, its car is +a tree-sitter node). Walk that tree and return an imenu alist. + +Return a list of ENTRY where + +ENTRY := (NAME . MARKER) + | (NAME . ((JUMP-LABEL . MARKER) + ENTRY + ...) + +NAME is the function/class's name, JUMP-LABEL is like \"*function +definition*\"." + (let* ((ts-node (car node)) + (children (cdr node)) + (subtrees (mapcan #'js--treesit-imenu-1 + children)) + (type (pcase (treesit-node-type ts-node) + ("lexical_declaration" 'variable) + ("class_declaration" 'class) + ("method_definition" 'method) + ("function_declaration" 'function))) + ;; The root of the tree could have a nil ts-node. + (name (when ts-node + (let ((ts-node-1 + (if (eq type 'variable) + (treesit-search-subtree + ts-node "variable_declarator" nil nil 1) + ts-node))) + (treesit-node-text + (treesit-node-child-by-field-name + ts-node-1 "name") + t)))) + (marker (when ts-node + (set-marker (make-marker) + (treesit-node-start ts-node))))) + (cond + ((null ts-node) + subtrees) + ;; Don't included non-top-level variable declarations. + ((and (eq type 'variable) + (treesit-node-top-level ts-node)) + nil) + (subtrees + `((,name + ,(cons "" marker) + ,@subtrees))) + (t (list (cons name marker)))))) + +(defun js--treesit-imenu () + "Return Imenu alist for the current buffer." + (let* ((node (treesit-buffer-root-node)) + (class-tree (treesit-induce-sparse-tree + node (rx (or "class_declaration" + "method_definition")) + nil 1000)) + (func-tree (treesit-induce-sparse-tree + node "function_declaration" nil 1000)) + (var-tree (treesit-induce-sparse-tree + node "lexical_declaration" nil 1000))) + `(("Class" . ,(js--treesit-imenu-1 class-tree)) + ("Varieable" . ,(js--treesit-imenu-1 var-tree)) + ("Function" . ,(js--treesit-imenu-1 func-tree))))) + ;;; Main Function ;;;###autoload -(define-derived-mode js-mode prog-mode "JavaScript" +(define-derived-mode js-base-mode prog-mode "JavaScript" + "Generic major mode for editing JavaScript. + +This mode is intended to be inherited by concrete major modes. +Currently there are `js-mode' and `js-ts-mode'." + :group 'js + nil) + +;;;###autoload +(define-derived-mode js-mode js-base-mode "JavaScript" "Major mode for editing JavaScript." :group 'js ;; Ensure all CC Mode "lang variables" are set to valid values. @@ -3489,6 +3835,55 @@ This function is intended for use in `after-change-functions'." ) ;;;###autoload +(define-derived-mode js-ts-mode js-base-mode "JavaScript" + "Major mode for editing JavaScript. + +\\<js-ts-mode-map>" + :group 'js + (when (treesit-ready-p 'javascript) + ;; Borrowed from `js-mode'. + (setq-local prettify-symbols-alist js--prettify-symbols-alist) + (setq-local parse-sexp-ignore-comments t) + ;; Which-func. + (setq-local which-func-imenu-joiner-function #'js--which-func-joiner) + ;; Comment. + (setq-local comment-start "// ") + (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *") + (setq-local comment-end "") + (setq-local comment-multi-line t) + (setq-local treesit-comment-start (rx "/" (or (+ "/") (+ "*")))) + (setq-local treesit-comment-end (rx (+ (or "*")) "/")) + ;; Electric-indent. + (setq-local electric-indent-chars + (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*". + (setq-local electric-layout-rules + '((?\; . after) (?\{ . after) (?\} . before))) + + ;; Tree-sitter setup. + (treesit-parser-create 'javascript) + ;; Indent. + (setq-local treesit-simple-indent-rules js--treesit-indent-rules) + ;; Navigation. + (setq-local treesit-defun-type-regexp + (rx (or "class_declaration" + "method_definition" + "function_declaration" + "lexical_declaration"))) + ;; Fontification. + (setq-local treesit-font-lock-settings js--treesit-font-lock-settings) + (setq-local treesit-font-lock-feature-list + '(( comment declaration) + ( constant expression identifier keyword number string) + ( bracket delimiter escape-sequence jsx operator + pattern property))) + ;; Imenu + (setq-local imenu-create-index-function + #'js--treesit-imenu) + ;; Which-func (use imenu). + (setq-local which-func-functions nil) + (treesit-major-mode-setup))) + +;;;###autoload (define-derived-mode js-json-mode js-mode "JSON" (setq-local js-enabled-frameworks nil) ;; Speed up `syntax-ppss': JSON files can be big but can't hold diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el new file mode 100644 index 00000000000..101e873cf6e --- /dev/null +++ b/lisp/progmodes/json-ts-mode.el @@ -0,0 +1,171 @@ +;;; json-ts-mode.el --- tree-sitter support for JSON -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author : Theodor Thornhill <theo@thornhill.no> +;; Maintainer : Theodor Thornhill <theo@thornhill.no> +;; Created : November 2022 +;; Keywords : json languages tree-sitter + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + + +;;; Commentary: +;; + +;;; Code: + +(require 'treesit) +(require 'rx) + +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-induce-sparse-tree "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-child-by-field-name "treesit.c") + + +(defcustom json-ts-mode-indent-offset 2 + "Number of spaces for each indentation step in `json-ts-mode'." + :version "29.1" + :type 'integer + :safe 'integerp + :group 'json) + +(defvar json-ts-mode--syntax-table + (let ((table (make-syntax-table))) + ;; Taken from the cc-langs version + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?$ "_" table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?% "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?` "\"" table) + (modify-syntax-entry ?\240 "." table) + table) + "Syntax table for `json-ts-mode'.") + + +(defvar json-ts--indent-rules + `((json + ((node-is "}") parent-bol 0) + ((node-is ")") parent-bol 0) + ((node-is "]") parent-bol 0) + ((parent-is "object") parent-bol json-ts-mode-indent-offset)))) + +(defvar json-ts-mode--font-lock-settings + (treesit-font-lock-rules + :language 'json + :feature 'bracket + '((["[" "]" "{" "}"]) @font-lock-bracket-face) + :language 'json + :feature 'constant + '([(null) (true) (false)] @font-lock-constant-face) + :language 'json + :feature 'delimiter + '((["," ":"]) @font-lock-delimiter-face) + :language 'json + :feature 'number + '((number) @font-lock-number-face) + :language 'json + :feature 'string + '((string) @font-lock-string-face) + :language 'json + :feature 'escape-sequence + :override t + '((escape_sequence) @font-lock-escape-face) + :language 'json + :feature 'error + :override t + '((ERROR) @font-lock-warning-face)) + "Font-lock settings for JSON.") + +(defun json-ts-mode--imenu-1 (node) + "Helper for `json-ts-mode--imenu'. +Find string representation for NODE and set marker, then recurse +the subtrees." + (let* ((ts-node (car node)) + (subtrees (mapcan #'json-ts-mode--imenu-1 (cdr node))) + (name (when ts-node + (treesit-node-text + (treesit-node-child-by-field-name + ts-node "key") + t))) + (marker (when ts-node + (set-marker (make-marker) + (treesit-node-start ts-node))))) + (cond + ((null ts-node) subtrees) + (subtrees + `((,name ,(cons name marker) ,@subtrees))) + (t + `((,name . ,marker)))))) + +(defun json-ts-mode--imenu () + "Return Imenu alist for the current buffer." + (let* ((node (treesit-buffer-root-node)) + (tree (treesit-induce-sparse-tree + node "pair" nil 1000))) + (json-ts-mode--imenu-1 tree))) + +;;;###autoload +(define-derived-mode json-ts-mode prog-mode "JSON" + "Major mode for editing JSON, powered by tree-sitter." + :group 'json + :syntax-table json-ts-mode--syntax-table + + (unless (treesit-ready-p 'json) + (error "Tree-sitter for JSON isn't available")) + + (treesit-parser-create 'json) + + ;; Comments. + (setq-local comment-start "// ") + (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *") + (setq-local comment-end "") + + ;; Electric + (setq-local electric-indent-chars + (append "{}():;," electric-indent-chars)) + + ;; Indent. + (setq-local treesit-simple-indent-rules json-ts--indent-rules) + + ;; Navigation. + (setq-local treesit-defun-type-regexp + (rx (or "pair" "object"))) + + ;; Font-lock. + (setq-local treesit-font-lock-settings json-ts-mode--font-lock-settings) + (setq-local treesit-font-lock-feature-list + '((constant number string) + (escape-sequence) + (bracket delimiter error))) + + ;; Imenu. + (setq-local imenu-create-index-function #'json-ts-mode--imenu) + (setq-local which-func-functions nil) ;; Piggyback on imenu + + (treesit-major-mode-setup)) + +(provide 'json-ts-mode) + +;;; json-ts-mode.el ends here diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 63510e90502..5b8648031fb 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -175,8 +175,14 @@ function; the only practical limitation is to use values that `cl-defmethod' can dispatch on, like a cons cell, or a list, or a CL struct.") -(defvar project-current-inhibit-prompt nil - "Non-nil to skip prompting the user in `project-current'.") +(define-obsolete-variable-alias + 'project-current-inhibit-prompt + 'project-current-directory-override + "29.1") + +(defvar project-current-directory-override nil + "Value to use instead of `default-directory' when detecting the project. +When it is non-nil, `project-current' will always skip prompting too.") ;;;###autoload (defun project-current (&optional maybe-prompt directory) @@ -195,11 +201,12 @@ ignored (per `project-ignores'). See the doc string of `project-find-functions' for the general form of the project instance object." - (unless directory (setq directory default-directory)) + (unless directory (setq directory (or project-current-directory-override + default-directory))) (let ((pr (project--find-in-directory directory))) (cond (pr) - ((unless project-current-inhibit-prompt + ((unless project-current-directory-override maybe-prompt) (setq directory (project-prompt-project-dir) pr (project--find-in-directory directory)))) @@ -251,6 +258,11 @@ depending on the languages used, this list should include the headers search path, load path, class path, and so on." nil) +(cl-defgeneric project-name (project) + "A human-readable name for the project. +Nominally unique, but not enforced." + (file-name-base (directory-file-name (project-root project)))) + (cl-defgeneric project-ignores (_project _dir) "Return the list of glob patterns to ignore inside DIR. Patterns can match both regular files and directories. @@ -390,6 +402,15 @@ you might have to restart Emacs to see the effect." :version "29.1" :safe #'booleanp) +(defcustom project-vc-name nil + "When non-nil, the name of the current VC project. + +The best way to change the value a VC project reports as its +name, is by setting this in .dir-locals.el." + :type 'string + :version "29.1" + :safe #'stringp) + ;; FIXME: Using the current approach, major modes are supposed to set ;; this variable to a buffer-local value. So we don't have access to ;; the "external roots" of language A from buffers of language B, which @@ -439,7 +460,7 @@ backend implementation of `project-external-roots'.") (if (and ;; FIXME: Invalidate the cache when the value ;; of this variable changes. - (project--vc-merge-submodules-p root) + project-vc-merge-submodules (project--submodule-p root)) (let* ((parent (file-name-directory (directory-file-name root)))) @@ -491,7 +512,7 @@ backend implementation of `project-external-roots'.") (cl-defmethod project-files ((project (head vc)) &optional dirs) (mapcan (lambda (dir) - (let ((ignores (project--value-in-dir 'project-vc-ignores dir)) + (let ((ignores project-vc-ignores) backend) (if (and (file-equal-p dir (nth 2 project)) (setq backend (cadr project)) @@ -555,7 +576,7 @@ backend implementation of `project-external-roots'.") (split-string (apply #'vc-git--run-command-string nil "ls-files" args) "\0" t))) - (when (project--vc-merge-submodules-p default-directory) + (when project-vc-merge-submodules ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'. (let* ((submodules (project--git-submodules)) (sub-files @@ -589,11 +610,6 @@ backend implementation of `project-external-roots'.") (lambda (s) (concat default-directory s)) (split-string (buffer-string) "\0" t))))))) -(defun project--vc-merge-submodules-p (dir) - (project--value-in-dir - 'project-vc-merge-submodules - dir)) - (defun project--git-submodules () ;; 'git submodule foreach' is much slower. (condition-case nil @@ -634,7 +650,7 @@ backend implementation of `project-external-roots'.") (condition-case nil (vc-call-backend backend 'ignore-completion-table root) (vc-not-supported () nil))))) - (project--value-in-dir 'project-vc-ignores root) + project-vc-ignores (mapcar (lambda (dir) (concat dir "/")) @@ -665,16 +681,9 @@ DIRS must contain directory names." ;; Sidestep the issue of expanded/abbreviated file names here. (cl-set-difference files dirs :test #'file-in-directory-p)) -(defun project--value-in-dir (var dir) - (with-temp-buffer - (setq default-directory dir) - (let ((enable-local-variables :all)) - (hack-dir-local-variables-non-file-buffer)) - (symbol-value var))) - (cl-defmethod project-buffers ((project (head vc))) (let* ((root (expand-file-name (file-name-as-directory (project-root project)))) - (modules (unless (or (project--vc-merge-submodules-p root) + (modules (unless (or project-vc-merge-submodules (project--submodule-p root)) (mapcar (lambda (m) (format "%s%s/" root m)) @@ -689,6 +698,10 @@ DIRS must contain directory names." (push buf bufs))) (nreverse bufs))) +(cl-defmethod project-name ((_project (head vc))) + (or project-vc-name + (cl-call-next-method))) + ;;; Project commands @@ -934,11 +947,15 @@ by the user at will." (_ (when included-cpd (setq substrings (cons "./" substrings)))) (new-collection (project--file-completion-table substrings)) - (res (project--completing-read-strict prompt - new-collection - predicate - hist mb-default))) - (concat common-parent-directory res))) + (relname (let ((history-add-new-input nil)) + (project--completing-read-strict prompt + new-collection + predicate + hist mb-default))) + (absname (expand-file-name relname common-parent-directory))) + (when (and hist history-add-new-input) + (add-to-history hist absname)) + absname)) (defun project--read-file-absolute (prompt all-files &optional predicate @@ -1680,10 +1697,8 @@ to directory DIR." (let ((command (if (symbolp project-switch-commands) project-switch-commands (project--switch-project-command)))) - (with-temp-buffer - (let ((default-directory dir) - (project-current-inhibit-prompt t)) - (call-interactively command))))) + (let ((project-current-directory-override dir)) + (call-interactively command)))) (provide 'project) ;;; project.el ends here diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index a734e06149e..2a7e8a4081d 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -261,15 +261,26 @@ (require 'ansi-color) (require 'cl-lib) (require 'comint) +(eval-when-compile (require 'subr-x)) ;For `string-empty-p' and `string-join'. +(require 'treesit) +(require 'pcase) (require 'compat nil 'noerror) (require 'project nil 'noerror) (require 'seq) -(eval-when-compile (require 'subr-x)) ;For `string-empty-p'. ;; Avoid compiler warnings (defvar compilation-error-regexp-alist) (defvar outline-heading-end-regexp) +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-induce-sparse-tree "treesit.c") +(declare-function treesit-node-child-by-field-name "treesit.c") +(declare-function treesit-node-type "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-end "treesit.c") +(declare-function treesit-node-parent "treesit.c") +(declare-function treesit-node-prev-sibling "treesit.c") + (autoload 'comint-mode "comint") (autoload 'help-function-arglist "help-fns") @@ -291,6 +302,7 @@ instead." :version "29.1" :type 'string) + ;;; Bindings @@ -393,6 +405,9 @@ instead." map) "Keymap for `python-mode'.") +(defvar python-ts-mode-map (copy-keymap python-mode-map) + "Keymap for `(copy-keymap python-mode-map)'.") + ;;; Python specialized rx @@ -563,7 +578,7 @@ the {...} holes that appear within f-strings." ;; FIXME: This will fail to properly highlight strings appearing ;; within the {...} of an f-string. ;; We could presumably fix it by running - ;; `font-lock-fontify-syntactically-region' (as is done in + ;; `font-lock-default-fontify-syntactically-region' (as is done in ;; `sm-c--cpp-fontify-syntactically', for example) after removing ;; the `face' property, but I'm not sure it's worth the effort and ;; the risks. @@ -941,6 +956,228 @@ is used to limit the scan." "Dotty syntax table for Python files. It makes underscores and dots word constituent chars.") +;;; Tree-sitter font-lock + +;; NOTE: Tree-sitter and font-lock works differently so this can't +;; merge with `python-font-lock-keywords-level-2'. + +(defvar python--treesit-keywords + '("as" "assert" "async" "await" "break" "class" "continue" "def" + "del" "elif" "else" "except" "exec" "finally" "for" "from" + "global" "if" "import" "lambda" "nonlocal" "pass" "print" + "raise" "return" "try" "while" "with" "yield" + ;; These are technically operators, but we fontify them as + ;; keywords. + "and" "in" "is" "not" "or")) + +(defvar python--treesit-builtins + '("abs" "all" "any" "ascii" "bin" "bool" "breakpoint" "bytearray" + "bytes" "callable" "chr" "classmethod" "compile" "complex" + "delattr" "dict" "dir" "divmod" "enumerate" "eval" "exec" + "filter" "float" "format" "frozenset" "getattr" "globals" + "hasattr" "hash" "help" "hex" "id" "input" "int" "isinstance" + "issubclass" "iter" "len" "list" "locals" "map" "max" + "memoryview" "min" "next" "object" "oct" "open" "ord" "pow" + "print" "property" "range" "repr" "reversed" "round" "set" + "setattr" "slice" "sorted" "staticmethod" "str" "sum" "super" + "tuple" "type" "vars" "zip" "__import__")) + +(defvar python--treesit-constants + '("Ellipsis" "False" "None" "NotImplemented" "True" "__debug__" + "copyright" "credits" "exit" "license" "quit")) + +(defvar python--treesit-operators + '("-" "-=" "!=" "*" "**" "**=" "*=" "/" "//" "//=" "/=" "&" "%" "%=" + "^" "+" "+=" "<" "<<" "<=" "<>" "=" "==" ">" ">=" ">>" "|" "~" "@" "@=")) + +(defvar python--treesit-special-attributes + '("__annotations__" "__closure__" "__code__" + "__defaults__" "__dict__" "__doc__" "__globals__" + "__kwdefaults__" "__name__" "__module__" "__package__" + "__qualname__" "__all__")) + +(defvar python--treesit-exceptions + '(;; Python 2 and 3: + "ArithmeticError" "AssertionError" "AttributeError" "BaseException" + "BufferError" "BytesWarning" "DeprecationWarning" "EOFError" + "EnvironmentError" "Exception" "FloatingPointError" "FutureWarning" + "GeneratorExit" "IOError" "ImportError" "ImportWarning" + "IndentationError" "IndexError" "KeyError" "KeyboardInterrupt" + "LookupError" "MemoryError" "NameError" "NotImplementedError" + "OSError" "OverflowError" "PendingDeprecationWarning" + "ReferenceError" "RuntimeError" "RuntimeWarning" "StopIteration" + "SyntaxError" "SyntaxWarning" "SystemError" "SystemExit" "TabError" + "TypeError" "UnboundLocalError" "UnicodeDecodeError" + "UnicodeEncodeError" "UnicodeError" "UnicodeTranslateError" + "UnicodeWarning" "UserWarning" "ValueError" "Warning" + "ZeroDivisionError" + ;; Python 2: + "StandardError" + ;; Python 3: + "BlockingIOError" "BrokenPipeError" "ChildProcessError" + "ConnectionAbortedError" "ConnectionError" "ConnectionRefusedError" + "ConnectionResetError" "FileExistsError" "FileNotFoundError" + "InterruptedError" "IsADirectoryError" "NotADirectoryError" + "PermissionError" "ProcessLookupError" "RecursionError" + "ResourceWarning" "StopAsyncIteration" "TimeoutError" + ;; OS specific + "VMSError" "WindowsError" + )) + +(defun python--treesit-fontify-string (node override start end &rest _) + "Fontify string. +NODE is the string node. Do not fontify the initial f for +f-strings. OVERRIDE is the override flag described in +`treesit-font-lock-rules'. START and END mark the region to be +fontified." + (let* ((string-beg (treesit-node-start node)) + (string-end (treesit-node-end node)) + (maybe-expression (treesit-node-parent node)) + (grandparent (treesit-node-parent + (treesit-node-parent + maybe-expression))) + (maybe-defun grandparent) + (face (if (and (or (member (treesit-node-type maybe-defun) + '("function_definition" + "class_definition")) + ;; If the grandparent is null, meaning the + ;; string is top-level, and the string has + ;; no node or only comment preceding it, + ;; it's a BOF docstring. + (and (null grandparent) + (cl-loop + for prev = (treesit-node-prev-sibling + maybe-expression) + then (treesit-node-prev-sibling prev) + while prev + if (not (equal (treesit-node-type prev) + "comment")) + return nil + finally return t))) + ;; This check filters out this case: + ;; def function(): + ;; return "some string" + (equal (treesit-node-type maybe-expression) + "expression_statement")) + 'font-lock-doc-face + 'font-lock-string-face))) + (when (eq (char-after string-beg) ?f) + (cl-incf string-beg)) + (treesit-fontify-with-override + (max start string-beg) (min end string-end) face override))) + +(defvar python--treesit-settings + (treesit-font-lock-rules + :feature 'comment + :language 'python + '((comment) @font-lock-comment-face) + + :feature 'string + :language 'python + :override t + '((string) @python--treesit-fontify-string) + + :feature 'string-interpolation + :language 'python + :override t + '((interpolation (identifier) @font-lock-variable-name-face)) + + :feature 'definition + :language 'python + '((function_definition + name: (identifier) @font-lock-function-name-face) + (class_definition + name: (identifier) @font-lock-type-face)) + + :feature 'keyword + :language 'python + `([,@python--treesit-keywords] @font-lock-keyword-face + ((identifier) @font-lock-keyword-face + (:match "^self$" @font-lock-keyword-face))) + + :feature 'builtin + :language 'python + `(((identifier) @font-lock-builtin-face + (:match ,(rx-to-string + `(seq bol + (or ,@python--treesit-builtins + ,@python--treesit-special-attributes) + eol)) + @font-lock-builtin-face))) + + :feature 'constant + :language 'python + '([(true) (false) (none)] @font-lock-constant-face) + + :feature 'assignment + :language 'python + `(;; Variable names and LHS. + (assignment left: (identifier) + @font-lock-variable-name-face) + (assignment left: (attribute + attribute: (identifier) + @font-lock-variable-name-face)) + (pattern_list (identifier) + @font-lock-variable-name-face) + (tuple_pattern (identifier) + @font-lock-variable-name-face) + (list_pattern (identifier) + @font-lock-variable-name-face) + (list_splat_pattern (identifier) + @font-lock-variable-name-face)) + + :feature 'decorator + :language 'python + '((decorator "@" @font-lock-type-face) + (decorator (call function: (identifier) @font-lock-type-face)) + (decorator (identifier) @font-lock-type-face)) + + :feature 'type + :language 'python + `(((identifier) @font-lock-type-face + (:match ,(rx-to-string + `(seq bol (or ,@python--treesit-exceptions) + eol)) + @font-lock-type-face)) + (type (identifier) @font-lock-type-face)) + + :feature 'escape-sequence + :language 'python + :override t + '((escape_sequence) @font-lock-escape-face) + + :feature 'number + :language 'python + :override t + '([(integer) (float)] @font-lock-number-face) + + :feature 'property + :language 'python + :override t + '((attribute + attribute: (identifier) @font-lock-property-face) + (class_definition + body: (block + (expression_statement + (assignment left: + (identifier) @font-lock-property-face))))) + + :feature 'operator + :language 'python + :override t + `([,@python--treesit-operators] @font-lock-operator-face) + + :feature 'bracket + :language 'python + :override t + '(["(" ")" "[" "]" "{" "}"] @font-lock-bracket-face) + + :feature 'delimiter + :language 'python + :override t + '(["," "." ":" ";" (ellipsis)] @font-lock-delimiter-face)) + "Tree-sitter font-lock settings.") + ;;; Indentation @@ -5195,6 +5432,92 @@ To this: (python-imenu-format-parent-item-jump-label-function fn)) (python-imenu-create-index)))))) +;;; Tree-sitter imenu + +(defun python--imenu-treesit-create-index-1 (node) + "Given a sparse tree, create an imenu alist. + +NODE is the root node of the tree returned by +`treesit-induce-sparse-tree' (not a tree-sitter node, its car is +a tree-sitter node). Walk that tree and return an imenu alist. + +Return a list of ENTRY where + +ENTRY := (NAME . MARKER) + | (NAME . ((JUMP-LABEL . MARKER) + ENTRY + ...) + +NAME is the function/class's name, JUMP-LABEL is like \"*function +definition*\"." + (let* ((ts-node (car node)) + (children (cdr node)) + (subtrees (mapcan #'python--imenu-treesit-create-index-1 + children)) + (type (pcase (treesit-node-type ts-node) + ("function_definition" 'def) + ("class_definition" 'class))) + ;; The root of the tree could have a nil ts-node. + (name (when ts-node + (treesit-node-text + (treesit-node-child-by-field-name + ts-node "name") t))) + (marker (when ts-node + (set-marker (make-marker) + (treesit-node-start ts-node))))) + (cond + ((null ts-node) + subtrees) + (subtrees + (let ((parent-label + (funcall python-imenu-format-parent-item-label-function + type name)) + (jump-label + (funcall + python-imenu-format-parent-item-jump-label-function + type name))) + `((,parent-label + ,(cons jump-label marker) + ,@subtrees)))) + (t (let ((label + (funcall python-imenu-format-item-label-function + type name))) + (list (cons label marker))))))) + +(defun python-imenu-treesit-create-index (&optional node) + "Return tree Imenu alist for the current Python buffer. + +Change `python-imenu-format-item-label-function', +`python-imenu-format-parent-item-label-function', +`python-imenu-format-parent-item-jump-label-function' to +customize how labels are formatted. + +NODE is the root node of the subtree you want to build an index +of. If nil, use the root node of the whole parse tree. + +Similar to `python-imenu-create-index' but use tree-sitter." + (let* ((node (or node (treesit-buffer-root-node 'python))) + (tree (treesit-induce-sparse-tree + node + (rx (seq bol + (or "function" "class") + "_definition" + eol)) + nil 1000))) + (python--imenu-treesit-create-index-1 tree))) + +(defun python-imenu-treesit-create-flat-index () + "Return flat outline of the current Python buffer for Imenu. + +Change `python-imenu-format-item-label-function', +`python-imenu-format-parent-item-label-function', +`python-imenu-format-parent-item-jump-label-function' to +customize how labels are formatted. + +Similar to `python-imenu-create-flat-index' but use +tree-sitter." + (python-imenu-create-flat-index + (python-imenu-treesit-create-index))) ;;; Misc helpers @@ -5260,6 +5583,29 @@ since it returns nil if point is not inside a defun." (concat (and type (format "%s " type)) (mapconcat #'identity names "."))))))) +(defun python-info-treesit-current-defun (&optional include-type) + "Identical to `python-info-current-defun' but use tree-sitter. +For INCLUDE-TYPE see `python-info-current-defun'." + (let ((node (treesit-node-at (point))) + (name-list ()) + (type 'def)) + (cl-loop while node + if (pcase (treesit-node-type node) + ("function_definition" + (setq type 'def)) + ("class_definition" + (setq type 'class)) + (_ nil)) + do (push (treesit-node-text + (treesit-node-child-by-field-name node "name") + t) + name-list) + do (setq node (treesit-node-parent node)) + finally return (concat (if include-type + (format "%s " type) + "") + (string-join name-list "."))))) + (defun python-info-current-symbol (&optional replace-self) "Return current symbol using dotty syntax. With optional argument REPLACE-SELF convert \"self\" to current @@ -6152,10 +6498,12 @@ Add import for undefined name `%s' (empty to skip): " (defvar prettify-symbols-alist) ;;;###autoload -(define-derived-mode python-mode prog-mode "Python" - "Major mode for editing Python files. +(define-derived-mode python-base-mode prog-mode "Python" + "Generic major mode for editing Python files. -\\{python-mode-map}" +This is a generic major mode intended to be inherited by +concrete implementations. Currently there are two concrete +implementations: `python-mode' and `python-ts-mode'." (setq-local tab-width 8) (setq-local indent-tabs-mode nil) @@ -6167,17 +6515,6 @@ Add import for undefined name `%s' (empty to skip): " (setq-local forward-sexp-function python-forward-sexp-function) - (setq-local font-lock-defaults - `(,python-font-lock-keywords - nil nil nil nil - (font-lock-syntactic-face-function - . python-font-lock-syntactic-face-function) - (font-lock-extend-after-change-region-function - . python-font-lock-extend-region))) - - (setq-local syntax-propertize-function - python-syntax-propertize-function) - (setq-local indent-line-function #'python-indent-line-function) (setq-local indent-region-function #'python-indent-region) ;; Because indentation is not redundant, we cannot safely reindent code. @@ -6202,14 +6539,9 @@ Add import for undefined name `%s' (empty to skip): " (add-hook 'post-self-insert-hook #'python-indent-post-self-insert-function 'append 'local) - (setq-local imenu-create-index-function - #'python-imenu-create-index) - (setq-local add-log-current-defun-function #'python-info-current-defun) - (add-hook 'which-func-functions #'python-info-current-defun nil t) - (setq-local skeleton-further-elements '((abbrev-mode nil) (< '(backward-delete-char-untabify (min python-indent-offset @@ -6218,13 +6550,13 @@ Add import for undefined name `%s' (empty to skip): " (with-no-warnings ;; suppress warnings about eldoc-documentation-function being obsolete - (if (null eldoc-documentation-function) - ;; Emacs<25 - (setq-local eldoc-documentation-function #'python-eldoc-function) - (if (boundp 'eldoc-documentation-functions) - (add-hook 'eldoc-documentation-functions #'python-eldoc-function nil t) - (add-function :before-until (local 'eldoc-documentation-function) - #'python-eldoc-function)))) + (if (null eldoc-documentation-function) + ;; Emacs<25 + (setq-local eldoc-documentation-function #'python-eldoc-function) + (if (boundp 'eldoc-documentation-functions) + (add-hook 'eldoc-documentation-functions #'python-eldoc-function nil t) + (add-function :before-until (local 'eldoc-documentation-function) + #'python-eldoc-function)))) (add-to-list 'hs-special-modes-alist @@ -6257,6 +6589,42 @@ Add import for undefined name `%s' (empty to skip): " (add-hook 'flymake-diagnostic-functions #'python-flymake nil t)) +;;;###autoload +(define-derived-mode python-mode python-base-mode "Python" + "Major mode for editing Python files. + +\\{python-mode-map}" + (setq-local font-lock-defaults + `(,python-font-lock-keywords + nil nil nil nil + (font-lock-syntactic-face-function + . python-font-lock-syntactic-face-function))) + (setq-local syntax-propertize-function + python-syntax-propertize-function) + (setq-local imenu-create-index-function + #'python-imenu-create-index) + (add-hook 'which-func-functions #'python-info-current-defun nil t)) + +;;;###autoload +(define-derived-mode python-ts-mode python-base-mode "Python" + "Major mode for editing Python files, using tree-sitter library. + +\\{python-ts-mode-map}" + (when (treesit-ready-p 'python) + (treesit-parser-create 'python) + (setq-local treesit-font-lock-feature-list + '(( comment string definition) + ( keyword builtin constant type) + ( assignment decorator escape-sequence + string-interpolation number property + operator bracket delimiter))) + (setq-local treesit-font-lock-settings python--treesit-settings) + (setq-local imenu-create-index-function + #'python-imenu-treesit-create-index) + (setq-local treesit-defun-type-regexp (rx (or "function" "class") + "_definition")) + (treesit-major-mode-setup))) + ;;; Completion predicates for M-x ;; Commands that only make sense when editing Python code (dolist (sym '(python-add-import diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 4deb06bde4b..067aef86692 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -148,6 +148,7 @@ (require 'let-alist) (require 'subr-x)) (require 'executable) +(require 'treesit) (autoload 'comint-completion-at-point "comint") (autoload 'comint-filename-completion "comint") @@ -1465,58 +1466,15 @@ When the region is active, send the region instead." (symbol-name sh-shell) sh-shell)))) -;;;###autoload -(define-derived-mode sh-mode prog-mode "Shell-script" - "Major mode for editing shell scripts. -This mode works for many shells, since they all have roughly the same syntax, -as far as commands, arguments, variables, pipes, comments etc. are concerned. -Unless the file's magic number indicates the shell, your usual shell is -assumed. Since filenames rarely give a clue, they are not further analyzed. - -This mode adapts to the variations between shells (see `sh-set-shell') by -means of an inheritance based feature lookup (see `sh-feature'). This -mechanism applies to all variables (including skeletons) that pertain to -shell-specific features. Shell script files can use the `sh-shell' local -variable to indicate the shell variant to be used for the file. - -The default style of this mode is that of Rosenblatt's Korn shell book. -The syntax of the statements varies with the shell being used. The -following commands are available, based on the current shell's syntax: -\\<sh-mode-map> -\\[sh-case] case statement -\\[sh-for] for loop -\\[sh-function] function definition -\\[sh-if] if statement -\\[sh-indexed-loop] indexed loop from 1 to n -\\[sh-while-getopts] while getopts loop -\\[sh-repeat] repeat loop -\\[sh-select] select loop -\\[sh-until] until loop -\\[sh-while] while loop +(defvar sh-mode--treesit-settings) -For sh and rc shells indentation commands are: -\\[smie-config-show-indent] Show the rules controlling this line's indentation. -\\[smie-config-set-indent] Change the rules controlling this line's indentation. -\\[smie-config-guess] Try to tweak the indentation rules so the -buffer indents as it currently is indented. - - -\\[backward-delete-char-untabify] Delete backward one position, even if it was a tab. -\\[sh-end-of-command] Go to end of successive commands. -\\[sh-beginning-of-command] Go to beginning of successive commands. -\\[sh-set-shell] Set this buffer's shell, and maybe its magic number. -\\[sh-execute-region] Have optional header and region be executed in a subshell. - -`sh-electric-here-document-mode' controls whether insertion of two -unquoted < insert a here document. You can control this behavior by -modifying `sh-mode-hook'. - -If you generally program a shell different from your login shell you can -set `sh-shell-file' accordingly. If your shell's file name doesn't correctly -indicate what shell it is use `sh-alias-alist' to translate. +;;;###autoload +(define-derived-mode sh-base-mode prog-mode "Shell-script" + "Generic major mode for editing shell scripts. -If your shell gives error messages with line numbers, you can use \\[executable-interpret] -with your script for an edit-interpret-debug cycle." +This is a generic major mode intended to be inherited by concrete +implementations. Currently there are two: `sh-mode' and +`bash-ts-mode'." (make-local-variable 'sh-shell-file) (make-local-variable 'sh-shell) @@ -1534,13 +1492,6 @@ with your script for an edit-interpret-debug cycle." ;; we can't look if previous line ended with `\' (setq-local comint-prompt-regexp "^[ \t]*") (setq-local imenu-case-fold-search nil) - (setq font-lock-defaults - `((sh-font-lock-keywords - sh-font-lock-keywords-1 sh-font-lock-keywords-2) - nil nil - ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil - (font-lock-syntactic-face-function - . ,#'sh-font-lock-syntactic-face-function))) (setq-local syntax-propertize-function #'sh-syntax-propertize-function) (add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline 'append 'local) @@ -1587,11 +1538,83 @@ with your script for an edit-interpret-debug cycle." nil nil) (add-hook 'flymake-diagnostic-functions #'sh-shellcheck-flymake nil t) (add-hook 'hack-local-variables-hook - #'sh-after-hack-local-variables nil t)) + #'sh-after-hack-local-variables nil t)) + +;;;###autoload +(define-derived-mode sh-mode sh-base-mode "Shell-script" + "Major mode for editing shell scripts. +This mode works for many shells, since they all have roughly the same syntax, +as far as commands, arguments, variables, pipes, comments etc. are concerned. +Unless the file's magic number indicates the shell, your usual shell is +assumed. Since filenames rarely give a clue, they are not further analyzed. + +This mode adapts to the variations between shells (see `sh-set-shell') by +means of an inheritance based feature lookup (see `sh-feature'). This +mechanism applies to all variables (including skeletons) that pertain to +shell-specific features. Shell script files can use the `sh-shell' local +variable to indicate the shell variant to be used for the file. + +The default style of this mode is that of Rosenblatt's Korn shell book. +The syntax of the statements varies with the shell being used. The +following commands are available, based on the current shell's syntax: +\\<sh-mode-map> +\\[sh-case] case statement +\\[sh-for] for loop +\\[sh-function] function definition +\\[sh-if] if statement +\\[sh-indexed-loop] indexed loop from 1 to n +\\[sh-while-getopts] while getopts loop +\\[sh-repeat] repeat loop +\\[sh-select] select loop +\\[sh-until] until loop +\\[sh-while] while loop + +For sh and rc shells indentation commands are: +\\[smie-config-show-indent] Show the rules controlling this line's indentation. +\\[smie-config-set-indent] Change the rules controlling this line's indentation. +\\[smie-config-guess] Try to tweak the indentation rules so the +buffer indents as it currently is indented. + + +\\[backward-delete-char-untabify] Delete backward one position, even if it was a tab. +\\[sh-end-of-command] Go to end of successive commands. +\\[sh-beginning-of-command] Go to beginning of successive commands. +\\[sh-set-shell] Set this buffer's shell, and maybe its magic number. +\\[sh-execute-region] Have optional header and region be executed in a subshell. + +`sh-electric-here-document-mode' controls whether insertion of two +unquoted < insert a here document. You can control this behavior by +modifying `sh-mode-hook'. + +If you generally program a shell different from your login shell you can +set `sh-shell-file' accordingly. If your shell's file name doesn't correctly +indicate what shell it is use `sh-alias-alist' to translate. + +If your shell gives error messages with line numbers, you can use \\[executable-interpret] +with your script for an edit-interpret-debug cycle." + (setq font-lock-defaults + `((sh-font-lock-keywords + sh-font-lock-keywords-1 sh-font-lock-keywords-2) + nil nil + ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil + (font-lock-syntactic-face-function + . ,#'sh-font-lock-syntactic-face-function)))) ;;;###autoload (defalias 'shell-script-mode 'sh-mode) +;;;###autoload +(define-derived-mode bash-ts-mode sh-base-mode "Bash" + "Major mode for editing Bash shell scripts." + (when (treesit-ready-p 'bash) + (setq-local treesit-font-lock-feature-list + '(( comment function heredoc string) + ( command declaration-command keyword number variable) + ( bracket builtin-variable constant delimiter + misc-punctuation operator))) + (setq-local treesit-font-lock-settings + sh-mode--treesit-settings) + (treesit-major-mode-setup))) (defun sh-font-lock-keywords (&optional keywords) "Function to get simple fontification based on `sh-font-lock-keywords'. @@ -3191,6 +3214,133 @@ member of `flymake-diagnostic-functions'." (process-send-region sh--shellcheck-process (point-min) (point-max)) (process-send-eof sh--shellcheck-process)))) -(provide 'sh-script) +;;; Tree-sitter font-lock + +(defvar sh-mode--treesit-operators + '("|" "|&" "||" "&&" ">" ">>" "<" "<<" "<<-" "<<<" "==" "!=" ";&" ";;&") + "A list of `sh-mode' operators to fontify.") + +(defvar sh-mode--treesit-keywords + '("case" "do" "done" "elif" "else" "esac" "export" "fi" "for" + "function" "if" "in" "unset" "while" "then") + "Minimal list of keywords that belong to tree-sitter-bash's grammar. + +Some reserved words are not recognize to keep the grammar +simpler. Those are identified with regex-based filtered queries. + +\(See `sh-mode--treesit-other-keywords' and +`sh-mode--treesit-settings').") + +(defun sh-mode--treesit-other-keywords () + "Return a list `others' of key/reserved words. +These words are fontified with regex-based queries as they are +not part of tree-sitter-bash's grammar. + +See `sh-mode--treesit-other-keywords' and +`sh-mode--treesit-settings')." + (let ((minimal sh-mode--treesit-keywords) + (all (append (sh-feature sh-leading-keywords) + (sh-feature sh-other-keywords))) + (others)) + (dolist (keyword all others) + (if (not (member keyword minimal)) + (setq others (cons keyword others)))))) + +(defvar sh-mode--treesit-declaration-commands + '("declare" "typeset" "export" "readonly" "local") + "Keywords in declaration commands.") + +(defvar sh-mode--treesit-settings + (treesit-font-lock-rules + :feature 'comment + :language 'bash + '((comment) @font-lock-comment-face) + + :feature 'function + :language 'bash + '((function_definition name: (word) @font-lock-function-name-face)) + + :feature 'string + :language 'bash + '([(string) (raw_string)] @font-lock-string-face) + + :feature 'heredoc + :language 'bash + '([(heredoc_start) (heredoc_body)] @sh-heredoc) + + :feature 'variable + :language 'bash + '((variable_name) @font-lock-variable-name-face) + + :feature 'keyword + :language 'bash + `(;; keywords + [ ,@sh-mode--treesit-keywords ] @font-lock-keyword-face + ;; reserved words + (command_name + ((word) @font-lock-keyword-face + (:match + ,(rx-to-string + `(seq bol + (or ,@(sh-mode--treesit-other-keywords)) + eol)) + @font-lock-keyword-face)))) + + :feature 'command + :language 'bash + `(;; function/non-builtin command calls + (command_name (word) @font-lock-function-name-face) + ;; builtin commands + (command_name + ((word) @font-lock-builtin-face + (:match ,(let ((builtins + (sh-feature sh-builtins))) + (rx-to-string + `(seq bol + (or ,@builtins) + eol))) + @font-lock-builtin-face)))) + + :feature 'declaration-command + :language 'bash + `([,@sh-mode--treesit-declaration-commands] @font-lock-keyword-face) + + :feature 'constant + :language 'bash + '((case_item value: (word) @font-lock-constant-face) + (file_descriptor) @font-lock-constant-face) + + :feature 'operator + :language 'bash + `([,@sh-mode--treesit-operators] @font-lock-operator-face) + + :feature 'builtin-variable + :language 'bash + `(((special_variable_name) @font-lock-builtin-face + (:match ,(let ((builtin-vars (sh-feature sh-variables))) + (rx-to-string + `(seq bol + (or ,@builtin-vars) + eol))) + @font-lock-builtin-face))) + + :feature 'number + :language 'bash + `(((word) @font-lock-number-face + (:match "^[0-9]+$" @font-lock-number-face))) + + :feature 'bracket + :language 'bash + '((["(" ")" "((" "))" "[" "]" "[[" "]]" "{" "}"]) @font-lock-bracket-face) + + :feature 'delimiter + :language 'bash + '(([";" ";;"]) @font-lock-delimiter-face) + + :feature 'misc-punctuation + :language 'bash + '((["$"]) @font-lock-misc-punctuation-face)) + "Tree-sitter font-lock settings for `sh-mode'.") +(provide 'sh-script) ;;; sh-script.el ends here diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el new file mode 100644 index 00000000000..763686bf660 --- /dev/null +++ b/lisp/progmodes/typescript-ts-mode.el @@ -0,0 +1,341 @@ +;;; typescript-ts-mode.el --- tree sitter support for TypeScript -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author : Theodor Thornhill <theo@thornhill.no> +;; Maintainer : Theodor Thornhill <theo@thornhill.no> +;; Created : October 2022 +;; Keywords : typescript tsx languages tree-sitter + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'treesit) +(require 'rx) +(require 'js) + +(declare-function treesit-parser-create "treesit.c") + +(defcustom typescript-ts-mode-indent-offset 2 + "Number of spaces for each indentation step in `typescript-ts-mode'." + :version "29.1" + :type 'integer + :safe 'integerp + :group 'typescript) + +(defvar typescript-ts-mode--syntax-table + (let ((table (make-syntax-table))) + ;; Taken from the cc-langs version + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?$ "_" table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?% "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?` "\"" table) + (modify-syntax-entry ?\240 "." table) + table) + "Syntax table for `typescript-ts-mode'.") + +(defvar typescript-ts-mode--indent-rules + `((tsx + ((parent-is "program") parent-bol 0) + ((node-is "}") parent-bol 0) + ((node-is ")") parent-bol 0) + ((node-is "]") parent-bol 0) + ((node-is ">") parent-bol 0) + ((and (parent-is "comment") comment-end) comment-start -1) + ((parent-is "comment") comment-start-skip 0) + ((parent-is "ternary_expression") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "member_expression") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "named_imports") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "statement_block") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "type_arguments") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "variable_declarator") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "arguments") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "array") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "formal_parameters") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "template_substitution") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "object_pattern") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "object") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "object_type") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "enum_body") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "arrow_function") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "parenthesized_expression") parent-bol typescript-ts-mode-indent-offset) + + ;; TSX + ((parent-is "jsx_opening_element") parent typescript-ts-mode-indent-offset) + ((node-is "jsx_closing_element") parent 0) + ((parent-is "jsx_element") parent typescript-ts-mode-indent-offset) + ((node-is "/") parent 0) + ((parent-is "jsx_self_closing_element") parent typescript-ts-mode-indent-offset) + (no-node parent-bol 0))) + "Tree-sitter indent rules.") + +(defvar typescript-ts-mode--keywords + '("!" "abstract" "as" "async" "await" "break" + "case" "catch" "class" "const" "continue" "debugger" + "declare" "default" "delete" "do" "else" "enum" + "export" "extends" "finally" "for" "from" "function" + "get" "if" "implements" "import" "in" "instanceof" "interface" + "keyof" "let" "namespace" "new" "of" "private" "protected" + "public" "readonly" "return" "set" "static" "switch" + "target" "throw" "try" "type" "typeof" "var" "void" + "while" "with" "yield") + "TypeScript keywords for tree-sitter font-locking.") + +(defvar typescript-ts-mode--operators + '("=" "+=" "-=" "*=" "/=" "%=" "**=" "<<=" ">>=" ">>>=" "&=" "^=" + "|=" "&&=" "||=" "??=" "==" "!=" "===" "!==" ">" ">=" "<" "<=" "+" + "-" "*" "/" "%" "++" "--" "**" "&" "|" "^" "~" "<<" ">>" ">>>" + "&&" "||" "!" "?.") + "TypeScript operators for tree-sitter font-locking.") + +(defvar typescript-ts-mode--font-lock-settings + (treesit-font-lock-rules + :language 'tsx + :override t + :feature 'comment + `((comment) @font-lock-comment-face) + + :language 'tsx + :override t + :feature 'constant + `(((identifier) @font-lock-constant-face + (:match "^[A-Z_][A-Z_\\d]*$" @font-lock-constant-face)) + + [(true) (false) (null)] @font-lock-constant-face) + + :language 'tsx + :override t + :feature 'keyword + `([,@typescript-ts-mode--keywords] @font-lock-keyword-face + [(this) (super)] @font-lock-keyword-face) + + :language 'tsx + :override t + :feature 'string + `((regex pattern: (regex_pattern)) @font-lock-string-face + (string) @font-lock-string-face + (template_string) @js--fontify-template-string + (template_substitution ["${" "}"] @font-lock-builtin-face)) + + :language 'tsx + :override t + :feature 'declaration + `((function + name: (identifier) @font-lock-function-name-face) + + (function_declaration + name: (identifier) @font-lock-function-name-face) + + (method_definition + name: (property_identifier) @font-lock-function-name-face) + + (variable_declarator + name: (identifier) @font-lock-variable-name-face) + + (enum_declaration (identifier) @font-lock-type-face) + + (arrow_function + parameter: (identifier) @font-lock-variable-name-face) + + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(function) (arrow_function)]) + + (variable_declarator + name: (array_pattern + (identifier) + (identifier) @font-lock-function-name-face) + value: (array (number) (function)))) + + :language 'tsx + :override t + :feature 'identifier + `((nested_type_identifier + module: (identifier) @font-lock-type-face) + + (type_identifier) @font-lock-type-face + + (predefined_type) @font-lock-type-face + + (new_expression + constructor: (identifier) @font-lock-type-face) + + (enum_body (property_identifier) @font-lock-type-face) + + (enum_assignment name: (property_identifier) @font-lock-type-face) + + (assignment_expression + left: [(identifier) @font-lock-variable-name-face + (member_expression + property: (property_identifier) @font-lock-variable-name-face)]) + + (for_in_statement + left: (identifier) @font-lock-variable-name-face) + + (arrow_function + parameters: + [(_ (identifier) @font-lock-variable-name-face) + (_ (_ (identifier) @font-lock-variable-name-face)) + (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) + + :language 'tsx + :override t + :feature 'expression + '((assignment_expression + left: [(identifier) @font-lock-function-name-face + (member_expression + property: (property_identifier) @font-lock-function-name-face)] + right: [(function) (arrow_function)]) + + (call_expression + function: + [(identifier) @font-lock-function-name-face + (member_expression + property: (property_identifier) @font-lock-function-name-face)])) + + :language 'tsx + :override t + :feature 'pattern + `((pair_pattern + key: (property_identifier) @font-lock-property-face) + + (array_pattern (identifier) @font-lock-variable-name-face)) + + :language 'tsx + :override t + :feature 'jsx + `((jsx_opening_element + [(nested_identifier (identifier)) (identifier)] + @font-lock-function-name-face) + + (jsx_closing_element + [(nested_identifier (identifier)) (identifier)] + @font-lock-function-name-face) + + (jsx_self_closing_element + [(nested_identifier (identifier)) (identifier)] + @font-lock-function-name-face) + + (jsx_attribute (property_identifier) @font-lock-constant-face)) + + :language 'tsx + :feature 'number + `((number) @font-lock-number-face + ((identifier) @font-lock-number-face + (:match "^\\(:?NaN\\|Infinity\\)$" @font-lock-number-face))) + + :language 'tsx + :feature 'operator + `([,@typescript-ts-mode--operators] @font-lock-operator-face + (ternary_expression ["?" ":"] @font-lock-operator-face)) + + :language 'tsx + :feature 'bracket + '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) + + :language 'tsx + :feature 'delimiter + '((["," "." ";" ":"]) @font-lock-delimiter-face) + + :language 'tsx + :feature 'escape-sequence + :override t + '((escape_sequence) @font-lock-escape-face) + + :language 'tsx + :override t + :feature 'property + `(((property_identifier) @font-lock-property-face) + + (pair value: (identifier) @font-lock-variable-name-face) + + ((shorthand_property_identifier) @font-lock-property-face) + + ((shorthand_property_identifier_pattern) + @font-lock-property-face))) + "Tree-sitter font-lock settings.") + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode)) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.tsx\\'" . typescript-ts-mode)) + +;;;###autoload +(define-derived-mode typescript-ts-mode prog-mode "TypeScript" + "Major mode for editing TypeScript." + :group 'typescript + :syntax-table typescript-ts-mode--syntax-table + + (cond + ;; `typescript-ts-mode' requires tree-sitter to work, so we don't check if + ;; user enables tree-sitter for it. + ((treesit-ready-p 'tsx) + ;; Tree-sitter. + (treesit-parser-create 'tsx) + + ;; Comments. + (setq-local comment-start "// ") + (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *") + (setq-local comment-end "") + (setq-local treesit-comment-start (rx "/" (or (+ "/") (+ "*")))) + (setq-local treesit-comment-end (rx (+ (or "*")) "/")) + + ;; Electric + (setq-local electric-indent-chars + (append "{}():;," electric-indent-chars)) + + ;; Indent. + (setq-local treesit-simple-indent-rules typescript-ts-mode--indent-rules) + + ;; Navigation. + (setq-local treesit-defun-type-regexp + (rx (or "class_declaration" + "method_definition" + "function_declaration" + "lexical_declaration"))) + + ;; Font-lock. + (setq-local treesit-font-lock-settings typescript-ts-mode--font-lock-settings) + (setq-local treesit-font-lock-feature-list + '((comment declaration) + (constant expression identifier keyword number string) + (bracket delimiter jsx pattern property))) + ;; Imenu. + (setq-local imenu-create-index-function #'js--treesit-imenu) + + ;; Which-func (use imenu). + (setq-local which-func-functions nil) + + (treesit-major-mode-setup)) + + ;; Elisp. + (t + (js-mode) + (message "Tree-sitter for TypeScript isn't available, falling back to `js-mode'")))) + +(provide 'typescript-ts-mode) + +;;; typescript-ts-mode.el ends here diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 4fe4edc1648..14b749296cb 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1994-2022 Free Software Foundation, Inc. -;; Author: Alex Rezinsky <alexr@msil.sps.mot.com> -;; (doesn't seem to be responsive any more) +;; Author: Alex Rezinsky <alexr@msil.sps.mot.com> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: mode-line, imenu, tools ;; This file is part of GNU Emacs. @@ -27,16 +27,6 @@ ;; located in mode line. It assumes that you work with the imenu ;; package and `imenu--index-alist' is up to date. -;; KNOWN BUGS -;; ---------- -;; Really this package shows not "function where the current point is -;; located now", but "nearest function which defined above the current -;; point". So if your current point is located after the end of -;; function FOO but before the beginning of function BAR, FOO will be -;; displayed in the mode line. -;; - If two windows display the same buffer, both windows -;; show the same `which-func' information. - ;; TODO LIST ;; --------- ;; 1. Dependence on imenu package should be removed. Separate @@ -50,8 +40,8 @@ ;; THANKS TO ;; --------- ;; Per Abrahamsen <abraham@iesd.auc.dk> -;; Some ideas (inserting in mode-line, using of post-command hook -;; and toggling this mode) have been borrowed from his package +;; Some ideas (inserting in mode-line, using of post-command hook +;; and toggling this mode) have been borrowed from his package ;; column.el ;; Peter Eisenhauer <pipe@fzi.de> ;; Bug fixing in case nested indexes. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 89a090ae932..c72041d70f9 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,7 +1,7 @@ ;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2022 Free Software Foundation, Inc. -;; Version: 1.5.1 +;; Version: 1.6.0 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -346,7 +346,9 @@ backward." (value nil)) (while (progn (goto-char (funcall next (point) property)) - (not (or (setq value (get-text-property (point) property)) + (not (or (and + (memq (get-char-property (point) 'invisible) '(ellipsis nil)) + (setq value (get-text-property (point) property))) (eobp) (bobp))))) (cond (value) @@ -427,32 +429,82 @@ or earlier: it can break `dired-do-find-regexp-and-replace'." :version "28.1" :package-version '(xref . "1.2.0")) +(defcustom xref-history-storage #'xref-global-history + "Function that returns xref history. + +The following functions that can be used as this variable's value +are predefined: + +- `xref-global-history' + Return a single, global history used across the entire Emacs + session. This is the default. +- `xref-window-local-history' + Return separate xref histories, one per window. Allows + independent navigation of code in each window. A new + xref history is created for every new window." + :type '(radio + (function-item :tag "Per-window history" xref-window-local-history) + (function-item :tag "Global history for Emacs session" + xref-global-history) + (function :tag "Other")) + :version "29.1" + :package-version '(xref . "1.6.0")) + (make-obsolete-variable 'xref--marker-ring 'xref--history "29.1") (defun xref-set-marker-ring-length (_var _val) (declare (obsolete nil "29.1")) nil) -(defvar xref--history (cons nil nil) +(defun xref--make-xref-history () + "Return a new xref history." + (cons nil nil)) + +(defvar xref--history (xref--make-xref-history) "(BACKWARD-STACK . FORWARD-STACK) of markers to visited Xref locations.") +(defun xref-global-history (&optional new-value) + "Return the xref history that is global for the current Emacs session. + +Override existing value with NEW-VALUE if NEW-VALUE is set." + (if new-value + (setq xref--history new-value) + xref--history)) + +(defun xref-window-local-history (&optional new-value) + "Return window-local xref history for the selected window. + +Override existing value with NEW-VALUE if NEW-VALUE is set." + (let ((w (selected-window))) + (if new-value + (set-window-parameter w 'xref--history new-value) + (or (window-parameter w 'xref--history) + (set-window-parameter w 'xref--history (xref--make-xref-history)))))) + +(defun xref--get-history () + "Return xref history using xref-history-storage." + (funcall xref-history-storage)) + (defun xref--push-backward (m) "Push marker M onto the backward history stack." - (unless (equal m (caar xref--history)) - (push m (car xref--history)))) + (let ((history (xref--get-history))) + (unless (equal m (caar history)) + (push m (car history))))) (defun xref--push-forward (m) "Push marker M onto the forward history stack." - (unless (equal m (cadr xref--history)) - (push m (cdr xref--history)))) + (let ((history (xref--get-history))) + (unless (equal m (cadr history)) + (push m (cdr history))))) (defun xref-push-marker-stack (&optional m) "Add point M (defaults to `point-marker') to the marker stack. The future stack is erased." (xref--push-backward (or m (point-marker))) - (dolist (mk (cdr xref--history)) - (set-marker mk nil nil)) - (setcdr xref--history nil)) + (let ((history (xref--get-history))) + (dolist (mk (cdr history)) + (set-marker mk nil nil)) + (setcdr history nil))) ;;;###autoload (define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1") @@ -462,29 +514,31 @@ The future stack is erased." "Go back to the previous position in xref history. To undo, use \\[xref-go-forward]." (interactive) - (if (null (car xref--history)) - (user-error "At start of xref history") - (let ((marker (pop (car xref--history)))) - (xref--push-forward (point-marker)) - (switch-to-buffer (or (marker-buffer marker) - (user-error "The marked buffer has been deleted"))) - (goto-char (marker-position marker)) - (set-marker marker nil nil) - (run-hooks 'xref-after-return-hook)))) + (let ((history (xref--get-history))) + (if (null (car history)) + (user-error "At start of xref history") + (let ((marker (pop (car history)))) + (xref--push-forward (point-marker)) + (switch-to-buffer (or (marker-buffer marker) + (user-error "The marked buffer has been deleted"))) + (goto-char (marker-position marker)) + (set-marker marker nil nil) + (run-hooks 'xref-after-return-hook))))) ;;;###autoload (defun xref-go-forward () "Got to the point where a previous \\[xref-go-back] was invoked." (interactive) - (if (null (cdr xref--history)) - (user-error "At end of xref history") - (let ((marker (pop (cdr xref--history)))) - (xref--push-backward (point-marker)) - (switch-to-buffer (or (marker-buffer marker) - (user-error "The marked buffer has been deleted"))) - (goto-char (marker-position marker)) - (set-marker marker nil nil) - (run-hooks 'xref-after-return-hook)))) + (let ((history (xref--get-history))) + (if (null (cdr history)) + (user-error "At end of xref history") + (let ((marker (pop (cdr history)))) + (xref--push-backward (point-marker)) + (switch-to-buffer (or (marker-buffer marker) + (user-error "The marked buffer has been deleted"))) + (goto-char (marker-position marker)) + (set-marker marker nil nil) + (run-hooks 'xref-after-return-hook))))) (define-obsolete-variable-alias 'xref--current-item @@ -510,22 +564,23 @@ This can be used from `xref-after-jump-hook', for instance.") ;; etags.el needs this (defun xref-clear-marker-stack () "Discard all markers from the xref history." - (dolist (l (list (car xref--history) (cdr xref--history))) - (dolist (m l) - (set-marker m nil nil))) - (setq xref--history (cons nil nil)) + (let ((history (xref--get-history))) + (dolist (l (list (car history) (cdr history))) + (dolist (m l) + (set-marker m nil nil))) + (setq history (cons nil nil))) nil) ;;;###autoload (defun xref-marker-stack-empty-p () "Whether the xref back-history is empty." - (null (car xref--history))) + (null (car (xref--get-history)))) ;; FIXME: rename this to `xref-back-history-empty-p'. ;;;###autoload (defun xref-forward-history-empty-p () "Whether the xref forward-history is empty." - (null (cdr xref--history))) + (null (cdr (xref--get-history)))) (defun xref--goto-char (pos) @@ -919,6 +974,8 @@ ITEMS is an xref item which " ; FIXME: Expand documentation. (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack) map)) +(declare-function outline-search-text-property "outline" (property &optional value bound move backward looking-at)) + (define-derived-mode xref--xref-buffer-mode special-mode "XREF" "Mode for displaying cross-references." (setq buffer-read-only t) @@ -927,7 +984,14 @@ ITEMS is an xref item which " ; FIXME: Expand documentation. (setq imenu-prev-index-position-function #'xref--imenu-prev-index-position) (setq imenu-extract-index-name-function - #'xref--imenu-extract-index-name)) + #'xref--imenu-extract-index-name) + (setq-local outline-minor-mode-cycle t + outline-minor-mode-use-buttons t + outline-search-function + (lambda (&optional bound move backward looking-at) + (outline-search-text-property + 'xref-group nil bound move backward looking-at)) + outline-level (lambda () 1))) (defvar xref--transient-buffer-mode-map (let ((map (make-sparse-keymap))) diff --git a/lisp/server.el b/lisp/server.el index 2973b783e64..2102f8569b8 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -287,6 +287,8 @@ If nil, no instructions are displayed." "The directory in which to place the server socket. If local sockets are not supported, this is nil.") +(define-error 'server-running-external "External server running") + (defun server-clients-with (property value) "Return a list of clients with PROPERTY set to VALUE." (let (result) @@ -610,6 +612,54 @@ If the key is not valid, signal an error." (error "The key `%s' is invalid" server-auth-key)) (server-generate-key))) +(defsubst server--file-name () + "Return the file name to use for the server socket." + (let ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))) + (expand-file-name server-name server-dir))) + +(defun server-stop (&optional noframe) + "If this Emacs process has a server communication subprocess, stop it. +If the server is running in some other Emacs process (see +`server-running-p'), signal a `server-running-external' error. + +If NOFRAME is non-nil, don't delete any existing frames +associated with a client process. This is useful, for example, +when killing Emacs, in which case the frames will get deleted +anyway." + (let ((server-file (server--file-name))) + (when server-process + ;; Kill it dead! + (ignore-errors (delete-process server-process)) + (unless noframe + (server-log (message "Server stopped"))) + (setq server-process nil + server-mode nil + global-minor-modes (delq 'server-mode global-minor-modes))) + (unwind-protect + ;; Delete the socket files made by previous server + ;; invocations. + (if (not (eq t (server-running-p server-name))) + ;; Remove any leftover socket or authentication file. + (ignore-errors + (let (delete-by-moving-to-trash) + (delete-file server-file) + ;; Also delete the directory that the server file was + ;; created in -- but only in /tmp (see bug#44644). + ;; There may be other servers running, too, so this may + ;; fail. + (when (equal (file-name-directory + (directory-file-name + (file-name-directory server-file))) + "/tmp/") + (ignore-errors + (delete-directory (file-name-directory server-file)))))) + (signal 'server-running-external + (list (format "There is an existing Emacs server, named %S" + server-name)))) + ;; If this Emacs already had a server, clear out associated status. + (while server-clients + (server-delete-client (car server-clients) noframe))))) + ;;;###autoload (defun server-start (&optional leave-dead inhibit-prompt) "Allow this Emacs process to be a server for client processes. @@ -643,55 +693,30 @@ the `server-process' variable." (inhibit-prompt t) (t (yes-or-no-p "The current server still has clients; delete them? ")))) - (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)) - (server-file (expand-file-name server-name server-dir))) - (when server-process - ;; kill it dead! - (ignore-errors (delete-process server-process))) - ;; Check to see if an uninitialized external socket has been - ;; passed in, if that is the case, skip checking - ;; `server-running-p' as this will return the wrong result. - (if (and internal--daemon-sockname - (not server--external-socket-initialized)) - (setq server--external-socket-initialized t) - ;; Delete the socket files made by previous server invocations. - (if (not (eq t (server-running-p server-name))) - ;; Remove any leftover socket or authentication file. - (ignore-errors - (let (delete-by-moving-to-trash) - (delete-file server-file) - ;; Also delete the directory that the server file was - ;; created in -- but only in /tmp (see bug#44644). - ;; There may be other servers running, too, so this may - ;; fail. - (when (equal (file-name-directory - (directory-file-name - (file-name-directory server-file))) - "/tmp/") - (ignore-errors - (delete-directory (file-name-directory server-file)))))) - (display-warning - 'server - (concat "Unable to start the Emacs server.\n" - (format "There is an existing Emacs server, named %S.\n" - server-name) - (substitute-command-keys - "To start the server in this Emacs process, stop the existing -server or call `\\[server-force-delete]' to forcibly disconnect it.")) - :warning) - (setq leave-dead t))) - ;; If this Emacs already had a server, clear out associated status. - (while server-clients - (server-delete-client (car server-clients))) + ;; If a server is already running, try to stop it. + (condition-case err + ;; Check to see if an uninitialized external socket has been + ;; passed in. If that is the case, don't try to stop the + ;; server. (`server-stop' checks `server-running-p', which + ;; would return the wrong result). + (if (and internal--daemon-sockname + (not server--external-socket-initialized)) + (setq server--external-socket-initialized t) + (server-stop)) + (server-running-external + (display-warning + 'server + (concat "Unable to start the Emacs server.\n" + (cadr err) + (substitute-command-keys + "\nTo start the server in this Emacs process, stop the existing server or call `\\[server-force-delete]' to forcibly disconnect it.")) + :warning) + (setq leave-dead t))) ;; Now any previous server is properly stopped. - (if leave-dead - (progn - (unless (eq t leave-dead) (server-log (message "Server stopped"))) - (setq server-mode nil - global-minor-modes (delq 'server-mode global-minor-modes) - server-process nil)) + (unless leave-dead + (let ((server-file (server--file-name))) ;; Make sure there is a safe directory in which to place the socket. - (server-ensure-safe-dir server-dir) + (server-ensure-safe-dir (file-name-directory server-file)) (when server-process (server-log (message "Restarting server"))) (with-file-modes ?\700 @@ -731,6 +756,7 @@ server or call `\\[server-force-delete]' to forcibly disconnect it.")) :service server-file :plist '(:authenticated t))))) (unless server-process (error "Could not start server process")) + (server-log "Starting server") (process-put server-process :server-file server-file) (setq server-mode t) (push 'server-mode global-minor-modes) @@ -748,7 +774,7 @@ server or call `\\[server-force-delete]' to forcibly disconnect it.")) (defun server-force-stop () "Kill all connections to the current server. This function is meant to be called from `kill-emacs-hook'." - (server-start t t)) + (ignore-errors (server-stop 'noframe))) ;;;###autoload (defun server-force-delete (&optional name) @@ -1869,11 +1895,10 @@ Returns the result of the evaluation, or signals an error if it cannot contact the specified server. For example: (server-eval-at \"server\" \\='(emacs-pid)) returns the process ID of the Emacs instance running \"server\"." - (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)) - (server-file (expand-file-name server server-dir)) - (coding-system-for-read 'binary) - (coding-system-for-write 'binary) - address port secret process) + (let ((server-file (server--file-name)) + (coding-system-for-read 'binary) + (coding-system-for-write 'binary) + address port secret process) (unless (file-exists-p server-file) (error "No such server: %s" server)) (with-temp-buffer diff --git a/lisp/simple.el b/lisp/simple.el index 0f44b14948c..893a43b03fc 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -9184,33 +9184,39 @@ The function should return non-nil if the two tokens do not match.") "Return the line string that contains the openparen at POS." (save-excursion (goto-char pos) - ;; Show what precedes the open in its line, if anything. - (cond - ((save-excursion (skip-chars-backward " \t") (not (bolp))) - (buffer-substring (line-beginning-position) - (1+ pos))) - ;; Show what follows the open in its line, if anything. - ((save-excursion - (forward-char 1) - (skip-chars-forward " \t") - (not (eolp))) - (buffer-substring pos - (line-end-position))) - ;; Otherwise show the previous nonblank line, - ;; if there is one. - ((save-excursion (skip-chars-backward "\n \t") (not (bobp))) - (concat - (buffer-substring (progn - (skip-chars-backward "\n \t") - (line-beginning-position)) - (progn (end-of-line) - (skip-chars-backward " \t") - (point))) - ;; Replace the newline and other whitespace with `...'. - "..." - (buffer-substring pos (1+ pos)))) - ;; There is nothing to show except the char itself. - (t (buffer-substring pos (1+ pos)))))) + ;; Capture the regions in terms of (beg . end) conses whose + ;; buffer-substrings we want to show as a context string. Ensure + ;; they are font-locked (bug#59527). + (let (regions) + ;; Show what precedes the open in its line, if anything. + (cond + ((save-excursion (skip-chars-backward " \t") (not (bolp))) + (setq regions (list (cons (line-beginning-position) + (1+ pos))))) + ;; Show what follows the open in its line, if anything. + ((save-excursion + (forward-char 1) + (skip-chars-forward " \t") + (not (eolp))) + (setq regions (list (cons pos (line-end-position))))) + ;; Otherwise show the previous nonblank line, + ;; if there is one. + ((save-excursion (skip-chars-backward "\n \t") (not (bobp))) + (setq regions (list (cons (progn + (skip-chars-backward "\n \t") + (line-beginning-position)) + (progn (end-of-line) + (skip-chars-backward " \t") + (point))) + (cons pos (1+ pos))))) + ;; There is nothing to show except the char itself. + (t (setq regions (list (cons pos (1+ pos)))))) + ;; Ensure we've font-locked the context region. + (font-lock-ensure (caar regions) (cdar (last regions))) + (mapconcat (lambda (region) + (buffer-substring (car region) (cdr region))) + regions + "...")))) (defvar blink-paren-function 'blink-matching-open "Function called, if non-nil, whenever a close parenthesis is inserted. @@ -9572,6 +9578,8 @@ makes it easier to edit it." (define-key map "\C-m" 'choose-completion) (define-key map "\e\e\e" 'delete-completion-window) (define-key map [remap keyboard-quit] #'delete-completion-window) + (define-key map [up] 'previous-line-completion) + (define-key map [down] 'next-line-completion) (define-key map [left] 'previous-completion) (define-key map [right] 'next-completion) (define-key map [?\t] 'next-completion) @@ -9631,8 +9639,10 @@ Go to the window from which completion was requested." (defcustom completion-auto-wrap t "Non-nil means to wrap around when selecting completion options. -This affects the commands `next-completion' and `previous-completion'. -When `completion-auto-select' is t, it wraps through the minibuffer." +This affects the commands `next-completion', `previous-completion', +`next-line-completion' and `previous-line-completion'. +When `completion-auto-select' is t, it wraps through the minibuffer +for the commands bound to the TAB key." :type 'boolean :version "29.1" :group 'completion) @@ -9736,6 +9746,73 @@ Also see the `completion-auto-wrap' variable." (when (/= 0 n) (switch-to-minibuffer)))) +(defun previous-line-completion (&optional n) + "Move to the item on the previous line in the completion list. +With prefix argument N, move back N items line-wise (negative N +means move forward). + +Also see the `completion-auto-wrap' variable." + (interactive "p") + (next-line-completion (- n))) + +(defun next-line-completion (&optional n) + "Move to the item on the next line in the completion list. +With prefix argument N, move N items line-wise (negative N +means move backward). + +Also see the `completion-auto-wrap' variable." + (interactive "p") + (let ((column (current-column)) + pos) + (catch 'bound + (while (> n 0) + (setq pos nil) + (save-excursion + (while (and (not pos) (not (eobp))) + (forward-line 1) + (when (and (not (eobp)) + (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))))) + (if pos (goto-char pos) + (when completion-auto-wrap + (save-excursion + (goto-char (point-min)) + (when (and (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))) + (while (and (not pos) (not (eobp))) + (forward-line 1) + (when (and (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))))) + (if pos (goto-char pos)))) + (setq n (1- n))) + + (while (< n 0) + (setq pos nil) + (save-excursion + (while (and (not pos) (not (bobp))) + (forward-line -1) + (when (and (not (bobp)) + (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))))) + (if pos (goto-char pos) + (when completion-auto-wrap + (save-excursion + (goto-char (point-max)) + (when (and (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))) + (while (and (not pos) (not (bobp))) + (forward-line -1) + (when (and (eq (move-to-column column) column) + (get-text-property (point) 'mouse-face)) + (setq pos (point))))) + (if pos (goto-char pos)))) + (setq n (1+ n)))))) + (defun choose-completion (&optional event no-exit no-quit) "Choose the completion at point. If EVENT, use EVENT's position to determine the starting position. diff --git a/lisp/subr.el b/lisp/subr.el index 261ec512d89..4f671de918b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1792,10 +1792,11 @@ and `event-end' functions." (or (posn-image position) (posn-string position))) (defsubst posn-object-x-y (position) - "Return the x and y coordinates relative to the object of POSITION. + "Return the x and y coordinates relative to the glyph of object of POSITION. The return value has the form (DX . DY), where DX and DY are -given in pixels. POSITION should be a list of the form returned -by `event-start' and `event-end'." +given in pixels, and they are relative to the top-left corner of +the clicked glyph of object at POSITION. POSITION should be a +list of the form returned by `event-start' and `event-end'." (nth 8 position)) (defsubst posn-object-width-height (position) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 993f1d43208..34f899ecaaa 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -287,7 +287,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") '(zlib "zlib1.dll" "libz-1.dll") '(lcms2 "liblcms2-2.dll") '(json "libjansson-4.dll") - '(gccjit "libgccjit-0.dll"))) + '(gccjit "libgccjit-0.dll") + ;; MSYS2 distributes libtree-sitter.dll, without API version + ;; number... + '(tree-sitter "libtree-sitter.dll" "libtree-sitter-0.dll"))) ;;; multi-tty support (defvar w32-initialized nil diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 55dced96b78..734252ee66f 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -40,7 +40,16 @@ (require 'sgml-mode) (require 'smie) (require 'thingatpt) -(eval-when-compile (require 'subr-x)) +(eval-when-compile (require 'subr-x) + (require 'rx)) +(require 'treesit) + +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-induce-sparse-tree "treesit.c") +(declare-function treesit-node-type "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-child "treesit.c") + (defgroup css nil "Cascading Style Sheets (CSS) editing mode." @@ -1317,6 +1326,98 @@ for determining whether point is within a selector." (when (smie-rule-hanging-p) css-indent-offset)))) +;;; Tree-sitter + +(defvar css-ts-mode-map (copy-keymap css-mode-map) + "Keymap used in `css-ts-mode'.") + +(defvar css--treesit-indent-rules + '((css + ((node-is "}") parent-bol 0) + ((node-is ")") parent-bol 0) + ((node-is "]") parent-bol 0) + + ((parent-is "block") parent-bol css-indent-offset) + ((parent-is "arguments") parent-bol css-indent-offset) + ((match nil "declaration" nil 0 3) parent-bol css-indent-offset) + ((match nil "declaration" nil 3) (nth-sibling 2) 0))) + "Tree-sitter indentation rules for `css-ts-mode'.") + +(defvar css--treesit-settings + (treesit-font-lock-rules + :feature 'comment + :language 'css + '((comment) @font-lock-comment-face) + + :feature 'string + :language 'css + '((string_value) @font-lock-string-face) + + :feature 'variable + :language 'css + '((plain_value) @font-lock-variable-name-face) + + :feature 'selector + :language 'css + '((class_selector) @css-selector + (child_selector) @css-selector + (id_selector) @css-selector + (tag_name) @css-selector + (class_name) @css-selector) + + :feature 'property + :language 'css + `((property_name) @css-property) + + :feature 'function + :language 'css + '((function_name) @font-lock-function-name-face) + + :feature 'constant + :language 'css + '((integer_value) @font-lock-number-face + (float_value) @font-lock-number-face + (unit) @font-lock-constant-face) + + :feature 'error + :language 'css + '((ERROR) @error)) + "Tree-sitter font-lock settings for `css-ts-mode'.") + +(defun css--treesit-imenu-1 (node) + "Helper for `css--treesit-imenu'. +Find string representation for NODE and set marker, then recurse +the subtrees." + (let* ((ts-node (car node)) + (subtrees (mapcan #'css--treesit-imenu-1 (cdr node))) + (name (when ts-node + (pcase (treesit-node-type ts-node) + ("rule_set" (treesit-node-text + (treesit-node-child ts-node 0) t)) + ("media_statement" + (let ((block (treesit-node-child ts-node -1))) + (string-trim + (buffer-substring-no-properties + (treesit-node-start ts-node) + (treesit-node-start block)))))))) + (marker (when ts-node + (set-marker (make-marker) + (treesit-node-start ts-node))))) + (cond + ((or (null ts-node) (null name)) subtrees) + (subtrees + `((,name ,(cons name marker) ,@subtrees))) + (t + `((,name . ,marker)))))) + +(defun css--treesit-imenu () + "Return Imenu alist for the current buffer." + (let* ((node (treesit-buffer-root-node)) + (tree (treesit-induce-sparse-tree + node (rx (or "rule_set" "media_statement")) + nil 1000))) + (css--treesit-imenu-1 tree))) + ;;; Completion (defun css--complete-property () @@ -1655,8 +1756,72 @@ rgb()/rgba()." (replace-regexp-in-string "[\n ]+" " " s))) res))))))) +(define-derived-mode css-base-mode prog-mode "CSS" + "Generic mode to edit Cascading Style Sheets (CSS). + +This is a generic major mode intended to be inherited by a +concrete implementation. Currently there are two concrete +implementations: `css-mode' and `css-ts-mode'." + (setq-local comment-start "/*") + (setq-local comment-start-skip "/\\*+[ \t]*") + (setq-local comment-end "*/") + (setq-local comment-end-skip "[ \t]*\\*+/") + (setq-local electric-indent-chars + (append css-electric-keys electric-indent-chars)) + ;; The default "." creates ambiguity with class selectors. + (setq-local imenu-space-replacement " ")) + +;;;###autoload +(define-derived-mode css-ts-mode css-base-mode "CSS" + "Major mode to edit Cascading Style Sheets (CSS). +\\<css-ts-mode-map> + +This mode provides syntax highlighting, indentation, completion, +and documentation lookup for CSS, based on the tree-sitter +library. + +Use `\\[completion-at-point]' to complete CSS properties, +property values, pseudo-elements, pseudo-classes, at-rules, +bang-rules, and HTML tags, classes and IDs. Completion +candidates for HTML class names and IDs are found by looking +through open HTML mode buffers. + +Use `\\[info-lookup-symbol]' to look up documentation of CSS +properties, at-rules, pseudo-classes, and pseudo-elements on the +Mozilla Developer Network (MDN). + +Use `\\[fill-paragraph]' to reformat CSS declaration blocks. It +can also be used to fill comments. + +\\{css-mode-map}" + (when (treesit-ready-p 'css) + ;; Borrowed from `css-mode'. + (add-hook 'completion-at-point-functions + #'css-completion-at-point nil 'local) + (setq-local fill-paragraph-function #'css-fill-paragraph) + (setq-local adaptive-fill-function #'css-adaptive-fill) + (setq-local add-log-current-defun-function #'css-current-defun-name) + + ;; Tree-sitter specific setup. + (treesit-parser-create 'css) + (setq-local treesit-simple-indent-rules css--treesit-indent-rules) + (setq-local treesit-defun-type-regexp "rule_set") + (setq-local treesit-font-lock-settings css--treesit-settings) + (setq-local treesit-font-lock-feature-list + '((selector comment) + (property constant string) + (error variable function))) + ;; Tree-sitter-css, for whatever reason, cannot reliably return + ;; the captured nodes in a given range (it instead returns the + ;; nodes preceding range). Before this is fixed in + ;; tree-sitter-css, use this heuristic as a temporary fix. + (setq-local treesit--font-lock-query-expand-range (cons 80 80)) + (setq-local imenu-create-index-function #'css--treesit-imenu) + (setq-local which-func-functions nil) + (treesit-major-mode-setup))) + ;;;###autoload -(define-derived-mode css-mode prog-mode "CSS" +(define-derived-mode css-mode css-base-mode "CSS" "Major mode to edit Cascading Style Sheets (CSS). \\<css-mode-map> This mode provides syntax highlighting, indentation, completion, @@ -1677,10 +1842,6 @@ be used to fill comments. \\{css-mode-map}" (setq-local font-lock-defaults css-font-lock-defaults) - (setq-local comment-start "/*") - (setq-local comment-start-skip "/\\*+[ \t]*") - (setq-local comment-end "*/") - (setq-local comment-end-skip "[ \t]*\\*+/") (setq-local syntax-propertize-function css-syntax-propertize-function) (setq-local fill-paragraph-function #'css-fill-paragraph) @@ -1689,13 +1850,9 @@ be used to fill comments. (smie-setup css-smie-grammar #'css-smie-rules :forward-token #'css-smie--forward-token :backward-token #'css-smie--backward-token) - (setq-local electric-indent-chars - (append css-electric-keys electric-indent-chars)) (setq-local font-lock-fontify-region-function #'css--fontify-region) (add-hook 'completion-at-point-functions #'css-completion-at-point nil 'local) - ;; The default "." creates ambiguity with class selectors. - (setq-local imenu-space-replacement " ") (setq-local imenu-prev-index-position-function #'css--prev-index-position) (setq-local imenu-extract-index-name-function diff --git a/lisp/treesit.el b/lisp/treesit.el new file mode 100644 index 00000000000..b7da38becc1 --- /dev/null +++ b/lisp/treesit.el @@ -0,0 +1,2330 @@ +;;; treesit.el --- tree-sitter utilities -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file is the Lisp counterpart of treesit.c. Together they +;; provide tree-sitter integration for Emacs. This file contains +;; convenient functions that are more idiomatic and flexible than the +;; exposed C API of tree-sitter. It also contains frameworks for +;; integrating tree-sitter with font-lock, indentation, activating and +;; deactivating tree-sitter, debugging tree-sitter, etc. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'subr-x)) ; For `string-join'. +(require 'cl-seq) +(require 'font-lock) + +;;; Function declarations + +(declare-function treesit-language-available-p "treesit.c") +(declare-function treesit-language-version "treesit.c") + +(declare-function treesit-parser-p "treesit.c") +(declare-function treesit-node-p "treesit.c") +(declare-function treesit-compiled-query-p "treesit.c") +(declare-function treesit-query-p "treesit.c") +(declare-function treesit-query-language "treesit.c") + +(declare-function treesit-node-parser "treesit.c") + +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-parser-delete "treesit.c") +(declare-function treesit-parser-list "treesit.c") +(declare-function treesit-parser-buffer "treesit.c") +(declare-function treesit-parser-language "treesit.c") + +(declare-function treesit-parser-root-node "treesit.c") + +(declare-function treesit-parser-set-included-ranges "treesit.c") +(declare-function treesit-parser-included-ranges "treesit.c") +(declare-function treesit-parser-add-notifier "treesit.c") + +(declare-function treesit-node-type "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-end "treesit.c") +(declare-function treesit-node-string "treesit.c") +(declare-function treesit-node-parent "treesit.c") +(declare-function treesit-node-child "treesit.c") +(declare-function treesit-node-check "treesit.c") +(declare-function treesit-node-field-name-for-child "treesit.c") +(declare-function treesit-node-child-count "treesit.c") +(declare-function treesit-node-child-by-field-name "treesit.c") +(declare-function treesit-node-next-sibling "treesit.c") +(declare-function treesit-node-prev-sibling "treesit.c") +(declare-function treesit-node-first-child-for-pos "treesit.c") +(declare-function treesit-node-descendant-for-range "treesit.c") +(declare-function treesit-node-eq "treesit.c") + +(declare-function treesit-pattern-expand "treesit.c") +(declare-function treesit-query-expand "treesit.c") +(declare-function treesit-query-compile "treesit.c") +(declare-function treesit-query-capture "treesit.c") + +(declare-function treesit-search-subtree "treesit.c") +(declare-function treesit-search-forward "treesit.c") +(declare-function treesit-induce-sparse-tree "treesit.c") + +(declare-function treesit-available-p "treesit.c") + +;;; Custom options + +;; Tree-sitter always appear as treesit in symbols. +(defgroup treesit nil + "Incremental parser. +It is used to enhance major mode features like font-lock, +indent, imenu, etc." + :group 'tools + :version "29.1") + +(defcustom treesit-max-buffer-size + (let ((mb (* 1024 1024))) + ;; 40MB for 64-bit systems, 15 for 32-bit. + (if (or (< most-positive-fixnum (* 2.0 1024 mb)) + ;; 32-bit system with wide ints. + (string-match-p "--with-wide-int" system-configuration-options)) + (* 15 mb) + (* 40 mb))) + "Maximum buffer size (in bytes) for enabling tree-sitter parsing. + +A typical tree-sitter parser needs 10 times as much memory as the +buffer it parses. Also, the tree-sitter library has a hard limit +of max unsigned 32-bit value for byte offsets into buffer text." + :type 'integer + :version "29.1") + +;;; Parser API supplement + +(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 language)))) + +(defvar-local treesit-language-at-point-function nil + "A function that returns the language at point. +This is used by `treesit-language-at', which is used by various +functions to determine which parser to use at point. + +The function is called with one argument, the position of point.") + +(defun treesit-language-at (position) + "Return the language at POSITION. +This function assumes that parser ranges are up-to-date. It +returns the return value of `treesit-language-at-point-function' +if it's non-nil, otherwise it returns the language of the first +parser in `treesit-parser-list', or nil if there is no parser." + (if treesit-language-at-point-function + (funcall treesit-language-at-point-function position) + (when-let ((parser (car (treesit-parser-list)))) + (treesit-parser-language parser)))) + +;;; Node API supplement + +(defun treesit-node-buffer (node) + "Return the buffer in which NODE belongs." + (treesit-parser-buffer + (treesit-node-parser node))) + +(defun treesit-node-language (node) + "Return the language symbol that NODE's parser uses." + (treesit-parser-language + (treesit-node-parser node))) + +(defun treesit-node-at (pos &optional parser-or-lang named) + "Return the leaf node at position POS. + +A leaf node is a node that doesn't have any child nodes. + +The returned node's span covers POS: the node's beginning is before +or at POS, and the node's end is at or after POS. + +If no leaf node's span covers POS (e.g., POS is on whitespace +between two leaf nodes), return the first leaf node after POS. + +If there is no leaf node after POS, return the first leaf node +before POS. + +Return nil if no leaf node can be returned. If NAMED is non-nil, +only look for named nodes. + +If PARSER-OR-LANG is nil, use the first parser in +`treesit-parser-list'; if PARSER-OR-LANG is a parser, use +that parser; if PARSER-OR-LANG is a language, find a parser using +that language in the current buffer, and use that." + (let* ((root (if (treesit-parser-p parser-or-lang) + (treesit-parser-root-node parser-or-lang) + (treesit-buffer-root-node parser-or-lang))) + (node root) + (node-before root) + (pos-1 (max (1- pos) (point-min))) + next) + (when node + ;; This is very fast so no need for C implementation. + (while (setq next (treesit-node-first-child-for-pos + node pos named)) + (setq node next)) + ;; If POS is at the end of buffer, after all the text, we will + ;; end up with NODE = root node. Instead of returning nil, + ;; return the last leaf node in the tree for convenience. + (if (treesit-node-eq node root) + (progn + (while (setq next (treesit-node-child node -1 named)) + (setq node next)) + node) + ;; Normal case, where we found a node. + (if (<= (treesit-node-start node) pos) + node + ;; So the node we found is completely after POS, try to find + ;; a node whose end equals to POS. + (while (setq next (treesit-node-first-child-for-pos + node-before pos-1 named)) + (setq node-before next)) + (if (eq (treesit-node-end node-before) pos) + node-before + node)))))) + +(defun treesit-node-on (beg end &optional parser-or-lang named) + "Return the smallest node covering BEG to END. + +BEWARE! Calling this function on an empty line that is not +inside any top-level construct (function definition, etc.) most +probably will give you the root node, because the root node is +the smallest node that covers that empty line. You probably want +to use `treesit-node-at' instead. + +Return nil if none was found. If NAMED is non-nil, only look for +named node. + +If PARSER-OR-LANG is nil, use the first parser in +`treesit-parser-list'; if PARSER-OR-LANG is a parser, use +that parser; if PARSER-OR-LANG is a language, find a parser using +that language in the current buffer, and use that." + (let ((root (if (treesit-parser-p parser-or-lang) + (treesit-parser-root-node parser-or-lang) + (treesit-buffer-root-node parser-or-lang)))) + (treesit-node-descendant-for-range root beg (or end beg) named))) + +(defun treesit-node-top-level (node &optional type) + "Return the top-level equivalent of NODE. +Specifically, return the highest parent of NODE that has the same +type as it. If no such parent exists, return nil. + +If TYPE is non-nil, match each parent's type with TYPE as a +regexp, rather than using NODE's type." + (let ((type (or type (treesit-node-type node))) + (result nil)) + (cl-loop for cursor = (treesit-node-parent node) + then (treesit-node-parent cursor) + while cursor + if (string-match-p type (treesit-node-type cursor)) + do (setq result cursor)) + result)) + +(defun treesit-buffer-root-node (&optional language) + "Return the root node of the current buffer. +Use the first parser in `treesit-parser-list'. + +If optional argument LANGUAGE is non-nil, use the first parser +for LANGUAGE." + (if-let ((parser + (or (if language + (treesit-parser-create language) + (or (car (treesit-parser-list)) + (signal 'treesit-error + '("Buffer has no parser"))))))) + (treesit-parser-root-node parser))) + +(defun treesit-filter-child (node pred &optional named) + "Return children of NODE that satisfies predicate PRED. +PRED is a function that takes one argument, the child node. +If optional argument NAMED is non-nil, only search for named +node." + (let ((child (treesit-node-child node 0 named)) + result) + (while child + (when (funcall pred child) + (push child result)) + (setq child (treesit-node-next-sibling child named))) + (reverse result))) + +(defun treesit-node-text (node &optional no-property) + "Return the buffer (or string) content corresponding to NODE. +If optional argument NO-PROPERTY is non-nil, remove text +properties." + (when node + (with-current-buffer (treesit-node-buffer node) + (if no-property + (buffer-substring-no-properties + (treesit-node-start node) + (treesit-node-end node)) + (buffer-substring + (treesit-node-start node) + (treesit-node-end node)))))) + +(defun treesit-parent-until (node pred) + "Return the closest parent of NODE that satisfies PRED. +Return nil if none was found. PRED should be a function that +takes one argument, the parent node." + (let ((node (treesit-node-parent node))) + (while (and node (not (funcall pred node))) + (setq node (treesit-node-parent node))) + node)) + +(defun treesit-parent-while (node pred) + "Return the furthest parent of NODE that satisfies PRED. +Return nil if none was found. PRED should be a function that +takes one argument, the parent node." + (let ((last nil)) + (while (and node (funcall pred node)) + (setq last node + node (treesit-node-parent node))) + last)) + +(defalias 'treesit-traverse-parent #'treesit-parent-until) + +(defun treesit-node-children (node &optional named) + "Return a list of NODE's children. +If NAMED is non-nil, collect named child only." + (mapcar (lambda (idx) + (treesit-node-child node idx named)) + (number-sequence + 0 (1- (treesit-node-child-count node named))))) + +(defun treesit-node-index (node &optional named) + "Return the index of NODE in its parent. +If NAMED is non-nil, count named child only." + (let ((count 0)) + (while (setq node (treesit-node-prev-sibling node named)) + (cl-incf count)) + count)) + +(defun treesit-node-field-name (node) + "Return the field name of NODE as a child of its parent." + (when-let ((parent (treesit-node-parent node)) + (idx (treesit-node-index node))) + (treesit-node-field-name-for-child parent idx))) + +;;; Query API supplement + +(defun treesit-query-string (string query language) + "Query STRING with QUERY in LANGUAGE. +See `treesit-query-capture' for QUERY." + (with-temp-buffer + (insert string) + (let ((parser (treesit-parser-create language))) + (treesit-query-capture + (treesit-parser-root-node parser) + query)))) + +(defun treesit-query-range (node query &optional beg end) + "Query the current buffer and return ranges of captured nodes. + +QUERY, NODE, BEG, END are the same as in +`treesit-query-capture'. This function returns a list +of (START . END), where START and END specifics the range of each +captured node. Capture names don't matter." + (cl-loop for capture + in (treesit-query-capture node query beg end) + for node = (cdr capture) + collect (cons (treesit-node-start node) + (treesit-node-end node)))) + +;;; Range API supplement + +(defvar-local treesit-range-settings nil + "A list of range settings. + +Each element of the list is of the form (QUERY LANGUAGE). +When updating the range of each parser in the buffer, +`treesit-update-ranges' queries each QUERY, and sets LANGUAGE's +range to the range spanned by captured nodes. QUERY must be a +compiled query. + +QUERY can also be a function, in which case it is called with 2 +arguments, START and END. It should ensure parsers' ranges are +correct in the region between START and END. + +The exact form of each setting is considered internal and subject +to change. Use `treesit-range-rules' to set this variable.") + +(defun treesit-range-rules (&rest query-specs) + "Produce settings for `treesit-range-settings'. + +QUERY-SPECS are a series of QUERY-SPECs, where each QUERY-SPEC is +a QUERY preceded by zero or more pairs of :KEYWORD and VALUE, +like this: + + :KEYWORD VALUE... QUERY + +Each QUERY is a tree-sitter query in either the string, +s-expression or compiled form. + +For each QUERY, :KEYWORD and VALUE pairs add meta information to +it. For example, + + (treesit-range-rules + :embed \\='javascript + :host \\='html + \\='((script_element (raw_text) @cap))) + +The `:embed' keyword specifies the embedded language, and the +`:host' keyword specifies the host language. They are used in +this way: Emacs queries QUERY in the host language's parser, +computes the ranges spanned by the captured nodes, and applies +these ranges to parsers for the embedded language. + +QUERY can also be a function that takes two arguments, START and +END. If QUERY is a function, it doesn't need the :KEYWORD VALUE +pair preceding it. This function should set the ranges for +parsers in the current buffer in the region between START and +END. It is OK for this function to set ranges in a larger region +that encompasses the region between START and END." + (let (host embed result) + (while query-specs + (pcase (pop query-specs) + (:host (let ((host-lang (pop query-specs))) + (unless (symbolp host-lang) + (signal 'treesit-error (list "Value of :host option should be a symbol" host-lang))) + (setq host host-lang))) + (:embed (let ((embed-lang (pop query-specs))) + (unless (symbolp embed-lang) + (signal 'treesit-error (list "Value of :embed option should be a symbol" embed-lang))) + (setq embed embed-lang))) + (query (if (functionp query) + (push (list query nil nil) result) + (when (null embed) + (signal 'treesit-error (list "Value of :embed option cannot be omitted"))) + (when (null host) + (signal 'treesit-error (list "Value of :host option cannot be omitted"))) + (push (list (treesit-query-compile host query) + embed host) + result)) + (setq host nil embed nil)))) + (nreverse result))) + +(defun treesit--merge-ranges (old-ranges new-ranges start end) + "Merge OLD-RANGES and NEW-RANGES, discarding ranges between START and END. +OLD-RANGES and NEW-RANGES are lists of cons of the form (BEG . END). +When merging the two ranges, if a range in OLD-RANGES intersects with +another range in NEW-RANGES, discard the one in OLD-RANGES and +keep the one in NEW-RANGES. Also discard any range in OLD-RANGES +that intersects the region marked by START and END. + +Return the merged list of ranges." + (let ((result nil)) + (while (and old-ranges new-ranges) + (let ((new-beg (caar new-ranges)) + (new-end (cdar new-ranges)) + (old-beg (caar old-ranges)) + (old-end (cdar old-ranges))) + (cond + ;; Old range intersects with START-END, discard. + ((and (< start old-end) + (< old-beg end)) + (setq old-ranges (cdr old-ranges))) + ;; New range and old range don't intersect, new comes + ;; before, push new. + ((<= new-end old-beg) + (push (car new-ranges) result) + (setq new-ranges (cdr new-ranges))) + ;; New range and old range don't intersect, old comes + ;; before, push old. + ((<= old-end new-beg) + (push (car old-ranges) result) + (setq old-ranges (cdr old-ranges))) + (t ;; New and old range intersect, discard old. + (setq old-ranges (cdr old-ranges)))))) + (let ((left-over (or new-ranges old-ranges))) + (dolist (range left-over) + (push range result))) + (nreverse result))) + +(defun treesit--clip-ranges (ranges start end) + "Clip RANGES in between START and END. +RANGES is a list of ranges of the form (BEG . END). Ranges +outside of the region between START and END are thrown away, and +those inside are kept." + (cl-loop for range in ranges + if (<= start (car range) (cdr range) end) + collect range)) + +(defun treesit-update-ranges (&optional beg end) + "Update the ranges for each language in the current buffer. +If BEG and END are non-nil, only update parser ranges in that +region." + ;; When updating ranges, we want to avoid querying the whole buffer + ;; which could be slow in very large buffers. Instead, we only + ;; query for nodes that intersect with the region between BEG and + ;; END. Also, we only update the ranges intersecting BEG and END; + ;; outside of that region we inherit old ranges. + (dolist (setting treesit-range-settings) + (let ((query (nth 0 setting)) + (language (nth 1 setting)) + (beg (or beg (point-min))) + (end (or end (point-max)))) + (if (functionp query) (funcall query beg end) + (let* ((host-lang (treesit-query-language query)) + (parser (treesit-parser-create language)) + (old-ranges (treesit-parser-included-ranges parser)) + (new-ranges (treesit-query-range + host-lang query beg end)) + (set-ranges (treesit--clip-ranges + (treesit--merge-ranges + old-ranges new-ranges beg end) + (point-min) (point-max)))) + (dolist (parser (treesit-parser-list)) + (when (eq (treesit-parser-language parser) + language) + (treesit-parser-set-included-ranges + parser set-ranges)))))))) + +(defun treesit-parser-range-on (parser beg &optional end) + "Check if PARSER's range covers the portion between BEG and END. + +If it does, return the range covering that portion in the form +of (RANGE-BEG . RANGE-END), if not, return nil. If nil or +omitted, default END to BEG." + (let ((ranges (treesit-parser-included-ranges parser)) + (end (or end beg))) + (if (null ranges) + (cons (point-min) (point-max)) + (cl-loop for rng in ranges + if (<= (car rng) beg end (cdr rng)) + return rng + finally return nil)))) + +;;; Fontification + +(define-error 'treesit-font-lock-error + "Generic tree-sitter font-lock error" + 'treesit-error) + +(defvar-local treesit--font-lock-query-expand-range (cons 0 0) + "The amount to expand the start and end of the region when fontifying. +This should be a cons cell (START . END). When fontifying a +buffer, Emacs will move the start of the query range backward by +START amount, and the end of the query range by END amount. Both +START and END should be positive integers or 0. This doesn't +affect the fontified range. + +Sometimes, querying on some parser with a restricted range +returns nodes not in that range but before it, which breaks +fontification. Major modes can adjust this variable as a +temporarily fix.") + +(defvar-local treesit-font-lock-feature-list nil + "A list of lists of feature symbols. + +Use `treesit-font-lock-recompute-features' and +`font-lock-maximum-decoration' to configure enabled features. + +Each sublist represents a decoration level. +`font-lock-maximum-decoration' controls which levels are +activated. + +Inside each sublist are feature symbols, which correspond to the +:feature value of a query defined in `treesit-font-lock-rules'. +Removing a feature symbol from this list disables the +corresponding query during font-lock. + +Common feature names (for general programming languages) include +definition, type, assignment, builtin, constant, keyword, +string-interpolation, comment, doc, string, operator, property, +preprocessor, escape-sequence, key (in key-value pairs). Major +modes are free to subdivide or extend on these common features. +See the manual for more explanations on some of the features. + +For changes to this variable to take effect, run +`treesit-font-lock-recompute-features'.") + +(defvar-local treesit-font-lock-settings nil + "A list of SETTINGs for treesit-based fontification. + +The exact format of each SETTING is considered internal. Use +`treesit-font-lock-rules' to set this variable. + +Each SETTING has the form: + + (QUERY ENABLE FEATURE OVERRIDE) + +QUERY must be a compiled query. See Info node `(elisp)Pattern +Matching' for how to write a query and compile it. + +For SETTING to be activated for font-lock, ENABLE must be t. To +disable this SETTING, set ENABLE to nil. + +FEATURE is the \"feature name\" of the query. Users can control +which features are enabled with `font-lock-maximum-decoration' +and `treesit-font-lock-feature-list'. + +OVERRIDE is the override flag for this query. Its value can be +t, nil, append, prepend, keep. See more in +`treesit-font-lock-rules'.") + +(defun treesit-font-lock-rules (&rest query-specs) + "Return a value suitable for `treesit-font-lock-settings'. + +QUERY-SPECS is a series of QUERY-SPECs. Each QUERY-SPEC is a +QUERY preceded by multiple pairs of :KEYWORD and VALUE: + + :KEYWORD VALUE... QUERY + +QUERY is a tree-sitter query in either the string, s-expression +or compiled form. For each query, captured nodes are highlighted +with the capture name as its face. + +:KEYWORD and VALUE pairs preceding a QUERY add meta information +to QUERY. For example, + + (treesit-font-lock-rules + :language \\='javascript + :override t + :feature\\='constant + \\='((true) @font-lock-constant-face + (false) @font-lock-constant-face) + :language \\='html + :feature \\='script + \"(script_element) @font-lock-builtin-face\") + +For each QUERY, a :language keyword and a :feature keyword are +required. Each query's :feature is a symbol summarizing what the +query fontifies. It is used to allow users to enable/disable +certain features. See `treesit-font-lock-feature-list' for more. +Other keywords include: + + KEYWORD VALUE DESCRIPTION + :override nil If the region already has a face, + discard the new face. + t Always apply the new face. + `append' Append the new face to existing ones. + `prepend' Prepend the new face to existing ones. + `keep' Fill-in regions without an existing face. + +Capture names in QUERY should be face names like +`font-lock-keyword-face'. The captured node will be fontified +with that face. + +Capture names can also be function names, in which case the +function will be called with the following argument list: + + (NODE OVERRIDE START END &rest _) + +where NODE is the tree-sitter node object, OVERRIDE is the +override option of that rule, and START and END specify the region +to be fontified. This function should accept more arguments as +optional arguments for future extensibility, and it shouldn't +fontify text outside the region given by START and END. + +If a capture name is both a face and a function, the face takes +priority. If a capture name is not a face name nor a function +name, it is ignored." + ;; Other tree-sitter function don't tend to be called unless + ;; tree-sitter is enabled, which means tree-sitter must be compiled. + ;; But this function is usually call in `defvar' which runs + ;; regardless whether tree-sitter is enabled. So we need this + ;; guard. + (when (treesit-available-p) + (let (;; Tracks the current :language/:override/:toggle/:level value + ;; that following queries will apply to. + current-language current-override + current-feature + ;; The list this function returns. + (result nil)) + (while query-specs + (let ((token (pop query-specs))) + (pcase token + ;; (1) Process keywords. + (:language + (let ((lang (pop query-specs))) + (when (or (not (symbolp lang)) (null lang)) + (signal 'treesit-font-lock-error + `("Value of :language should be a symbol" + ,lang))) + (setq current-language lang))) + (:override + (let ((flag (pop query-specs))) + (when (not (memq flag '(t nil append prepend keep))) + (signal 'treesit-font-lock-error + `("Value of :override should be one of t, nil, append, prepend, keep" + ,flag)) + (signal 'wrong-type-argument + `((or t nil append prepend keep) + ,flag))) + (setq current-override flag))) + (:feature + (let ((var (pop query-specs))) + (when (or (not (symbolp var)) + (memq var '(t nil))) + (signal 'treesit-font-lock-error + `("Value of :feature should be a symbol" + ,var))) + (setq current-feature var))) + ;; (2) Process query. + ((pred treesit-query-p) + (when (null current-language) + (signal 'treesit-font-lock-error + `("Language unspecified, use :language keyword to specify a language for this query" ,token))) + (when (null current-feature) + (signal 'treesit-font-lock-error + `("Feature unspecified, use :feature keyword to specify the feature name for this query" ,token))) + (if (treesit-compiled-query-p token) + (push `(,current-language token) result) + (push `(,(treesit-query-compile current-language token) + t + ,current-feature + ,current-override) + result)) + ;; Clears any configurations set for this query. + (setq current-language nil + current-override nil + current-feature nil)) + (_ (signal 'treesit-font-lock-error + `("Unexpected value" ,token)))))) + (nreverse result)))) + +;; `font-lock-fontify-region-function' has the LOUDLY argument, but +;; `jit-lock-functions' doesn't pass that argument. So even if we set +;; `font-lock-verbose' to t, if jit-lock is enabled (and it's almost +;; always is), we don't get debug messages. So we add our own. +(defvar treesit--font-lock-verbose nil + "If non-nil, print debug messages when fontifying.") + +(defun treesit-font-lock-recompute-features (&optional add-list remove-list) + "Enable/disable font-lock features. + +Enable each feature in ADD-LIST, disable each feature in +REMOVE-LIST. + +If both ADD-LIST and REMOVE-LIST are omitted, recompute each +feature according to `treesit-font-lock-feature-list' and +`font-lock-maximum-decoration'. Let N be the value of +`font-lock-maximum-decoration', features in the first Nth sublist +of `treesit-font-lock-feature-list' are enabled, and the rest +features are disabled. If `font-lock-maximum-decoration' is t, +all features in `treesit-font-lock-feature-list' are enabled, and +the rest are disabled. + +ADD-LIST and REMOVE-LIST are each a list of feature symbols. The +same feature symbol cannot appear in both lists; the function +signals the `treesit-font-lock-error' error if that happens." + (when-let ((intersection (cl-intersection add-list remove-list))) + (signal 'treesit-font-lock-error + (list "ADD-LIST and REMOVE-LIST contain the same feature" + intersection))) + (let* ((level (font-lock-value-in-major-mode + font-lock-maximum-decoration)) + (base-features (cl-loop + for idx = 0 then (1+ idx) + for features in treesit-font-lock-feature-list + if (or (eq level t) + (>= level (1+ idx))) + append features)) + (features (cl-set-difference (cl-union base-features add-list) + remove-list)) + ;; If additive non-nil, we are configuring on top of the + ;; existing configuration, if nil, we are resetting + ;; everything according to `treesit-font-lock-feature-list'. + (additive (or add-list remove-list))) + (cl-loop for idx = 0 then (1+ idx) + for setting in treesit-font-lock-settings + for feature = (nth 2 setting) + for current-value = (nth 1 setting) + ;; Set the ENABLE flag for the setting. + do (setf (nth 1 (nth idx treesit-font-lock-settings)) + (cond + ((not additive) + (if (memq feature features) t nil)) + ((memq feature add-list) t) + ((memq feature remove-list) nil) + (t current-value)))))) + +(defun treesit-fontify-with-override (start end face override) + "Apply FACE to the region between START and END. +OVERRIDE can be nil, t, `append', `prepend', or `keep'. +See `treesit-font-lock-rules' for their semantic." + (pcase override + ('nil (unless (text-property-not-all + start end 'face nil) + (put-text-property start end 'face face))) + ('t (put-text-property start end 'face face)) + ('append (font-lock-append-text-property + start end 'face face)) + ('prepend (font-lock-prepend-text-property + start end 'face face)) + ('keep (font-lock-fillin-text-property + start end 'face face)) + (_ (signal 'treesit-font-lock-error + (list + "Unrecognized value of :override option" + override))))) + +(defun treesit--set-nonsticky (start end sym &optional remove) + "Set `rear-nonsticky' property between START and END. +Set the property to a list containing SYM. If there is already a +list, add SYM to that list. If REMOVE is non-nil, remove SYM +instead." + (let* ((prop (get-text-property start 'rear-nonsticky)) + (new-prop + (pcase prop + ((pred listp) ; PROP is a list or nil. + (if remove + (remove sym prop) + ;; We should make sure PORP doesn't contain SYM, but + ;; whatever. + (cons sym prop))) + ;; PROP is t. + (_ (if remove + nil + (list sym)))))) + (if (null new-prop) + (remove-text-properties start end '(rear-nonsticky nil)) + (put-text-property start end 'rear-nonsticky new-prop)))) + +(defun treesit--children-covering-range (node start end) + "Return a list of children of NODE covering a range. +The range is between START and END." + (if-let* ((child (treesit-node-first-child-for-pos node start)) + (result (list child))) + (progn + (while (and child (< (treesit-node-end child) end) + (setq child (treesit-node-next-sibling child))) + (push child result)) + (nreverse result)) + (list node))) + +(defun treesit--children-covering-range-recurse (node start end threshold) + "Return a list of children of NODE covering a range. +Recursively go down the parse tree and collect children, until +all nodes in the returned list are smaller than THRESHOLD. The +range is between START and END." + (let* ((child (treesit-node-first-child-for-pos node start)) + result) + (while (and child (<= (treesit-node-start child) end)) + ;; If child still too large, recurse down. Otherwise collect + ;; child. + (if (> (- (treesit-node-end child) + (treesit-node-start child)) + threshold) + (dolist (r (treesit--children-covering-range-recurse + child start end threshold)) + (push r result)) + (push child result)) + (setq child (treesit-node-next-sibling child))) + ;; If NODE has no child, keep NODE. + (or result node))) + +(defsubst treesit--node-length (node) + "Return the length of the text of NODE." + (- (treesit-node-end node) (treesit-node-start node))) + +(defvar-local treesit--font-lock-fast-mode nil + "If this variable is t, change the way we query so it's faster. +This is not a general optimization and should be RARELY needed! +See comments in `treesit-font-lock-fontify-region' for more +detail.") + +;; Some details worth explaining: +;; +;; 1. When we apply face to a node, we clip the face into the +;; currently fontifying region, this way we don't overwrite faces +;; applied by regexp-based font-lock. The clipped part will be +;; fontified fine when Emacs fontifies the region containing it. +;; +;; 2. If you insert an ending quote into a buffer, jit-lock only wants +;; to fontify that single quote, and (treesit-node-on start end) will +;; give you that quote node. We want to capture the string and apply +;; string face to it, but querying on the quote node will not give us +;; the string node. So we don't use treesit-node-on: using the root +;; node with a restricted range is very fast anyway (even in large +;; files of size ~10MB). Plus, querying the result of +;; `treesit-node-on' could still miss patterns even if we use some +;; heuristic to enlarge the node (how much to enlarge? to which +;; extent?), it's much safer to just use the root node. +;; +;; Sometimes the source file has some errors that cause tree-sitter to +;; parse it into a enormously tall tree (10k levels tall). In that +;; case querying the root node is very slow. So we try to get +;; top-level nodes and query them. This ensures that querying is fast +;; everywhere else, except for the problematic region. +;; +;; 3. It is possible to capture a node that's completely outside the +;; region between START and END: as long as the whole pattern +;; intersects the region, all the captured nodes in that pattern are +;; returned. If the node is outside of that region, (max node-start +;; start) and friends return bad values, so we filter them out. +;; However, we don't filter these nodes out if a function will process +;; the node, because could (and often do) fontify the relatives of the +;; captured node, not just the node itself. If we took out those +;; nodes author of those functions would be very confused. +(defun treesit-font-lock-fontify-region (start end &optional loudly) + "Fontify the region between START and END. +If LOUDLY is non-nil, display some debugging information." + (when (or loudly treesit--font-lock-verbose) + (message "Fontifying region: %s-%s" start end)) + (treesit-update-ranges start end) + (font-lock-unfontify-region start end) + (dolist (setting treesit-font-lock-settings) + (let* ((query (nth 0 setting)) + (enable (nth 1 setting)) + (override (nth 3 setting)) + (language (treesit-query-language query))) + (when-let ((nodes (list (treesit-buffer-root-node language))) + ;; Only activate if ENABLE flag is t. + (activate (eq t enable))) + (ignore activate) + + ;; If we run into problematic files, use the "fast mode" to + ;; try to recover. See comment #2 above for more explanation. + (when treesit--font-lock-fast-mode + (setq nodes (treesit--children-covering-range + (car nodes) start end))) + + ;; Query each node. + (dolist (sub-node nodes) + (let* ((delta-start (car treesit--font-lock-query-expand-range)) + (delta-end (cdr treesit--font-lock-query-expand-range)) + (start-time (current-time)) + (captures (treesit-query-capture + sub-node query + (max (- start delta-start) (point-min)) + (min (+ end delta-end) (point-max)))) + (end-time (current-time))) + ;; If for any query the query time is strangely long, + ;; switch to fast mode (see comments above). + (when (> (time-to-seconds (time-subtract end-time start-time)) + 0.01) + (setq-local treesit--font-lock-fast-mode t)) + + ;; For each captured node, fontify that node. + (with-silent-modifications + (dolist (capture captures) + (let* ((face (car capture)) + (node (cdr capture)) + (node-start (treesit-node-start node)) + (node-end (treesit-node-end node))) + ;; If node is not in the region, take them out. See + ;; comment #3 above for more detail. + (if (and (facep face) + (or (>= start node-end) (>= node-start end))) + (when (or loudly treesit--font-lock-verbose) + (message "Captured node %s(%s-%s) but it is outside of fontifing region" node node-start node-end)) + (cond + ((facep face) + (treesit-fontify-with-override + (max node-start start) (min node-end end) + face override)) + ((functionp face) + (funcall face node override start end))) + ;; Don't raise an error if FACE is neither a face nor + ;; a function. This is to allow intermediate capture + ;; names used for #match and #eq. + (when (or loudly treesit--font-lock-verbose) + (message "Fontifying text from %d to %d, Face: %s, Node: %s" + (max node-start start) (min node-end end) + face (treesit-node-type node)))))))))))) + `(jit-lock-bounds ,start . ,end)) + +(defun treesit--font-lock-notifier (ranges parser) + "Ensures updated parts of the parse-tree are refontified. +RANGES is a list of (BEG . END) ranges, PARSER is the tree-sitter +parser notifying of the change." + (with-current-buffer (treesit-parser-buffer parser) + (dolist (range ranges) + (when treesit--font-lock-verbose + (message "Notifier received range: %s-%s" + (car range) (cdr range))) + (put-text-property (car range) (cdr range) 'fontified nil)))) + +;;; Indent + +;; `comment-start' and `comment-end' assume there is only one type of +;; comment, and that the comment spans only one line. So they are not +;; sufficient for our purpose. + +(defvar-local treesit-comment-start nil + "Regular expression matching an opening comment token.") + +(defvar-local treesit-comment-end nil + "Regular expression matching a closing comment token.") + +(define-error 'treesit-indent-error + "Generic tree-sitter indentation error" + 'treesit-error) + +(defvar treesit--indent-verbose nil + "If non-nil, log progress when indenting.") + +(defvar-local treesit-simple-indent-rules nil + "A list of indent rule settings. +Each indent rule setting should be (LANGUAGE . RULES), +where LANGUAGE is a language symbol, and RULES is a list of + + (MATCHER ANCHOR OFFSET). + +MATCHER determines whether this rule applies, ANCHOR and OFFSET +together determines which column to indent to. + +A MATCHER is a function that takes three arguments (NODE PARENT +BOL). BOL is the point where we are indenting: the beginning of +line content, the position of the first non-whitespace character. +NODE is the largest (highest-in-tree) node starting at that +point. PARENT is the parent of NODE. + +If MATCHER returns non-nil, meaning the rule matches, Emacs then +uses ANCHOR to find an anchor, it should be a function that takes +the same argument (NODE PARENT BOL) and returns a point. + +Finally Emacs computes the column of that point returned by +ANCHOR and adds OFFSET to it, and indents to that column. OFFSET +can be an integer or a variable whose value is an integer. + +For MATCHER and ANCHOR, Emacs provides some convenient presets. +See `treesit-simple-indent-presets'.") + +(defvar treesit-simple-indent-presets + (list (cons 'match + (lambda + (&optional node-type parent-type node-field + node-index-min node-index-max) + (lambda (node parent &rest _) + (and (or (null node-type) + (string-match-p + node-type (or (treesit-node-type node) ""))) + (or (null parent-type) + (string-match-p + parent-type (treesit-node-type parent))) + (or (null node-field) + (string-match-p + node-field + (or (treesit-node-field-name node) ""))) + (or (null node-index-min) + (>= (treesit-node-index node) + node-index-min)) + (or (null node-index-max) + (<= (treesit-node-index node) + node-index-max)))))) + ;; TODO: Document if genuinely useful. + (cons 'n-p-gp + (lambda (node-t parent-t grand-parent-t) + (lambda (node parent &rest _) + (and (or (null node-t) + (string-match-p + node-t (or (treesit-node-type node) ""))) + (or (null parent-t) + (string-match-p + parent-t (treesit-node-type parent))) + (or (null grand-parent-t) + (string-match-p + grand-parent-t + (treesit-node-type + (treesit-node-parent parent)))))))) + (cons 'no-node (lambda (node &rest _) (null node))) + (cons 'parent-is (lambda (type) + (lambda (_n parent &rest _) + (string-match-p + type (treesit-node-type parent))))) + + (cons 'node-is (lambda (type) + (lambda (node &rest _) + (string-match-p + type (or (treesit-node-type node) ""))))) + (cons 'field-is (lambda (name) + (lambda (node &rest _) + (string-match-p + name (or (treesit-node-field-name node) ""))))) + (cons 'comment-end (lambda (_node _parent bol &rest _) + (save-excursion + (goto-char bol) + (looking-at-p treesit-comment-end)))) + ;; TODO: Document. + (cons 'catch-all (lambda (&rest _) t)) + + (cons 'query (lambda (pattern) + (lambda (node parent &rest _) + (cl-loop for capture + in (treesit-query-capture + parent pattern) + if (treesit-node-eq node (cdr capture)) + return t + finally return nil)))) + (cons 'first-sibling (lambda (_n parent &rest _) + (treesit-node-start + (treesit-node-child parent 0)))) + ;; TODO: Document. + (cons 'nth-sibling (lambda (n &optional named) + (lambda (_n parent &rest _) + (treesit-node-start + (treesit-node-child parent n named))))) + (cons 'parent (lambda (_n parent &rest _) + (treesit-node-start parent))) + (cons 'comment-start + (lambda (_n parent &rest _) + (save-excursion + (goto-char (treesit-node-start parent)) + (re-search-forward treesit-comment-start) + (point)))) + (cons 'comment-start-skip + (lambda (_n parent &rest _) + (save-excursion + (goto-char (treesit-node-start parent)) + (re-search-forward treesit-comment-start) + (skip-syntax-forward "-") + (point)))) + ;; TODO: Document. + (cons 'grand-parent + (lambda (_n parent &rest _) + (treesit-node-start (treesit-node-parent parent)))) + (cons 'parent-bol (lambda (_n parent &rest _) + (save-excursion + (goto-char (treesit-node-start parent)) + (back-to-indentation) + (point)))) + (cons 'prev-sibling (lambda (node &rest _) + (treesit-node-start + (treesit-node-prev-sibling node)))) + (cons 'no-indent (lambda (_n _p bol &rest _) bol)) + (cons 'prev-line (lambda (_n _p bol &rest _) + (save-excursion + (goto-char bol) + (forward-line -1) + (skip-chars-forward " \t")))) + (cons 'point-min (lambda (&rest _) (point-min))) + ;; TODO: Document. + (cons 'and (lambda (&rest fns) + (lambda (node parent bol &rest _) + (cl-reduce (lambda (a b) (and a b)) + (mapcar (lambda (fn) + (funcall fn node parent bol)) + fns))))) + (cons 'or (lambda (&rest fns) + (lambda (node parent bol &rest _) + (cl-reduce (lambda (a b) (or a b)) + (mapcar (lambda (fn) + (funcall fn node parent bol)) + fns))))) + (cons 'not (lambda (fn) + (lambda (node parent bol &rest _) + (debug) + (not (funcall fn node parent bol))))) + (cons 'list (lambda (&rest fns) + (lambda (node parent bol &rest _) + (mapcar (lambda (fn) + (funcall fn node parent bol)) + fns))))) + "A list of presets. +These presets that can be used as MATHER and ANCHOR in +`treesit-simple-indent-rules'. MACHTERs and ANCHORs are +functions that take 3 arguments: NODE, PARENT and BOL. + +MATCHER: + +\(match NODE-TYPE PARENT-TYPE NODE-FIELD NODE-INDEX-MIN NODE-INDEX-MAX) + + NODE-TYPE checks for NODE's type, PARENT-TYPE checks for + PARENT's type, NODE-FIELD checks for the field name of NODE + in PARENT, NODE-INDEX-MIN and NODE-INDEX-MAX check for + NODE's index in PARENT. Therefore, to match the first child + where PARENT is \"argument_list\", use + + (match nil \"argument_list\" nil nil 0 0). + + NODE-TYPE, PARENT-TYPE, and NODE-FIELD are regexps. + +no-node + + Matches the case where NODE is nil, i.e., there is no node + that starts at point. This is the case when indenting an + empty line. + +\(parent-is TYPE) + + Check that PARENT's type matches regexp TYPE. + +\(node-is TYPE) + + Checks that NODE's type matches regexp TYPE. + +\(query QUERY) + + Queries PARENT with QUERY, and checks if NODE is + captured (by any capture name). + +comment-end + + Matches if text after point matches `treesit-comment-end'. + +ANCHOR: + +first-sibling + + Returns the start of the first child of PARENT. + +parent + + Returns the start of PARENT. + +parent-bol + + Returns the beginning of non-space characters on the line where + PARENT is on. + +prev-sibling + + Returns the start of NODE's previous sibling. + +no-indent + + Returns the start of NODE. + +prev-line + + Returns the first non-whitespace character on the previous line. + +point-min + + Returns the beginning of buffer, which is always at column 0. + +comment-start + + Returns the position after a match for `treesit-comment-start'. + Assumes PARENT is a comment node. + +comment-start-skip + + Goes to the position that comment-start would return, skips + whitespace after that, and returns the resulting position. + Assumes PARENT is a comment node.") + +(defun treesit--simple-indent-eval (exp) + "Evaluate EXP. + +If EXP is an application and the function is a key in +`treesit-simple-indent-presets', use the corresponding value as +the function." + ;; We don't want to match uncompiled lambdas, so make sure this cons + ;; is not a function. We could move the condition functionp + ;; forward, but better be explicit. + (cond ((and (consp exp) (not (functionp exp))) + (apply (treesit--simple-indent-eval (car exp)) + (mapcar #'treesit--simple-indent-eval + (cdr exp)))) + ;; Presets override functions, so this condition comes before + ;; `functionp'. + ((alist-get exp treesit-simple-indent-presets) + (alist-get exp treesit-simple-indent-presets)) + ((functionp exp) exp) + ((symbolp exp) + (if (null exp) + exp + ;; Matchers only return lambdas, anchors only return + ;; integer, so we should never see a variable. + (signal 'treesit-indent-error + (list "Couldn't find the preset corresponding to expression" + exp)))) + (t exp))) + +;; This variable might seem unnecessary: why split +;; `treesit-indent' and `treesit-simple-indent' into two +;; functions? We add this variable in between because later we might +;; add more powerful indentation engines, and that new engine can +;; probably share `treesit-indent'. It is also useful, suggested +;; by Stefan M, to have a function that figures out how much to indent +;; but doesn't actually performs the indentation, because we might +;; want to know where will a node indent to if we put it at some other +;; location, and use that information to calculate the actual +;; indentation. And `treesit-simple-indent' is that function. I +;; forgot the example Stefan gave, but it makes a lot of sense. +(defvar treesit-indent-function #'treesit-simple-indent + "Function used by `treesit-indent' to do some of the work. + +This function is called with + + (NODE PARENT BOL &rest _) + +and returns + + (ANCHOR . OFFSET). + +BOL is the position of the beginning of the line; NODE is the +\"largest\" node that starts at BOL; PARENT is its parent; ANCHOR +is a point (not a node), and OFFSET is a number. Emacs finds the +column of ANCHOR and adds OFFSET to it as the final indentation +of the current line.") + +(defun treesit--indent-1 () + "Indent the current line. +Return (ANCHOR . OFFSET). This function is used by +`treesit-indent' and `treesit-indent-region'." + ;; Basically holds the common part between the two indent function. + (let* ((bol (save-excursion + (forward-line 0) + (skip-chars-forward " \t") + (point))) + (smallest-node + (cond ((null (treesit-parser-list)) nil) + ((eq 1 (length (treesit-parser-list))) + (treesit-node-at bol)) + ((treesit-language-at (point)) + (treesit-node-at bol (treesit-language-at (point)))) + (t (treesit-node-at bol)))) + (node (treesit-parent-while + smallest-node + (lambda (node) + (eq bol (treesit-node-start node)))))) + (let* + ((parser (if smallest-node + (treesit-node-parser smallest-node) + nil)) + ;; NODE would be nil if BOL is on a whitespace. In that case + ;; we set PARENT to the "node at point", which would + ;; encompass the whitespace. + (parent (cond ((and node parser) + (treesit-node-parent node)) + (t (treesit-node-on bol bol))))) + (funcall treesit-indent-function node parent bol)))) + +(defun treesit-indent () + "Indent according to the result of `treesit-indent-function'." + (treesit-update-ranges (line-beginning-position) + (line-end-position)) + ;; We don't return 'noindent even if no rules match, because + ;; `indent-for-tab-command' tries to indent itself when we return + ;; 'noindent, which leads to wrong indentation at times. + (pcase-let* ((`(,anchor . ,offset) (treesit--indent-1))) + (when (and anchor offset) + (let ((col (+ (save-excursion + (goto-char anchor) + (current-column)) + offset)) + (delta (- (point-max) (point)))) + (indent-line-to col) + ;; Now point is at the end of indentation. If we started + ;; from within the line, go back to where we started. + (when (> (- (point-max) delta) (point)) + (goto-char (- (point-max) delta))))))) + +;; Batch size can't be too large, because we put markers on each +;; ANCHOR, so a batch size of 400 lines means 400 markers. +(defvar treesit--indent-region-batch-size 400 + "How many lines of indent value do we precompute. +In `treesit-indent-region' we indent in batches: precompute +indent for each line, apply them in one go, let parser reparse, +and do it again. This way the parser doesn't need to unnecessarily +reparse after indenting every single line.") + +(defun treesit-indent-region (beg end) + "Indent the region between BEG and END. +Similar to `treesit-indent', but indent a region instead." + (treesit-update-ranges beg end) + ;; We indent `treesit--indent-region-batch-size' lines at a time, to + ;; reduce the number of times the parser needs to re-parse. In each + ;; batch, we go through each line and calculate the anchor and + ;; offset as usual, but instead of modifying the buffer, we save + ;; these information in a vector. Once we've collected ANCHOR and + ;; OFFSET for each line in the batch, we go through each line again + ;; and apply the changes. Now that buffer is modified, we need to + ;; reparse the buffer before continuing to indent the next batch. + (let* ((meta-len 2) + (vector-len (* meta-len treesit--indent-region-batch-size)) + ;; This vector saves the indent meta for each line in the + ;; batch. It is a vector [ANCHOR OFFSET ANCHOR OFFSET...]. + ;; ANCHOR is a marker on the anchor position, and OFFSET is + ;; an integer. ANCHOR and OFFSET are either both nil, or + ;; both valid. + (meta-vec (make-vector vector-len 0)) + (lines-left-to-move 0) + (end (copy-marker end t)) + (idx 0) + (starting-pos 0) + (announce-progress (> (- end beg) 80000))) + (save-excursion + (goto-char beg) + ;; First pass. Go through each line and compute the + ;; indentation. + (while (and (eq lines-left-to-move 0) (< (point) end)) + (setq idx 0 + starting-pos (point)) + (while (and (eq lines-left-to-move 0) + (< idx treesit--indent-region-batch-size) + (< (point) end)) + (if (looking-at (rx (* whitespace) eol) t) + ;; Unlike in `indent-line' where we sometimes pre-indent + ;; an empty line, We don't indent empty lines in + ;; `indent-region'. Set ANCHOR and OFFSET to nil. + (setf (aref meta-vec (* idx meta-len)) nil + (aref meta-vec (+ 1 (* idx meta-len))) nil) + (pcase-let* ((`(,anchor . ,offset) (treesit--indent-1)) + (marker (aref meta-vec (* idx meta-len)))) + ;; Set ANCHOR. + (when anchor + (if (markerp marker) + (move-marker marker anchor) + (setf (aref meta-vec (* idx meta-len)) + (copy-marker anchor t)))) + ;; SET OFFSET. + (setf (aref meta-vec (+ 1 (* idx meta-len))) offset))) + (cl-incf idx) + (setq lines-left-to-move (forward-line 1))) + ;; Now IDX = last valid IDX + 1. + (goto-char starting-pos) + ;; Second pass, go to each line and apply the indentation. + (dotimes (jdx idx) + (let ((anchor (aref meta-vec (* jdx meta-len))) + (offset (aref meta-vec (+ 1 (* jdx meta-len))))) + (when offset + (let ((col (save-excursion + (goto-char anchor) + (+ offset (current-column))))) + (indent-line-to col)))) + (forward-line 1)) + (when announce-progress + (message "Indenting region...%s%%" + (/ (* (- (point) beg) 100) (- end beg))))) + ;; Delete markers. + (dotimes (idx treesit--indent-region-batch-size) + (let ((marker (aref meta-vec (* idx meta-len)))) + (when (markerp marker) + (move-marker marker nil)))) + (move-marker end nil)))) + +(defun treesit-simple-indent (node parent bol) + "Calculate indentation according to `treesit-simple-indent-rules'. + +BOL is the position of the first non-whitespace character on the +current line. NODE is the largest node that starts at BOL, +PARENT is NODE's parent. + +Return (ANCHOR . OFFSET) where ANCHOR is a node, OFFSET is the +indentation offset, meaning indent to align with ANCHOR and add +OFFSET." + (if (null parent) + (progn (when treesit--indent-verbose + (message "PARENT is nil, not indenting")) + (cons nil nil)) + (let* ((language (treesit-node-language parent)) + (rules (alist-get language + treesit-simple-indent-rules))) + (cl-loop for rule in rules + for pred = (nth 0 rule) + for anchor = (nth 1 rule) + for offset = (nth 2 rule) + if (treesit--simple-indent-eval + (list pred node parent bol)) + do (when treesit--indent-verbose + (message "Matched rule: %S" rule)) + and + return + (let ((anchor-pos + (treesit--simple-indent-eval + (list anchor node parent bol)))) + (cons anchor-pos (if (symbolp offset) + (symbol-value offset) + offset))) + finally return + (progn (when treesit--indent-verbose + (message "No matched rule")) + (cons nil nil)))))) + +(defun treesit-check-indent (mode) + "Check current buffer's indentation against a major mode MODE. + +Pop up a diff buffer showing the difference. Correct +indentation (target) is in green, current indentation is in red." + (interactive "CTarget major mode: ") + (let ((source-buf (current-buffer))) + (with-temp-buffer + (insert-buffer-substring source-buf) + (funcall mode) + (indent-region (point-min) (point-max)) + (diff-buffers source-buf (current-buffer))))) + +(defun treesit--indent-rules-optimize (rules) + "Optimize simple indent RULES. +RULES should be a value suitable for +`treesit-simple-indent-rules'. Return the optimized version of +RULES." + ;; Right now this function just compiles queries. It doesn't + ;; byte-compile matchers and anchors because it doesn't make much + ;; difference. + (cl-loop for setting in rules + for lang = (car setting) + for indent-rules = (cdr setting) + collect + (cl-labels + ;; Optimize a matcher or anchor. + ((optimize-func (func) + (pcase func + (`(query ,qry) + (list 'query (treesit-query-compile lang qry))) + (_ func))) + ;; Optimize a rule (MATCHER ANCHOR OFFSET). + (optimize-rule (rule) + (let ((matcher (nth 0 rule)) + (anchor (nth 1 rule)) + (offset (nth 2 rule))) + (list (optimize-func matcher) + (optimize-func anchor) + offset)))) + (cons lang (mapcar #'optimize-rule indent-rules))))) + +;;; Search + +(defun treesit-search-forward-goto + (node predicate &optional start backward all) + "Search forward for a node and move to its end position. + +Stop at the first node after NODE that matches PREDICATE. +PREDICATE can be either a regexp that matches against each node's +type case-insensitively, or a function that takes a node and +returns nil/non-nil for match/no match. + +If a node matches, move to that node and return the node, +otherwise return nil. If START is non-nil, stop at the +beginning rather than the end of a node. + +This function guarantees that the matched node it returns makes +progress in terms of buffer position: the start/end position of +the returned node is always STRICTLY greater/less than that of +NODE. + +BACKWARD and ALL are the same as in `treesit-search-forward'." + (when-let* ((start-pos (if start + (treesit-node-start node) + (treesit-node-end node))) + (current-pos start-pos)) + ;; When searching forward and stopping at beginnings, or search + ;; backward stopping at ends, it is possible to "roll back" in + ;; position. Take three nodes N1, N2, N3 as an example, if we + ;; start at N3, search for forward for beginning, and N1 matches, + ;; we would stop at beg of N1, which is backwards! So we skip N1 + ;; and keep going. + ;; + ;; |<--------N1------->| + ;; |<--N2-->| |<--N3-->| + (while (and node (if backward + (>= current-pos start-pos) + (<= current-pos start-pos))) + (setq node (treesit-search-forward + node predicate backward all)) + (setq current-pos (if start + (treesit-node-start node) + (treesit-node-end node)))) + (cond + ;; When there is a match and match made progress, go to the + ;; result position. + ((and node + (if backward + (< current-pos (point)) + (> current-pos (point)))) + (goto-char current-pos))) + node)) + +;;; Navigation + +(defvar-local treesit-defun-type-regexp nil + "A regexp that matches the node type of defun nodes. +For example, \"(function|class)_definition\". + +This is used by `treesit-beginning-of-defun' and friends.") + +(defvar-local treesit-defun-prefer-top-level nil + "When non-nil, `treesit-beginning-of-defun' prefers top-level defun. + +In some languages, a defun (function, class, struct) could be +nested in another one. Normally `treesit-beginning-of-defun' +just finds the first defun it encounter. If this variable's +value is t, `treesit-beginning-of-defun' tries to find the +top-level defun, and ignores nested ones. + +This variable can also be a list of tree-sitter node type +regexps. Then, when `treesit-beginning-of-defun' finds a defun +node and that node's type matches one in the list, +`treesit-beginning-of-defun' finds the top-level node matching +that particular regexp (as opposed to any node matched by +`treesit-defun-type-regexp').") + +(defun treesit--defun-maybe-top-level (node) + "Maybe return the top-level equivalent of NODE. +For the detailed semantic see `treesit-defun-prefer-top-level'." + (pcase treesit-defun-prefer-top-level + ('nil node) + ('t (or (treesit-node-top-level + node treesit-defun-type-regexp) + node)) + ((pred consp) + (cl-loop + for re in treesit-defun-prefer-top-level + if (string-match-p re (treesit-node-type node)) + return (or (treesit-node-top-level node re) + node) + finally return node)))) + +(defun treesit-beginning-of-defun (&optional arg) + "Tree-sitter `beginning-of-defun' function. +ARG is the same as in `beginning-of-defun'." + (let ((arg (or arg 1)) + (node (treesit-node-at (point)))) + (if (> arg 0) + ;; Go backward. + (while (and (> arg 0) + (setq node (treesit-search-forward-goto + node treesit-defun-type-regexp t t))) + (setq node (treesit--defun-maybe-top-level node)) + (setq arg (1- arg))) + ;; Go forward. + (while (and (< arg 0) + (setq node (treesit-search-forward-goto + node treesit-defun-type-regexp))) + (setq node (treesit--defun-maybe-top-level node)) + (setq arg (1+ arg)))) + (when node + (goto-char (treesit-node-start node)) + t))) + +(defun treesit-end-of-defun () + "Tree-sitter `end-of-defun' function." + ;; Why not simply get the largest node at point: when point is at + ;; (point-min), that gives us the root node. + (let* ((node (treesit-search-forward + (treesit-node-at (point)) treesit-defun-type-regexp t t)) + (top (treesit--defun-maybe-top-level node))) + (goto-char (treesit-node-end top)))) + +;;; Activating tree-sitter + +(defun treesit-ready-p (language &optional quiet) + "Check whether tree-sitter is ready to be used for MODE and LANGUAGE. + +LANGUAGE is the language symbol to check for availability. +It can also be a list of language symbols. + +If tree-sitter is not ready, emit a warning and return nil. If +the user has chosen to activate tree-sitter for LANGUAGE and +tree-sitter is ready, return non-nil. If QUIET is t, don't emit +a warning in either case; if quiet is `message', display a message +instead of emitting a warning." + (let ((language-list (if (consp language) + language + (list language))) + msg) + ;; Check for each condition and set MSG. + (catch 'term + (when (not (treesit-available-p)) + (setq msg "tree-sitter library is not compiled with Emacs") + (throw 'term nil)) + (when (> (position-bytes (max (point-min) (1- (point-max)))) + treesit-max-buffer-size) + (setq msg "buffer larger than `treesit-max-buffer-size'") + (throw 'term nil)) + (dolist (lang language-list) + (pcase-let ((`(,available . ,err) + (treesit-language-available-p lang t))) + (when (not available) + (setq msg (format "language definition for %s is unavailable (%s): %s" + lang (nth 0 err) + (string-join + (mapcar (lambda (x) (format "%s" x)) + (cdr err)) + " "))) + (throw 'term nil))))) + ;; Decide if all conditions met and whether emit a warning. + (if (not msg) + t + (setq msg (concat "Cannot activate tree-sitter, because " msg)) + (pcase quiet + ('nil (display-warning 'treesit msg)) + ('message (message "%s" msg))) + nil))) + +(defun treesit-major-mode-setup () + "Activate tree-sitter to power major-mode features. + +If `treesit-font-lock-settings' is non-nil, setup fontification and +enable `font-lock-mode'. + +If `treesit-simple-indent-rules' is non-nil, setup indentation. + +If `treesit-defun-type-regexp' is non-nil, setup +`beginning/end-of-defun' functions. + +Make sure necessary parsers are created for the current buffer +before calling this function." + ;; Font-lock. + (when treesit-font-lock-settings + ;; `font-lock-mode' wouldn't setup properly if + ;; `font-lock-defaults' is nil, see `font-lock-specified-p'. + (setq-local font-lock-defaults + '( nil nil nil nil + (font-lock-fontify-syntactically-function + . treesit-font-lock-fontify-region))) + (font-lock-mode 1) + (treesit-font-lock-recompute-features) + (dolist (parser (treesit-parser-list)) + (treesit-parser-add-notifier + parser #'treesit--font-lock-notifier))) + ;; Indent. + (when treesit-simple-indent-rules + (setq-local treesit-simple-indent-rules + (treesit--indent-rules-optimize + treesit-simple-indent-rules)) + (setq-local indent-line-function #'treesit-indent) + (setq-local indent-region-function #'treesit-indent-region)) + ;; Navigation. + (when treesit-defun-type-regexp + (setq-local beginning-of-defun-function #'treesit-beginning-of-defun) + (setq-local end-of-defun-function #'treesit-end-of-defun))) + +;;; Debugging + +(defvar-local treesit--inspect-name nil + "Used by `treesit-inspect-mode' to show node name in mode-line.") + +(defun treesit-inspect-node-at-point (&optional arg) + "Show information of the node at point. +If called interactively, show in echo area, otherwise set +`treesit--inspect-name' (which will appear in the mode-line +if `treesit-inspect-mode' is enabled). Uses the first parser +in `treesit-parser-list'." + (interactive "p") + ;; NODE-LIST contains all the node that starts at point. + (let* ((node-list + (cl-loop for node = (treesit-node-at (point)) + then (treesit-node-parent node) + while node + if (eq (treesit-node-start node) + (point)) + collect node)) + (largest-node (car (last node-list))) + (parent (treesit-node-parent largest-node)) + ;; node-list-acending contains all the node bottom-up, then + ;; the parent. + (node-list-acending + (if (null largest-node) + ;; If there are no nodes that start at point, just show + ;; the node at point and its parent. + (list (treesit-node-at (point)) + (treesit-node-parent + (treesit-node-at (point)))) + (append node-list (list parent)))) + (name "")) + ;; We draw nodes like (parent field-name: (node)) recursively, + ;; so it could be (node1 field-name: (node2 field-name: (node3))). + (dolist (node node-list-acending) + (setq + name + (concat + (if (treesit-node-field-name node) + (format " %s: " (treesit-node-field-name node)) + " ") + (if (treesit-node-check node 'named) "(" "\"") + (propertize (or (treesit-node-type node) "N/A") + 'face + (if (treesit-node-eq node largest-node) + 'bold nil)) + name + (if (treesit-node-check node 'named) ")" "\"")))) + (setq treesit--inspect-name name) + (force-mode-line-update) + (when arg + (if node-list + (message "%s" treesit--inspect-name) + (message "No node at point"))))) + +(define-minor-mode treesit-inspect-mode + "Minor mode that displays in the mode-line the node which starts at point. + +When this mode is enabled, the mode-line displays + + PARENT FIELD-NAME: (NODE FIELD-NAME: (CHILD (...))) + +where NODE, CHILD, etc, are nodes which begin at point. PARENT +is the parent of NODE. NODE is displayed in bold typeface. +FIELD-NAMEs are field names of NODE and CHILD, etc (see Info +node `(elisp)Language Definitions', heading \"Field names\"). + +If no node starts at point, i.e., point is in the middle of a +node, then the mode line displays the earliest node that spans point, +and its immediate parent. + +This minor mode doesn't create parsers on its own. It uses the first +parser in `treesit-parser-list'." + :lighter nil + (if treesit-inspect-mode + (progn + (add-hook 'post-command-hook + #'treesit-inspect-node-at-point 0 t) + (add-to-list 'mode-line-misc-info + '(:eval treesit--inspect-name))) + (remove-hook 'post-command-hook + #'treesit-inspect-node-at-point t) + (setq mode-line-misc-info + (remove '(:eval treesit--inspect-name) + mode-line-misc-info)))) + +(defun treesit-query-validate (language query) + "Check if QUERY is valid for LANGUAGE. +If QUERY is invalid, display the query in a popup buffer, jump +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-parser-create language) + (condition-case err + (progn (treesit-query-capture language query) + (message "QUERY is valid")) + (treesit-query-error + (with-current-buffer buf + (let* ((data (cdr err)) + (message (nth 0 data)) + (start (nth 1 data))) + (erase-buffer) + (insert (treesit-query-expand query)) + (goto-char start) + (search-forward " " nil t) + (put-text-property start (point) 'face 'error) + (message "%s" (buffer-substring start (point))) + (goto-char (point-min)) + (insert (format "%s: %d\n" message start)) + (forward-char start))) + (pop-to-buffer buf)))))) + +;;; Explorer + +(defvar-local treesit--explorer-buffer nil + "Buffer used to display the syntax tree.") + +(defvar-local treesit--explorer-source-buffer nil + "Source buffer corresponding to the playground buffer.") + +(defvar-local treesit--explorer-language nil + "The language used in the playground.") + +(defvar-local treesit--explorer-refresh-timer nil + "Timer for refreshing the syntax tree buffer.") + +(defvar-local treesit--explorer-highlight-overlay nil + "Overlay used to highlight in syntax tree and source buffer.") + +(defvar-local treesit--explorer-last-node nil + "Last top-level node used to generate syntax tree.") + +(defvar treesit-explore-mode) + +(defun treesit--explorer--nodes-to-highlight (language) + "Return nodes for LANGUAGE covered in region. +This function tries to return the largest node possible. If the +region covers exactly one node, that node is returned (in a +list). If the region covers more than one node, two nodes are +returned: the very first one in the region and the very last one +in the region." + (let* ((beg (region-beginning)) + (end (region-end)) + (node (treesit-node-on beg end language)) + (node (or (treesit-parent-while + node + (lambda (n) + (<= beg (treesit-node-start n) + (treesit-node-end n) end))) + node))) + ;; If NODE is completely contained in the region, return NODE, + ;; otherwise return its children that are in the region. + (if (<= beg (treesit-node-start node) + (treesit-node-end node) end) + (list node) + (list (treesit-node-at beg) + (treesit-search-forward + (treesit-node-at end) + (lambda (n) + (<= (treesit-node-end n) end)) + t t))))) + +(defun treesit--explorer-refresh () + "Update the syntax tree buffer." + (when (and treesit-explore-mode + (buffer-live-p treesit--explorer-buffer)) + (let* ((root (treesit-node-on + (window-start) (window-end) treesit--explorer-language)) + ;; Only highlight the current top-level construct. + ;; Highlighting the whole buffer is slow and unnecessary. + (top-level (treesit-node-first-child-for-pos + root (if (eolp) + (max (point-min) (1- (point))) + (point)) + t)) + ;; Only highlight node when region is active, if we + ;; highlight node at point the syntax tree is too jumpy. + (nodes-hl + (when (region-active-p) + (treesit--explorer--nodes-to-highlight + treesit--explorer-language))) + ;; If we didn't edit the buffer nor change the top-level + ;; node, don't redraw the whole syntax tree. + (highlight-only (treesit-node-eq + top-level treesit--explorer-last-node)) + (source-buffer (current-buffer))) + (setq-local treesit--explorer-last-node top-level) + (with-current-buffer treesit--explorer-buffer + (let ((inhibit-read-only t)) + (setq-local treesit--explorer-source-buffer source-buffer) + ;; Redraw the syntax tree or just rehighlight the focused + ;; node. + (when (and top-level (not highlight-only)) + (erase-buffer) + (treesit--explorer-draw-node top-level)) + (when-let ((pos (treesit--explorer-highlight-node nodes-hl)) + (window (get-buffer-window + treesit--explorer-buffer))) + (if highlight-only + (goto-char pos) + ;; If HIGHLIGHT-ONLY is nil, we erased the buffer and + ;; re-inserted text, scroll down from the very top until + ;; we can see the highlighted node. + (goto-char (point-min)) + (while (and (null (pos-visible-in-window-p pos window)) + (= (forward-line 4) 0)) + (set-window-start window (point)))) + (set-window-point window pos))))))) + +(defun treesit--explorer-post-command (&rest _) + "Post-command function that runs in the source buffer." + (when treesit-explore-mode + (when treesit--explorer-highlight-overlay + (delete-overlay treesit--explorer-highlight-overlay)) + (when treesit--explorer-refresh-timer + (cancel-timer treesit--explorer-refresh-timer)) + (setq-local treesit--explorer-refresh-timer + (run-with-timer 0.1 nil #'treesit--explorer-refresh)))) + +(defun treesit--explorer-jump (button) + "Mark the original text corresponding to BUTTON." + (interactive) + (when (and (derived-mode-p 'treesit--explorer-tree-mode) + (buffer-live-p treesit--explorer-source-buffer)) + (with-current-buffer treesit--explorer-source-buffer + (let ((start (button-get button 'node-start)) + (end (button-get button 'node-end))) + (when treesit--explorer-highlight-overlay + (delete-overlay treesit--explorer-highlight-overlay)) + (setq-local treesit--explorer-highlight-overlay + (make-overlay start end nil t nil)) + (overlay-put treesit--explorer-highlight-overlay + 'face 'highlight))))) + +(defun treesit--explorer-highlight-node (nodes) + "Highlight nodes in NODES in the syntax tree buffer. +Return the start of the syntax tree text corresponding to NODE." + (when treesit--explorer-highlight-overlay + (delete-overlay treesit--explorer-highlight-overlay)) + (let ((start-node (car nodes)) + (end-node (car (last nodes))) + start end) + (when (and start-node end-node) + (cl-loop for ov in (overlays-in (point-min) (point-max)) + while (or (null start) (null end)) + if (treesit-node-eq start-node + (overlay-get ov 'treesit-node)) + do (setq start (overlay-start ov)) + if (treesit-node-eq end-node (overlay-get ov 'treesit-node)) + do (setq end (overlay-end ov))) + (when (and start end) + (setq-local treesit--explorer-highlight-overlay + (make-overlay start end)) + (overlay-put treesit--explorer-highlight-overlay + 'face 'highlight) + start)))) + +(defun treesit--explorer-draw-node (node) + "Draw the syntax tree of NODE. + +When this function is called, point should be at the position +where the node should start. When this function returns, it +leaves point at the end of the last line of NODE." + (let* ((type (treesit-node-type node)) + (field-name (treesit-node-field-name node)) + (children (treesit-node-children node)) + (named (treesit-node-check node 'named)) + ;; Column number of the start of the field-name, aka start of + ;; the whole node. + (before-field-column (current-column)) + ;; Column number after the field-name. + after-field-column + ;; Column number after the type. + after-type-column + ;; Are all children suitable for inline? + (all-children-inline + (eq 0 (apply #'+ (mapcar #'treesit-node-child-count children)))) + ;; If the child is the first child, we can inline, if the + ;; previous child is suitable for inline, this child can + ;; inline, if the previous child is not suitable for inline, + ;; this child cannot inline. + (can-inline t) + ;; The beg and end of this node. + beg end) + (when treesit--explorer-highlight-overlay + (delete-overlay treesit--explorer-highlight-overlay)) + + (setq beg (point)) + ;; Draw field name. If all children are suitable for inline, we + ;; draw everything in one line, other wise draw field name and the + ;; rest of the node in two lines. + (when field-name + (insert field-name ": ") + (when (and children (not all-children-inline)) + (insert "\n") + (indent-to-column (1+ before-field-column)))) + (setq after-field-column (current-column)) + + ;; Draw type. + (if named + (progn + (insert "(") + (insert-text-button + type 'action #'treesit--explorer-jump + 'follow-link t + 'node-start (treesit-node-start node) + 'node-end (treesit-node-end node))) + (pcase type + ("\n" (insert "\\n")) + ("\t" (insert "\\t")) + (" " (insert "SPC")) + (_ (insert type)))) + (setq after-type-column (current-column)) + + ;; Draw children. + (dolist (child children) + ;; If a child doesn't have children, it is suitable for inline. + (let ((draw-inline (eq 0 (treesit-node-child-count child))) + (children-indent (1+ after-field-column))) + (while + ;; This form returns t if it wants to run another + ;; iteration, returns nil if it wants to stop. + (if (and draw-inline can-inline) + ;; Draw children on the same line. + (let ((inline-beg (point))) + (insert " ") + (treesit--explorer-draw-node child) + ;; If we exceeds window width, draw on the next line. + (if (< (current-column) (window-width)) + nil + (delete-region inline-beg (point)) + (setq draw-inline nil + children-indent (1+ after-type-column)) + t)) + ;; Draw children on the new line. + (insert "\n") + (indent-to-column children-indent) + (treesit--explorer-draw-node child) + nil)) + (setq can-inline draw-inline))) + + ;; Done drawing children, draw the ending paren. + (when named (insert ")")) + (setq end (point)) + + ;; Associate the text with NODE, so we can later find a piece of + ;; text by a node. + (let ((ov (make-overlay beg end))) + (overlay-put ov 'treesit-node node) + (overlay-put ov 'evaporate t) + (when (not named) + (overlay-put ov 'face 'shadow))))) + +(define-derived-mode treesit--explorer-tree-mode special-mode + "TS Explorer" + "Mode for displaying syntax trees for `treesit-explore-mode'." + nil) + +(define-minor-mode treesit-explore-mode + "Enable exploring the current buffer's syntax tree. +Pops up a window showing the syntax tree of the source in the +current buffer in real time. The corresponding node enclosing +the text in the active region is highlighted in the explorer +window." + :lighter " TSplay" + (if treesit-explore-mode + (progn + (unless (buffer-live-p treesit--explorer-buffer) + (setq-local treesit--explorer-buffer + (get-buffer-create + (format "*tree-sitter playground for %s*" + (buffer-name)))) + (setq-local treesit--explorer-language + (intern (completing-read + "Language: " + (mapcar #'treesit-parser-language + (treesit-parser-list))))) + (with-current-buffer treesit--explorer-buffer + (treesit--explorer-tree-mode))) + (display-buffer treesit--explorer-buffer + (cons nil '((inhibit-same-window . t)))) + (treesit--explorer-refresh) + (add-hook 'post-command-hook + #'treesit--explorer-post-command 0 t) + (setq-local treesit--explorer-last-node nil)) + (remove-hook 'post-command-hook + #'treesit--explorer-post-command t) + (kill-buffer treesit--explorer-buffer))) + +;;; Etc + +(declare-function find-library-name "find-func.el") +(defun treesit--check-manual-coverage () + "Print tree-sitter functions missing from the manual in message buffer." + (interactive) + (require 'find-func) + (let ((functions-in-source + (with-temp-buffer + (insert-file-contents (find-library-name "treesit")) + (cl-remove-if + (lambda (name) (string-match "treesit--" name)) + (cl-sort + (save-excursion + (goto-char (point-min)) + (cl-loop while (re-search-forward + "^(defun \\([^ ]+\\)" nil t) + collect (match-string-no-properties 1))) + #'string<)))) + (functions-in-manual + (with-temp-buffer + (insert-file-contents (expand-file-name + "doc/lispref/parsing.texi" + source-directory)) + (insert-file-contents (expand-file-name + "doc/lispref/modes.texi" + source-directory)) + (cl-sort + (save-excursion + (goto-char (point-min)) + (cl-loop while (re-search-forward + "^@defun \\([^ ]+\\)" nil t) + collect (match-string-no-properties 1))) + #'string<)))) + (message "Missing: %s" + (string-join + (cl-remove-if + (lambda (name) (member name functions-in-manual)) + functions-in-source) + "\n")))) + +;;; Shortdocs + +(defun treesit--generate-shortdoc-examples () + "Generate examples for shortdoc." + (with-temp-buffer + (let (node parent) + (insert "int c = 0;") + (print (treesit-parser-create 'c)) + (print (treesit-parser-list)) + (goto-char (point-min)) + (print (setq node (treesit-node-at (point)))) + (print (setq parent (treesit-node-parent node))) + (print (treesit-node-children parent)) + (print (treesit-node-next-sibling node)) + (print (treesit-node-child-by-field-name parent "declarator")) + nil))) + +(define-short-documentation-group treesit + + + "Parsers" + (treesit-parser-create + :no-eval (treesit-parser-create) + :eg-result-string "#<treesit-parser for c>") + (treesit-parser-delete + :no-value (treesit-parser-delete parser)) + (treesit-parser-list + :no-eval (treesit-parser-list) + :eg-result-string "(#<treesit-parser for c>)") + (treesit-parser-buffer + :no-eval (treesit-parser-buffer parser) + :eg-result-string "#<buffer xdisp.c>") + (treesit-parser-language + :no-eval (treesit-parser-language parser) + :eg-result c) + (treesit-parser-add-notifier) + (treesit-parser-remove-notifier) + (treesit-parser-notifiers + :no-eval (treesit-parser-notifiers parser) + :eg-result (function1 function2 function3)) + + + "Parser ranges" + (treesit-parser-set-included-ranges + :no-value (treesit-parser-set-included-ranges parser '((1 . 4) (5 . 8)))) + (treesit-parser-included-ranges + :no-eval (treesit-parser-included-ranges parser) + :eg-result '((1 . 4) (5 . 8))) + (treesit-query-range + :no-eval (treesit-query-range node '((script_element) @cap)) + :eg-result-string '((1 . 4) (5 . 8))) + + + "Retrieving a node" + (treesit-node-at + :no-eval (treesit-node-at (point)) + :eg-result-string "#<treesit-node (identifier) in 179-180>") + (treesit-node-on + :no-eval (treesit-node-on 18 28) + :eg-result-string "#<treesit-node (compound_statement) in 143-290>") + (treesit-buffer-root-node + :no-eval (treesit-buffer-root-node) + :eg-result-string "#<treesit-node (translation_unit) in 1-4830>") + (treesit-parser-root-node + :no-eval (treesit-parser-root-node parser) + :eg-result-string "#<treesit-node (translation_unit) in 1-4830>") + + + "Retrieving a node from another node" + (treesit-node-parent + :no-eval (treesit-node-parent node) + :eg-result-string "#<treesit-node (declaration) in 1-11>") + (treesit-node-child + :no-eval (treesit-node-child node 0) + :eg-result-string "#<treesit-node (primitive_type) in 1-4>") + (treesit-node-children + :no-eval (treesit-node-children node) + :eg-result-string "(#<treesit-node (primitive_type) in 1-4> #<treesit-node (init_declarator) in 5-10> #<treesit-node \";\" in 10-11>)") + (treesit-node-next-sibling + :no-eval (treesit-node-next-sibling node) + :eg-result-string "#<treesit-node (init_declarator) in 5-10>") + (treesit-node-prev-sibling + :no-eval (treesit-node-prev-sibling node) + :eg-result-string "#<treesit-node (primitive_type) in 1-4>") + (treesit-node-child-by-field-name + :no-eval (treesit-node-child-by-field-name node "declarator") + :eg-result-string "#<treesit-node (init_declarator) in 5-10>") + + + (treesit-first-child-for-pos + :no-eval (treesit-first-child-for-pos node 1) + :eg-result-string "#<treesit-node (primitive_type) in 1-4>") + (treesit-node-descendant-for-range + :no-eval (treesit-node-descendant-for-range node 2 3) + :eg-result-string "#<treesit-node (primitive_type) in 1-4>") + + + "Searching for node" + (treesit-search-subtree + :no-eval (treesit-search-subtree node "function_definition") + :eg-result-string "#<treesit-node (function_definition) in 57-146>") + (treesit-search-forward + :no-eval (treesit-search-forward node "function_definition") + :eg-result-string "#<treesit-node (function_definition) in 57-146>") + (treesit-search-forward-goto + :no-eval (treesit-search-forward-goto node "function_definition") + :eg-result-string "#<treesit-node (function_definition) in 57-146>") + (treesit-induce-sparse-tree + :no-eval (treesit-induce-sparse-tree node "function_definition") + :eg-result-string "(nil (#<treesit-node (function_definition) in 57-146>) (#<treesit-node (function_definition) in 259-296>) (#<treesit-node (function_definition) in 303-659>))") + (treesit-filter-child + :no-eval (treesit-filter-child node (lambda (n) (equal (treesit-node-type) "identifier"))) + :eg-result-string "(#<treesit-node (identifier) in 195-196>)") + (treesit-parent-until + :no-eval (treesit-parent-until node (lambda (p) (eq (treesit-node-start p) (point)))) + :eg-result-string "#<treesit-node (declaration) in 1-11>") + (treesit-parent-while + :no-eval (treesit-parent-while node (lambda (p) (eq (treesit-node-start p) (point)))) + :eg-result-string "#<treesit-node (declaration) in 1-11>") + (treesit-node-top-level + :no-eval (treesit-node-top-level node) + :eg-result-string "#<treesit-node (declaration) in 1-11>") + + + "Retrieving node information" + (treesit-node-text + :no-eval (treesit-node-text node) + :eg-result "int") + (treesit-node-start + :no-eval (treesit-node-start node) + :eg-result 1) + (treesit-node-end + :no-eval (treesit-node-end node) + :eg-result 10) + (treesit-node-type + :no-eval (treesit-node-type node) + :eg-result "function_definition") + (treesit-node-field-name + :no-eval (treesit-node-field-name node) + :eg-result "body") + + + (treesit-node-parser + :no-eval (treesit-node-parser node) + :eg-result-string "#<treesit-parser for c>") + (treesit-node-language + :no-eval (treesit-node-language node) + :eg-result c) + (treesit-node-buffer + :no-eval (treesit-node-buffer node) + :eg-result-string "#<buffer xdisp.c>") + + + (treesit-node-index + :no-eval (treesit-node-index node) + :eg-result 0) + (treesit-node-string + :no-eval (treesit-node-string node) + :eg-result-string "(init_declarator declarator: (identifier) value: (number_literal))") + (treesit-node-check + :no-eval (treesit-node-check node 'named) + :eg-result t) + + + (treesit-field-name-for-child + :no-eval (treesit-field-name-for-child node) + :eg-result "body") + (treesit-child-count + :no-eval (treesit-child-count node) + :eg-result 3) + + + "Pattern matching" + (treesit-query-capture + :no-eval (treesit-query-capture node '((identifier) @id "return" @ret)) + :eg-result-string "((id . #<treesit-node (identifier) in 195-196>) (ret . #<treesit-node "return" in 338-344>))") + (treesit-query-compile + :no-eval (treesit-query-compile 'c '((identifier) @id "return" @ret)) + :eg-result-string "#<treesit-compiled-query>") + (treesit-query-language + :no-eval (treesit-query-language compiled-query) + :eg-result c) + (treesit-query-expand + :eval (treesit-query-expand '((identifier) @id "return" @ret))) + (treesit-pattern-expand + :eval (treesit-pattern-expand :anchor) + :eval (treesit-pattern-expand '(identifier)) + :eval (treesit-pattern-expand :equal)) + + + "Parsing a string" + (treesit-parse-string + :no-eval (treesit-parse-string "int c = 0;" 'c) + :eg-result-string "#<treesit-node (translation_unit) in 1-11>") + (treesit-query-string + :no-eval (treesit-query-string "int c = 0;" '((identifier) @id) 'c) + :eg-result-string "((id . #<treesit-node (identifier) in 5-6>))")) + +(provide 'treesit) + +;;; treesit.el ends here diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index fa3d58f770e..328d33040db 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1561,7 +1561,7 @@ Argument BACKEND is the backend to use." (insert-file-contents file) (split-string (buffer-string) "\n" t))) -;; Subroutine for `vc-git-ignore' and `vc-hg-ignore'. +;; Subroutine for `vc-default-ignore'. (defun vc--add-line (string file) "Add STRING as a line to FILE." (with-current-buffer (find-file-noselect file) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 4d9663cea95..cc7926c3c50 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3816,7 +3816,7 @@ thus allowing recursive data structures to be described. The :type parameter takes the same arguments as the defcustom parameter with the same name. -Most composite widgets, i.e. widgets containing other widgets, does +Most composite widgets, i.e. widgets containing other widgets, do not allow recursion. That is, when you define a new widget type, none of the inferior widgets may be of the same type you are currently defining. diff --git a/m4/assert_h.m4 b/m4/assert_h.m4 index c1306daef4f..e892ea2f01b 100644 --- a/m4/assert_h.m4 +++ b/m4/assert_h.m4 @@ -57,5 +57,11 @@ AC_DEFUN([gl_ASSERT_H], && __GNUG__ < 6 && __clang_major__ < 6))) #include <assert.h> #undef/**/assert + /* Solaris 11.4 <assert.h> defines static_assert as a macro with 2 arguments. + We need it also to be invocable with a single argument. */ + #if defined __sun && (__STDC_VERSION__ - 0 >= 201112L) && !defined __cplusplus + #undef static_assert + #define static_assert _Static_assert + #endif #endif]) ]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index f1ac4991324..1a8bf8b7cdf 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -77,7 +77,6 @@ AC_DEFUN([gl_EARLY], # Code from module dtoastr: # Code from module dtotimespec: # Code from module dup2: - # Code from module dynarray: # Code from module eloop-threshold: # Code from module environ: # Code from module errno: @@ -115,6 +114,8 @@ AC_DEFUN([gl_EARLY], # Code from module gettime: # Code from module gettimeofday: # Code from module gitlog-to-changelog: + # Code from module glibc-internal/dynarray: + # Code from module glibc-internal/scratch_buffer: # Code from module group-member: # Code from module idx: # Code from module ieee754-h: @@ -159,7 +160,6 @@ AC_DEFUN([gl_EARLY], # Code from module realloc-posix: # Code from module regex: # Code from module root-uid: - # Code from module scratch_buffer: # Code from module sig2str: # Code from module sigdescr_np: # Code from module signal-h: @@ -492,6 +492,14 @@ AC_DEFUN([gl_INIT], gl_CONDITIONAL_HEADER([stdalign.h]) AC_PROG_MKDIR_P gl_C_BOOL + AC_CHECK_HEADERS_ONCE([stdckdint.h]) + if test $ac_cv_header_stdckdint_h = yes; then + GL_GENERATE_STDCKDINT_H=false + else + GL_GENERATE_STDCKDINT_H=true + fi + gl_CONDITIONAL_HEADER([stdckdint.h]) + AC_PROG_MKDIR_P gl_STDDEF_H gl_STDDEF_H_REQUIRE_DEFAULTS gl_CONDITIONAL_HEADER([stddef.h]) @@ -620,12 +628,13 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false gl_gnulib_enabled_cloexec=false gl_gnulib_enabled_dirfd=false - gl_gnulib_enabled_dynarray=false gl_gnulib_enabled_925677f0343de64b89a9f0c790b4104c=false gl_gnulib_enabled_euidaccess=false gl_gnulib_enabled_getdtablesize=false gl_gnulib_enabled_getgroups=false gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false + gl_gnulib_enabled_fd38c7e463b54744b77b98aeafb4fa7c=false + gl_gnulib_enabled_8444034ea779b88768865bb60b4fb8c9=false gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false gl_gnulib_enabled_lchmod=false gl_gnulib_enabled_e80bf6f757095d2e5fc94dafb8f8fc8b=false @@ -637,8 +646,6 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_d3b2383720ee0e541357aa2aac598e2b=false gl_gnulib_enabled_61bcaca76b3e6f9ae55d57a1c3193bc4=false gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false - gl_gnulib_enabled_scratch_buffer=false - gl_gnulib_enabled_stdckdint=false gl_gnulib_enabled_strtoll=false gl_gnulib_enabled_utimens=false gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false @@ -672,13 +679,6 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_dirfd=true fi } - func_gl_gnulib_m4code_dynarray () - { - if ! $gl_gnulib_enabled_dynarray; then - AC_PROG_MKDIR_P - gl_gnulib_enabled_dynarray=true - fi - } func_gl_gnulib_m4code_925677f0343de64b89a9f0c790b4104c () { if ! $gl_gnulib_enabled_925677f0343de64b89a9f0c790b4104c; then @@ -735,6 +735,22 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true fi } + func_gl_gnulib_m4code_fd38c7e463b54744b77b98aeafb4fa7c () + { + if ! $gl_gnulib_enabled_fd38c7e463b54744b77b98aeafb4fa7c; then + AC_PROG_MKDIR_P + gl_gnulib_enabled_fd38c7e463b54744b77b98aeafb4fa7c=true + fi + } + func_gl_gnulib_m4code_8444034ea779b88768865bb60b4fb8c9 () + { + if ! $gl_gnulib_enabled_8444034ea779b88768865bb60b4fb8c9; then + AC_PROG_MKDIR_P + gl_gnulib_enabled_8444034ea779b88768865bb60b4fb8c9=true + func_gl_gnulib_m4code_ef455225c00f5049c808c2eda3e76866 + func_gl_gnulib_m4code_61bcaca76b3e6f9ae55d57a1c3193bc4 + fi + } func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1 () { if ! $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then @@ -751,9 +767,6 @@ AC_DEFUN([gl_INIT], if test $HAVE_GROUP_MEMBER = 0; then func_gl_gnulib_m4code_d3b2383720ee0e541357aa2aac598e2b fi - if test $HAVE_GROUP_MEMBER = 0; then - func_gl_gnulib_m4code_stdckdint - fi fi } func_gl_gnulib_m4code_lchmod () @@ -882,29 +895,6 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=true fi } - func_gl_gnulib_m4code_scratch_buffer () - { - if ! $gl_gnulib_enabled_scratch_buffer; then - AC_PROG_MKDIR_P - gl_gnulib_enabled_scratch_buffer=true - func_gl_gnulib_m4code_ef455225c00f5049c808c2eda3e76866 - func_gl_gnulib_m4code_61bcaca76b3e6f9ae55d57a1c3193bc4 - fi - } - func_gl_gnulib_m4code_stdckdint () - { - if ! $gl_gnulib_enabled_stdckdint; then - AC_CHECK_HEADERS_ONCE([stdckdint.h]) - if test $ac_cv_header_stdckdint_h = yes; then - GL_GENERATE_STDCKDINT_H=false - else - GL_GENERATE_STDCKDINT_H=true - fi - gl_CONDITIONAL_HEADER([stdckdint.h]) - AC_PROG_MKDIR_P - gl_gnulib_enabled_stdckdint=true - fi - } func_gl_gnulib_m4code_strtoll () { if ! $gl_gnulib_enabled_strtoll; then @@ -935,10 +925,10 @@ AC_DEFUN([gl_INIT], func_gl_gnulib_m4code_925677f0343de64b89a9f0c790b4104c fi if test $HAVE_CANONICALIZE_FILE_NAME = 0 || test $REPLACE_CANONICALIZE_FILE_NAME = 1; then - func_gl_gnulib_m4code_rawmemchr + func_gl_gnulib_m4code_8444034ea779b88768865bb60b4fb8c9 fi if test $HAVE_CANONICALIZE_FILE_NAME = 0 || test $REPLACE_CANONICALIZE_FILE_NAME = 1; then - func_gl_gnulib_m4code_scratch_buffer + func_gl_gnulib_m4code_rawmemchr fi if test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1; then func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b @@ -992,7 +982,7 @@ AC_DEFUN([gl_INIT], func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 fi if test $ac_use_included_regex = yes; then - func_gl_gnulib_m4code_dynarray + func_gl_gnulib_m4code_fd38c7e463b54744b77b98aeafb4fa7c fi if { test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then func_gl_gnulib_m4code_strtoll @@ -1013,12 +1003,13 @@ AC_DEFUN([gl_INIT], AM_CONDITIONAL([gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b], [$gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b]) AM_CONDITIONAL([gl_GNULIB_ENABLED_cloexec], [$gl_gnulib_enabled_cloexec]) AM_CONDITIONAL([gl_GNULIB_ENABLED_dirfd], [$gl_gnulib_enabled_dirfd]) - AM_CONDITIONAL([gl_GNULIB_ENABLED_dynarray], [$gl_gnulib_enabled_dynarray]) AM_CONDITIONAL([gl_GNULIB_ENABLED_925677f0343de64b89a9f0c790b4104c], [$gl_gnulib_enabled_925677f0343de64b89a9f0c790b4104c]) AM_CONDITIONAL([gl_GNULIB_ENABLED_euidaccess], [$gl_gnulib_enabled_euidaccess]) AM_CONDITIONAL([gl_GNULIB_ENABLED_getdtablesize], [$gl_gnulib_enabled_getdtablesize]) AM_CONDITIONAL([gl_GNULIB_ENABLED_getgroups], [$gl_gnulib_enabled_getgroups]) AM_CONDITIONAL([gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36], [$gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_fd38c7e463b54744b77b98aeafb4fa7c], [$gl_gnulib_enabled_fd38c7e463b54744b77b98aeafb4fa7c]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_8444034ea779b88768865bb60b4fb8c9], [$gl_gnulib_enabled_8444034ea779b88768865bb60b4fb8c9]) AM_CONDITIONAL([gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1], [$gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1]) AM_CONDITIONAL([gl_GNULIB_ENABLED_lchmod], [$gl_gnulib_enabled_lchmod]) AM_CONDITIONAL([gl_GNULIB_ENABLED_e80bf6f757095d2e5fc94dafb8f8fc8b], [$gl_gnulib_enabled_e80bf6f757095d2e5fc94dafb8f8fc8b]) @@ -1030,8 +1021,6 @@ AC_DEFUN([gl_INIT], AM_CONDITIONAL([gl_GNULIB_ENABLED_d3b2383720ee0e541357aa2aac598e2b], [$gl_gnulib_enabled_d3b2383720ee0e541357aa2aac598e2b]) AM_CONDITIONAL([gl_GNULIB_ENABLED_61bcaca76b3e6f9ae55d57a1c3193bc4], [$gl_gnulib_enabled_61bcaca76b3e6f9ae55d57a1c3193bc4]) AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c]) - AM_CONDITIONAL([gl_GNULIB_ENABLED_scratch_buffer], [$gl_gnulib_enabled_scratch_buffer]) - AM_CONDITIONAL([gl_GNULIB_ENABLED_stdckdint], [$gl_gnulib_enabled_stdckdint]) AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll]) AM_CONDITIONAL([gl_GNULIB_ENABLED_utimens], [$gl_gnulib_enabled_utimens]) AM_CONDITIONAL([gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec], [$gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec]) @@ -1320,7 +1309,6 @@ AC_DEFUN([gl_FILE_LIST], [ lib/malloc/dynarray_resize.c lib/malloc/dynarray_resize_clear.c lib/malloc/scratch_buffer.h - lib/malloc/scratch_buffer_dupfree.c lib/malloc/scratch_buffer_grow.c lib/malloc/scratch_buffer_grow_preserve.c lib/malloc/scratch_buffer_set_array_size.c diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4 index 0aa8c53f9ec..8282a371e4c 100644 --- a/m4/pthread_sigmask.m4 +++ b/m4/pthread_sigmask.m4 @@ -215,6 +215,7 @@ int main () LIBS="$LIBS $LIBMULTITHREAD"]) AC_RUN_IFELSE( [AC_LANG_SOURCE([[ +#include <limits.h> #include <pthread.h> #include <signal.h> #include <stdio.h> @@ -230,14 +231,16 @@ sigint_handler (int sig) int main () { sigset_t set; - int pid = getpid (); + pid_t pid = getpid (); char command[80]; + if (LONG_MAX < pid) + return 6; signal (SIGINT, sigint_handler); sigemptyset (&set); sigaddset (&set, SIGINT); if (!(pthread_sigmask (SIG_BLOCK, &set, NULL) == 0)) return 1; - sprintf (command, "sh -c 'sleep 1; kill -%d %d' &", SIGINT, pid); + sprintf (command, "sh -c 'sleep 1; kill -INT %ld' &", (long) pid); if (!(system (command) == 0)) return 2; sleep (2); diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index b7818f8b21e..9c9d1eded19 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -179,6 +179,8 @@ s/ *@WEBP_LIBS@// /^LIBGCCJIT_OBJ *=/s/@LIBGCCJIT_OBJ@// /^LIBGCCJIT_CFLAGS *=/s/@LIBGCCJIT_CFLAGS@// /^LIBGCCJIT_LIBS *=/s/@LIBGCCJIT_LIBS@// +/^TREE_SITTER_LIBS *=/s/@TREE_SITTER_LIBS@// +/^TREE_SITTER_CFLAGS *=/s/@TREE_SITTER_CFLAGS@// /^HARFBUZZ_CFLAGS *=/s/@HARFBUZZ_CFLAGS@// /^HARFBUZZ_LIBS *=/s/@HARFBUZZ_LIBS@// /^LCMS2_CFLAGS *=/s/@LCMS2_CFLAGS@// diff --git a/nt/icons/README b/nt/icons/README index 4d9fb15e520..f84d4635b35 100644 --- a/nt/icons/README +++ b/nt/icons/README @@ -23,7 +23,7 @@ License: GNU General Public License version 3 or later (see COPYING) <http://users.adelphia.net/~rob.davenport/gnuicons.html> "These are some images of a 3D stylized gnu head that I created back in 1998. I started studying pictures of gnus and wildebeests and - worked with a 3D modeller, sPatch, until I came up with these. Then + worked with a 3D modeler, sPatch, until I came up with these. Then I worked to make them into icons - cropping the horns off the sides so the images were big enough to be recognizable (to me anyway)." diff --git a/src/Makefile.in b/src/Makefile.in index 059e6c717b4..da11e130b2a 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -343,6 +343,9 @@ JSON_LIBS = @JSON_LIBS@ JSON_CFLAGS = @JSON_CFLAGS@ JSON_OBJ = @JSON_OBJ@ +TREE_SITTER_LIBS = @TREE_SITTER_LIBS@ +TREE_SITTER_CFLAGS = @TREE_SITTER_CFLAGS@ + INTERVALS_H = dispextern.h intervals.h composite.h GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ @@ -406,7 +409,7 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ $(XINPUT_CFLAGS) $(WEBP_CFLAGS) $(WEBKIT_CFLAGS) $(LCMS2_CFLAGS) \ $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ $(HARFBUZZ_CFLAGS) $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ - $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) $(XSYNC_CFLAGS) \ + $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) $(XSYNC_CFLAGS) $(TREE_SITTER_CFLAGS) \ $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ $(WERROR_CFLAGS) $(HAIKU_CFLAGS) $(XCOMPOSITE_CFLAGS) $(XSHAPE_CFLAGS) ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS) @@ -441,7 +444,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \ $(XWIDGETS_OBJ) \ profiler.o decompress.o \ - thread.o systhread.o sqlite.o \ + thread.o systhread.o sqlite.o treesit.o \ itree.o \ $(if $(HYBRID_MALLOC),sheap.o) \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \ @@ -566,7 +569,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(PGTK_LIBS) $(LIBX_BASE) $(LIBIMAGE $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \ $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) $(HAIKU_LIBS) \ - $(SQLITE3_LIBS) $(XCOMPOSITE_LIBS) $(XSHAPE_LIBS) + $(TREE_SITTER_LIBS) $(SQLITE3_LIBS) $(XCOMPOSITE_LIBS) $(XSHAPE_LIBS) ## FORCE it so that admin/unidata can decide whether this file is ## up-to-date. Although since charprop depends on bootstrap-emacs, diff --git a/src/alloc.c b/src/alloc.c index d3f696d5ade..0653f2e0ccc 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -50,6 +50,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include TERM_HEADER #endif /* HAVE_WINDOW_SYSTEM */ +#ifdef HAVE_TREE_SITTER +#include "treesit.h" +#endif + #include <flexmember.h> #include <verify.h> #include <execinfo.h> /* For backtrace. */ @@ -3170,6 +3174,12 @@ cleanup_vector (struct Lisp_Vector *vector) if (uptr->finalizer) uptr->finalizer (uptr->p); } +#ifdef HAVE_TREE_SITTER + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_TS_PARSER)) + treesit_delete_parser (PSEUDOVEC_STRUCT (vector, Lisp_TS_Parser)); + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_TS_COMPILED_QUERY)) + treesit_delete_query (PSEUDOVEC_STRUCT (vector, Lisp_TS_Query)); +#endif #ifdef HAVE_MODULES else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MODULE_FUNCTION)) { diff --git a/src/buffer.c b/src/buffer.c index d948aaa2662..ac7f4f8e9d4 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -231,6 +231,13 @@ bset_extra_line_spacing (struct buffer *b, Lisp_Object val) { b->extra_line_spacing_ = val; } +#ifdef HAVE_TREE_SITTER +static void +bset_ts_parser_list (struct buffer *b, Lisp_Object val) +{ + b->ts_parser_list_ = val; +} +#endif static void bset_file_format (struct buffer *b, Lisp_Object val) { @@ -1058,6 +1065,9 @@ reset_buffer (register struct buffer *b) (b, BVAR (&buffer_defaults, enable_multibyte_characters)); bset_cursor_type (b, BVAR (&buffer_defaults, cursor_type)); bset_extra_line_spacing (b, BVAR (&buffer_defaults, extra_line_spacing)); +#ifdef HAVE_TREE_SITTER + bset_ts_parser_list (b, Qnil); +#endif b->display_error_modiff = 0; } @@ -4681,6 +4691,9 @@ init_buffer_once (void) XSETFASTINT (BVAR (&buffer_local_flags, tab_line_format), idx); ++idx; XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx; XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx; +#ifdef HAVE_TREE_SITTER + XSETFASTINT (BVAR (&buffer_local_flags, ts_parser_list), idx); ++idx; +#endif XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx; /* buffer_local_flags contains no pointers, so it's safe to treat it @@ -4749,6 +4762,9 @@ init_buffer_once (void) bset_bidi_paragraph_separate_re (&buffer_defaults, Qnil); bset_cursor_type (&buffer_defaults, Qt); bset_extra_line_spacing (&buffer_defaults, Qnil); +#ifdef HAVE_TREE_SITTER + bset_ts_parser_list (&buffer_defaults, Qnil); +#endif bset_cursor_in_non_selected_windows (&buffer_defaults, Qt); bset_enable_multibyte_characters (&buffer_defaults, Qt); diff --git a/src/buffer.h b/src/buffer.h index 2e80c8a7b04..dded0cd98c1 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -573,6 +573,10 @@ struct buffer in the display of this buffer. */ Lisp_Object extra_line_spacing_; +#ifdef HAVE_TREE_SITTER + /* A list of tree-sitter parsers for this buffer. */ + Lisp_Object ts_parser_list_; +#endif /* Cursor type to display in non-selected windows. t means to use hollow box cursor. See `cursor-type' for other values. */ diff --git a/src/casefiddle.c b/src/casefiddle.c index 2ea5f09b4c5..e8ae2e276fc 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -30,6 +30,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "composite.h" #include "keymap.h" +#ifdef HAVE_TREE_SITTER +#include "treesit.h" +#endif + enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; /* State for casing individual characters. */ @@ -530,6 +534,11 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e) modify_text (start, end); prepare_casing_context (&ctx, flag, true); +#ifdef HAVE_TREE_SITTER + ptrdiff_t start_byte = CHAR_TO_BYTE (start); + ptrdiff_t old_end_byte = CHAR_TO_BYTE (end); +#endif + ptrdiff_t orig_end = end; record_delete (start, make_buffer_string (start, end, true), false); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) @@ -549,6 +558,10 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e) signal_after_change (start, end - start - added, end - start); update_compositions (start, end, CHECK_ALL); } +#ifdef HAVE_TREE_SITTER + treesit_record_change (start_byte, old_end_byte, + CHAR_TO_BYTE (orig_end + added)); +#endif return orig_end + added; } diff --git a/src/data.c b/src/data.c index 221a6f58835..c6b85e17bc2 100644 --- a/src/data.c +++ b/src/data.c @@ -261,6 +261,12 @@ for example, (type-of 1) returns `integer'. */) return Qxwidget; case PVEC_XWIDGET_VIEW: return Qxwidget_view; + case PVEC_TS_PARSER: + return Qtreesit_parser; + case PVEC_TS_NODE: + return Qtreesit_node; + case PVEC_TS_COMPILED_QUERY: + return Qtreesit_compiled_query; case PVEC_SQLITE: return Qsqlite; /* "Impossible" cases. */ @@ -4271,6 +4277,9 @@ syms_of_data (void) DEFSYM (Qterminal, "terminal"); DEFSYM (Qxwidget, "xwidget"); DEFSYM (Qxwidget_view, "xwidget-view"); + DEFSYM (Qtreesit_parser, "treesit-parser"); + DEFSYM (Qtreesit_node, "treesit-node"); + DEFSYM (Qtreesit_compiled_query, "treesit-compiled-query"); DEFSYM (Qdefun, "defun"); diff --git a/src/emacs.c b/src/emacs.c index 85102acd28e..00e7f86e9ae 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -137,6 +137,10 @@ extern char etext; #include <sys/resource.h> #endif +/* We don't guard this with HAVE_TREE_SITTER because treesit.o is + always compiled (to provide treesit-available-p). */ +#include "treesit.h" + #include "pdumper.h" #include "fingerprint.h" #include "epaths.h" @@ -291,6 +295,7 @@ Initialization options:\n\ --no-site-lisp, -nsl do not add site-lisp directories to load-path\n\ --no-splash do not display a splash screen on startup\n\ --no-window-system, -nw do not communicate with X, ignoring $DISPLAY\n\ +--init-directory=DIR use DIR when looking for the Emacs init files.\n\ ", "\ --quick, -Q equivalent to:\n\ @@ -2266,7 +2271,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #ifdef HAVE_MODULES syms_of_module (); #endif - + /* We don't guard this with HAVE_TREE_SITTER because treesit.o + is always compiled (to provide treesit-available-p). */ + syms_of_treesit (); #ifdef HAVE_SOUND syms_of_sound (); #endif diff --git a/src/eval.c b/src/eval.c index 7327d681f9a..99f3650fc9b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1902,6 +1902,19 @@ signal_error (const char *s, Lisp_Object arg) xsignal (Qerror, Fcons (build_string (s), arg)); } +void +define_error (Lisp_Object name, const char *message, Lisp_Object parent) +{ + eassert (SYMBOLP (name)); + eassert (SYMBOLP (parent)); + Lisp_Object parent_conditions = Fget (parent, Qerror_conditions); + eassert (CONSP (parent_conditions)); + eassert (!NILP (Fmemq (parent, parent_conditions))); + eassert (NILP (Fmemq (name, parent_conditions))); + Fput (name, Qerror_conditions, pure_cons (name, parent_conditions)); + Fput (name, Qerror_message, build_pure_c_string (message)); +} + /* Use this for arithmetic overflow, e.g., when an integer result is too large even for a bignum. */ void diff --git a/src/fns.c b/src/fns.c index 035fa129352..7cc6d00afef 100644 --- a/src/fns.c +++ b/src/fns.c @@ -596,8 +596,9 @@ To emulate Unicode-compliant collation on MS-Windows systems, bind `w32-collate-ignore-punctuation' to a non-nil value, since the codeset part of the locale cannot be \"UTF-8\" on MS-Windows. -If your system does not support a locale environment, this function -behaves like `string-lessp'. */) +Some operating systems do not implement correct collation (in specific +locale environments or at all). Then, this functions falls back to +case-sensitive `string-lessp' and IGNORE-CASE argument is ignored. */) (Lisp_Object s1, Lisp_Object s2, Lisp_Object locale, Lisp_Object ignore_case) { #if defined __STDC_ISO_10646__ || defined WINDOWSNT @@ -643,7 +644,8 @@ bind `w32-collate-ignore-punctuation' to a non-nil value, since the codeset part of the locale cannot be \"UTF-8\" on MS-Windows. If your system does not support a locale environment, this function -behaves like `string-equal'. +behaves like `string-equal', and in that case the IGNORE-CASE argument +is ignored. Do NOT use this function to compare file names for equality. */) (Lisp_Object s1, Lisp_Object s2, Lisp_Object locale, Lisp_Object ignore_case) diff --git a/src/image.c b/src/image.c index 600c32571e1..2436f78ac38 100644 --- a/src/image.c +++ b/src/image.c @@ -193,8 +193,8 @@ static void anim_prune_animation_cache (Lisp_Object); #ifdef USE_CAIRO static Emacs_Pix_Container -image_create_pix_container (struct frame *f, unsigned int width, - unsigned int height, unsigned int depth) +image_create_pix_container (unsigned int width, unsigned int height, + unsigned int depth) { Emacs_Pix_Container pimg; @@ -237,7 +237,7 @@ image_pix_container_create_from_bitmap_data (struct frame *f, unsigned long fg, unsigned long bg) { - Emacs_Pix_Container pimg = image_create_pix_container (f, width, height, 0); + Emacs_Pix_Container pimg = image_create_pix_container (width, height, 0); int bytes_per_line = (width + (CHAR_BIT - 1)) / CHAR_BIT; for (int y = 0; y < height; y++) @@ -3342,7 +3342,7 @@ image_create_x_image_and_pixmap_1 (struct frame *f, int width, int height, int d eassert (input_blocked_p ()); /* Allocate a pixmap of the same size. */ - *pixmap = image_create_pix_container (f, width, height, depth); + *pixmap = image_create_pix_container (width, height, depth); if (*pixmap == NO_PIXMAP) { *pimg = NULL; diff --git a/src/insdel.c b/src/insdel.c index 03ce59b3409..d483736c039 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -31,6 +31,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "region-cache.h" #include "pdumper.h" +#ifdef HAVE_TREE_SITTER +#include "treesit.h" +#endif + static void insert_from_string_1 (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool, bool); static void insert_from_buffer_1 (struct buffer *, ptrdiff_t, ptrdiff_t, bool); @@ -938,6 +942,12 @@ insert_1_both (const char *string, set_text_properties (make_fixnum (PT), make_fixnum (PT + nchars), Qnil, Qnil, Qnil); +#ifdef HAVE_TREE_SITTER + eassert (nbytes >= 0); + eassert (PT_BYTE >= 0); + treesit_record_change (PT_BYTE, PT_BYTE, PT_BYTE + nbytes); +#endif + adjust_point (nchars, nbytes); check_markers (); @@ -1068,6 +1078,12 @@ insert_from_string_1 (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, graft_intervals_into_buffer (intervals, PT, nchars, current_buffer, inherit); +#ifdef HAVE_TREE_SITTER + eassert (nbytes >= 0); + eassert (PT_BYTE >= 0); + treesit_record_change (PT_BYTE, PT_BYTE, PT_BYTE + nbytes); +#endif + adjust_point (nchars, outgoing_nbytes); check_markers (); @@ -1134,6 +1150,12 @@ insert_from_gap (ptrdiff_t nchars, ptrdiff_t nbytes, bool text_at_gap_tail) current_buffer, 0); } +#ifdef HAVE_TREE_SITTER + eassert (nbytes >= 0); + eassert (ins_bytepos >= 0); + treesit_record_change (ins_bytepos, ins_bytepos, ins_bytepos + nbytes); +#endif + if (ins_charpos < PT) adjust_point (nchars, nbytes); @@ -1283,6 +1305,12 @@ insert_from_buffer_1 (struct buffer *buf, /* Insert those intervals. */ graft_intervals_into_buffer (intervals, PT, nchars, current_buffer, inherit); +#ifdef HAVE_TREE_SITTER + eassert (outgoing_nbytes >= 0); + eassert (PT_BYTE >= 0); + treesit_record_change (PT_BYTE, PT_BYTE, PT_BYTE + outgoing_nbytes); +#endif + adjust_point (nchars, outgoing_nbytes); } @@ -1519,6 +1547,13 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new, graft_intervals_into_buffer (intervals, from, inschars, current_buffer, inherit); +#ifdef HAVE_TREE_SITTER + eassert (to_byte >= from_byte); + eassert (outgoing_insbytes >= 0); + eassert (from_byte >= 0); + treesit_record_change (from_byte, to_byte, from_byte + outgoing_insbytes); +#endif + /* Relocate point as if it were a marker. */ if (from < PT) adjust_point ((from + inschars - (PT < to ? PT : to)), @@ -1550,7 +1585,11 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new, If MARKERS, relocate markers. Unlike most functions at this level, never call - prepare_to_modify_buffer and never call signal_after_change. */ + prepare_to_modify_buffer and never call signal_after_change. + Because this function is called in a loop, one character at a time. + The caller of 'replace_range_2' calls these hooks for the entire + region once. Apart from signal_after_change, any caller of this + function should also call treesit_record_change. */ void replace_range_2 (ptrdiff_t from, ptrdiff_t from_byte, @@ -1856,6 +1895,12 @@ del_range_2 (ptrdiff_t from, ptrdiff_t from_byte, check_markers (); +#ifdef HAVE_TREE_SITTER + eassert (from_byte <= to_byte); + eassert (from_byte >= 0); + treesit_record_change (from_byte, to_byte, from_byte); +#endif + return deletion; } diff --git a/src/json.c b/src/json.c index 9a455f507b4..cdcc11358e6 100644 --- a/src/json.c +++ b/src/json.c @@ -1092,22 +1092,6 @@ usage: (json-parse-buffer &rest args) */) return unbind_to (count, lisp); } -/* Simplified version of 'define-error' that works with pure - objects. */ - -static void -define_error (Lisp_Object name, const char *message, Lisp_Object parent) -{ - eassert (SYMBOLP (name)); - eassert (SYMBOLP (parent)); - Lisp_Object parent_conditions = Fget (parent, Qerror_conditions); - eassert (CONSP (parent_conditions)); - eassert (!NILP (Fmemq (parent, parent_conditions))); - eassert (NILP (Fmemq (name, parent_conditions))); - Fput (name, Qerror_conditions, pure_cons (name, parent_conditions)); - Fput (name, Qerror_message, build_pure_c_string (message)); -} - void syms_of_json (void) { diff --git a/src/lisp.h b/src/lisp.h index e240f86902f..6a24a538172 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -583,6 +583,8 @@ enum Lisp_Fwd_Type your object -- this way, the same object could be used to represent several disparate C structures. + In addition, you need to add switch branches in data.c for Ftype_of. + You also need to add the new type to the constant `cl--typeof-types' in lisp/emacs-lisp/cl-preloaded.el. */ @@ -1059,6 +1061,9 @@ enum pvec_type PVEC_CONDVAR, PVEC_MODULE_FUNCTION, PVEC_NATIVE_COMP_UNIT, + PVEC_TS_PARSER, + PVEC_TS_NODE, + PVEC_TS_COMPILED_QUERY, PVEC_SQLITE, /* These should be last, for internal_equal and sxhash_obj. */ @@ -4753,6 +4758,8 @@ extern void update_search_regs (ptrdiff_t oldstart, extern void record_unwind_save_match_data (void); extern ptrdiff_t fast_string_match_internal (Lisp_Object, Lisp_Object, Lisp_Object); +extern ptrdiff_t fast_c_string_match_internal (Lisp_Object, const char *, + ptrdiff_t, Lisp_Object); INLINE ptrdiff_t fast_string_match (Lisp_Object regexp, Lisp_Object string) @@ -4766,8 +4773,21 @@ fast_string_match_ignore_case (Lisp_Object regexp, Lisp_Object string) return fast_string_match_internal (regexp, string, Vascii_canon_table); } -extern ptrdiff_t fast_c_string_match_ignore_case (Lisp_Object, const char *, - ptrdiff_t); +INLINE ptrdiff_t +fast_c_string_match (Lisp_Object regexp, + const char *string, ptrdiff_t len) +{ + return fast_c_string_match_internal (regexp, string, len, Qnil); +} + +INLINE ptrdiff_t +fast_c_string_match_ignore_case (Lisp_Object regexp, + const char *string, ptrdiff_t len) +{ + return fast_c_string_match_internal (regexp, string, len, + Vascii_canon_table); +} + extern ptrdiff_t fast_looking_at (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, Lisp_Object); extern ptrdiff_t find_newline1 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, @@ -5567,6 +5587,11 @@ maybe_gc (void) maybe_garbage_collect (); } +/* Simplified version of 'define-error' that works with pure + objects. */ +void +define_error (Lisp_Object name, const char *message, Lisp_Object parent); + INLINE_HEADER_END #endif /* EMACS_LISP_H */ diff --git a/src/lread.c b/src/lread.c index 2a57f721943..0a6e4201e40 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5469,6 +5469,14 @@ to the specified file name if a suffix is allowed or required. */); Fcons (build_pure_c_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes); #endif + DEFVAR_LISP ("dynamic-library-suffixes", Vdynamic_library_suffixes, + doc: /* A list of suffixes for loadable dynamic libraries. */); + Vdynamic_library_suffixes = + Fcons (build_pure_c_string (DYNAMIC_LIB_SECONDARY_SUFFIX), Qnil); + Vdynamic_library_suffixes = + Fcons (build_pure_c_string (DYNAMIC_LIB_SUFFIX), + Vdynamic_library_suffixes); + #endif DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix, doc: /* Suffix of loadable module file, or nil if modules are not supported. */); diff --git a/src/pdumper.c b/src/pdumper.c index 0a5d96dbb7c..fedcd3e4044 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2748,7 +2748,7 @@ dump_hash_table (struct dump_context *ctx, static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_193CAA5E45 +#if CHECK_STRUCTS && !defined HASH_buffer_DB34E5D09F # error "buffer changed. See CHECK_STRUCTS comment in config.h." #endif struct buffer munged_buffer = *in_buffer; @@ -3000,7 +3000,7 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_pvec_type_AFF6FED5BD +#if CHECK_STRUCTS && !defined HASH_pvec_type_5F2059C47E # error "pvec_type changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Vector *v = XVECTOR (lv); diff --git a/src/print.c b/src/print.c index 07560518c46..d8f87c63036 100644 --- a/src/print.c +++ b/src/print.c @@ -47,6 +47,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ # include <sys/socket.h> /* for F_DUPFD_CLOEXEC */ #endif +#ifdef HAVE_TREE_SITTER +#include "treesit.h" +#endif + struct terminal; /* Avoid actual stack overflow in print. */ @@ -2007,6 +2011,45 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, } break; #endif + +#ifdef HAVE_TREE_SITTER + case PVEC_TS_PARSER: + print_c_string ("#<treesit-parser for ", printcharfun); + Lisp_Object language = XTS_PARSER (obj)->language_symbol; + /* No need to print the buffer because it's not that useful: we + usually know which buffer a parser belongs to. */ + print_string (Fsymbol_name (language), printcharfun); + printchar ('>', printcharfun); + break; + case PVEC_TS_NODE: + /* Prints #<treesit-node (identifier) in 12-15> or + #<treesit-node "keyword" in 28-31>. */ + print_c_string ("#<treesit-node", printcharfun); + if (!treesit_node_uptodate_p (obj)) + { + print_c_string ("-outdated>", printcharfun); + break; + } + printchar (' ', printcharfun); + /* Now the node must be up-to-date, and calling functions like + Ftreesit_node_start will not signal. */ + bool named = treesit_named_node_p (XTS_NODE (obj)->node); + const char *delim1 = named ? "(" : "\""; + const char *delim2 = named ? ")" : "\""; + print_c_string (delim1, printcharfun); + print_string (Ftreesit_node_type (obj), printcharfun); + print_c_string (delim2, printcharfun); + print_c_string (" in ", printcharfun); + print_object (Ftreesit_node_start (obj), printcharfun, escapeflag); + printchar ('-', printcharfun); + print_object (Ftreesit_node_end (obj), printcharfun, escapeflag); + printchar ('>', printcharfun); + break; + case PVEC_TS_COMPILED_QUERY: + print_c_string ("#<treesit-compiled-query>", printcharfun); + break; +#endif + case PVEC_SQLITE: { print_c_string ("#<sqlite ", printcharfun); diff --git a/src/search.c b/src/search.c index 1c5831b6de7..242681bbba0 100644 --- a/src/search.c +++ b/src/search.c @@ -496,19 +496,27 @@ fast_string_match_internal (Lisp_Object regexp, Lisp_Object string, return val; } -/* Match REGEXP against STRING, searching all of STRING ignoring case, - and return the index of the match, or negative on failure. - This does not clobber the match data. +/* Match REGEXP against STRING, searching all of STRING and return the + index of the match, or negative on failure. This does not clobber + the match data. Table is a canonicalize table for ignoring case, + or nil for none. + We assume that STRING contains single-byte characters. */ ptrdiff_t -fast_c_string_match_ignore_case (Lisp_Object regexp, - const char *string, ptrdiff_t len) +fast_c_string_match_internal (Lisp_Object regexp, + const char *string, ptrdiff_t len, + Lisp_Object table) { + /* FIXME: This is expensive and not obviously correct when it makes + a difference. I.e., no longer "fast", and may hide bugs. + Something should be done about this. */ regexp = string_make_unibyte (regexp); + /* Record specpdl index because freeze_pattern pushes an + unwind-protect on the specpdl. */ specpdl_ref count = SPECPDL_INDEX (); struct regexp_cache *cache_entry - = compile_pattern (regexp, 0, Vascii_canon_table, 0, 0); + = compile_pattern (regexp, 0, table, 0, 0); freeze_pattern (cache_entry); re_match_object = Qt; ptrdiff_t val = re_search (&cache_entry->buf, string, len, 0, len, 0); diff --git a/src/sqlite.c b/src/sqlite.c index ac860f55bcd..d9b9333fb3c 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -55,6 +55,7 @@ DEF_DLL_FN (SQLITE_API const char*, sqlite3_errmsg, (sqlite3*)); #if SQLITE_VERSION_NUMBER >= 3007015 DEF_DLL_FN (SQLITE_API const char*, sqlite3_errstr, (int)); #endif +DEF_DLL_FN (SQLITE_API const char*, sqlite3_libversion, (void)); DEF_DLL_FN (SQLITE_API int, sqlite3_step, (sqlite3_stmt*)); DEF_DLL_FN (SQLITE_API int, sqlite3_changes, (sqlite3*)); DEF_DLL_FN (SQLITE_API int, sqlite3_column_count, (sqlite3_stmt*)); @@ -96,6 +97,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension, # if SQLITE_VERSION_NUMBER >= 3007015 # undef sqlite3_errstr # endif +# undef sqlite3_libversion # undef sqlite3_step # undef sqlite3_changes # undef sqlite3_column_count @@ -124,6 +126,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension, # if SQLITE_VERSION_NUMBER >= 3007015 # define sqlite3_errstr fn_sqlite3_errstr # endif +# define sqlite3_libversion fn_sqlite3_libversion # define sqlite3_step fn_sqlite3_step # define sqlite3_changes fn_sqlite3_changes # define sqlite3_column_count fn_sqlite3_column_count @@ -155,6 +158,7 @@ load_dll_functions (HMODULE library) #if SQLITE_VERSION_NUMBER >= 3007015 LOAD_DLL_FN (library, sqlite3_errstr); #endif + LOAD_DLL_FN (library, sqlite3_libversion); LOAD_DLL_FN (library, sqlite3_step); LOAD_DLL_FN (library, sqlite3_changes); LOAD_DLL_FN (library, sqlite3_column_count); @@ -763,6 +767,16 @@ This will free the resources held by SET. */) return Qt; } +DEFUN ("sqlite-version", Fsqlite_version, Ssqlite_version, 0, 0, 0, + doc: /* Return the version string of the SQLite library. +Signal an error if SQLite support is not available. */) + (void) +{ + if (!init_sqlite_functions ()) + error ("sqlite support is not available"); + return build_string (sqlite3_libversion ()); +} + #endif /* HAVE_SQLITE3 */ DEFUN ("sqlitep", Fsqlitep, Ssqlitep, 1, 1, 0, @@ -814,6 +828,7 @@ syms_of_sqlite (void) defsubr (&Ssqlite_columns); defsubr (&Ssqlite_more_p); defsubr (&Ssqlite_finalize); + defsubr (&Ssqlite_version); DEFSYM (Qset, "set"); DEFSYM (Qfull, "full"); #endif diff --git a/src/timefns.c b/src/timefns.c index eed2edf1cc0..9beec1ce384 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -1194,7 +1194,7 @@ For example, nil stands for the current time. */) quicker while we're at it. This means (time-subtract X X) does not signal an error if X is not a valid time value, but that's OK. */ if (BASE_EQ (a, b)) - return timespec_to_lisp ((struct timespec) {0}); + return make_lisp_time ((struct timespec) {0}); return time_arith (a, b, true); } diff --git a/src/treesit.c b/src/treesit.c new file mode 100644 index 00000000000..ad7e43fbc5c --- /dev/null +++ b/src/treesit.c @@ -0,0 +1,3126 @@ +/* Tree-sitter integration for GNU Emacs. + +Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> +#include "lisp.h" +#include "buffer.h" + +#include "treesit.h" + +#if HAVE_TREE_SITTER + + +/* Dynamic loading of libtree-sitter. */ + +#ifdef WINDOWSNT +# include "w32common.h" + +/* In alphabetical order. */ +#undef ts_language_version +#undef ts_node_child +#undef ts_node_child_by_field_name +#undef ts_node_child_count +#undef ts_node_descendant_for_byte_range +#undef ts_node_end_byte +#undef ts_node_eq +#undef ts_node_field_name_for_child +#undef ts_node_first_child_for_byte +#undef ts_node_first_named_child_for_byte +#undef ts_node_has_error +#undef ts_node_is_extra +#undef ts_node_is_missing +#undef ts_node_is_named +#undef ts_node_is_null +#undef ts_node_named_child +#undef ts_node_named_child_count +#undef ts_node_named_descendant_for_byte_range +#undef ts_node_next_named_sibling +#undef ts_node_next_sibling +#undef ts_node_parent +#undef ts_node_prev_named_sibling +#undef ts_node_prev_sibling +#undef ts_node_start_byte +#undef ts_node_string +#undef ts_node_type +#undef ts_parser_delete +#undef ts_parser_included_ranges +#undef ts_parser_language +#undef ts_parser_new +#undef ts_parser_parse +#undef ts_parser_set_included_ranges +#undef ts_parser_set_language +#undef ts_query_capture_name_for_id +#undef ts_query_cursor_delete +#undef ts_query_cursor_exec +#undef ts_query_cursor_new +#undef ts_query_cursor_next_match +#undef ts_query_cursor_set_byte_range +#undef ts_query_delete +#undef ts_query_new +#undef ts_query_predicates_for_pattern +#undef ts_query_string_value_for_id +#undef ts_set_allocator +#undef ts_tree_cursor_current_node +#undef ts_tree_cursor_goto_first_child +#undef ts_tree_cursor_goto_next_sibling +#undef ts_tree_cursor_goto_parent +#undef ts_tree_cursor_new +#undef ts_tree_delete +#undef ts_tree_edit +#undef ts_tree_get_changed_ranges +#undef ts_tree_root_node + +DEF_DLL_FN (uint32_t, ts_language_version, (const TSLanguage *)); +DEF_DLL_FN (TSNode, ts_node_child, (TSNode, uint32_t)); +DEF_DLL_FN (TSNode, ts_node_child_by_field_name, + (TSNode, const char *, uint32_t)); +DEF_DLL_FN (uint32_t, ts_node_child_count, (TSNode)); +DEF_DLL_FN (TSNode, ts_node_descendant_for_byte_range, + (TSNode, uint32_t, uint32_t)); +DEF_DLL_FN (uint32_t, ts_node_end_byte, (TSNode)); +DEF_DLL_FN (bool, ts_node_eq, (TSNode, TSNode)); +DEF_DLL_FN (const char *, ts_node_field_name_for_child, (TSNode, uint32_t)); +DEF_DLL_FN (TSNode, ts_node_first_child_for_byte, (TSNode, uint32_t)); +DEF_DLL_FN (TSNode, ts_node_first_named_child_for_byte, (TSNode, uint32_t)); +DEF_DLL_FN (bool, ts_node_has_error, (TSNode)); +DEF_DLL_FN (bool, ts_node_is_extra, (TSNode)); +DEF_DLL_FN (bool, ts_node_is_missing, (TSNode)); +DEF_DLL_FN (bool, ts_node_is_named, (TSNode)); +DEF_DLL_FN (bool, ts_node_is_null, (TSNode)); +DEF_DLL_FN (TSNode, ts_node_named_child, (TSNode, uint32_t)); +DEF_DLL_FN (uint32_t, ts_node_named_child_count, (TSNode)); +DEF_DLL_FN (TSNode, ts_node_named_descendant_for_byte_range, + (TSNode, uint32_t, uint32_t)); +DEF_DLL_FN (TSNode, ts_node_next_named_sibling, (TSNode)); +DEF_DLL_FN (TSNode, ts_node_next_sibling, (TSNode)); +DEF_DLL_FN (TSNode, ts_node_parent, (TSNode)); +DEF_DLL_FN (TSNode, ts_node_prev_named_sibling, (TSNode)); +DEF_DLL_FN (TSNode, ts_node_prev_sibling, (TSNode)); +DEF_DLL_FN (uint32_t, ts_node_start_byte, (TSNode)); +DEF_DLL_FN (char *, ts_node_string, (TSNode)); +DEF_DLL_FN (const char *, ts_node_type, (TSNode)); +DEF_DLL_FN (void, ts_parser_delete, (TSParser *)); +DEF_DLL_FN (const TSRange *, ts_parser_included_ranges, + (const TSParser *, uint32_t *)); +DEF_DLL_FN (const TSLanguage *, ts_parser_language, (const TSParser *)); +DEF_DLL_FN (TSParser *, ts_parser_new, (void)); +DEF_DLL_FN (TSTree *, ts_parser_parse, (TSParser *, const TSTree *, TSInput)); +DEF_DLL_FN (bool, ts_parser_set_included_ranges, + (TSParser *, const TSRange *, uint32_t)); +DEF_DLL_FN (bool, ts_parser_set_language, (TSParser *, const TSLanguage *)); +DEF_DLL_FN (const char *, ts_query_capture_name_for_id, + (const TSQuery *, uint32_t, uint32_t *)); +DEF_DLL_FN (void, ts_query_cursor_delete, (TSQueryCursor *)); +DEF_DLL_FN (void, ts_query_cursor_exec, + (TSQueryCursor *, const TSQuery *, TSNode)); +DEF_DLL_FN (TSQueryCursor *, ts_query_cursor_new, (void)); +DEF_DLL_FN (bool, ts_query_cursor_next_match, + (TSQueryCursor *, TSQueryMatch *)); +DEF_DLL_FN (void, ts_query_cursor_set_byte_range, + (TSQueryCursor *, uint32_t, uint32_t)); +DEF_DLL_FN (void, ts_query_delete, (TSQuery *)); +DEF_DLL_FN (TSQuery *, ts_query_new, + (const TSLanguage *, const char *, uint32_t, uint32_t *, TSQueryError *)); +DEF_DLL_FN (const TSQueryPredicateStep *, ts_query_predicates_for_pattern, + ( const TSQuery *, uint32_t, uint32_t *)); +DEF_DLL_FN (const char *, ts_query_string_value_for_id, + (const TSQuery *, uint32_t, uint32_t *)); +DEF_DLL_FN (void, ts_set_allocator, + (void *(*)(size_t), void *(*)(size_t, size_t), void *(*)(void *, size_t), void (*)(void *))); +DEF_DLL_FN (TSNode, ts_tree_cursor_current_node, (const TSTreeCursor *)); +DEF_DLL_FN (bool, ts_tree_cursor_goto_first_child, (TSTreeCursor *)); +DEF_DLL_FN (bool, ts_tree_cursor_goto_next_sibling, (TSTreeCursor *)); +DEF_DLL_FN (bool, ts_tree_cursor_goto_parent, (TSTreeCursor *)); +DEF_DLL_FN (TSTreeCursor, ts_tree_cursor_new, (TSNode)); +DEF_DLL_FN (void, ts_tree_delete, (TSTree *)); +DEF_DLL_FN (void, ts_tree_edit, (TSTree *, const TSInputEdit *)); +DEF_DLL_FN (TSRange *, ts_tree_get_changed_ranges, + (const TSTree *, const TSTree *, uint32_t *)); +DEF_DLL_FN (TSNode, ts_tree_root_node, (const TSTree *)); + +static bool +init_treesit_functions (void) +{ + HMODULE library = w32_delayed_load (Qtree_sitter); + + if (!library) + return false; + + LOAD_DLL_FN (library, ts_language_version); + LOAD_DLL_FN (library, ts_node_child); + LOAD_DLL_FN (library, ts_node_child_by_field_name); + LOAD_DLL_FN (library, ts_node_child_count); + LOAD_DLL_FN (library, ts_node_descendant_for_byte_range); + LOAD_DLL_FN (library, ts_node_end_byte); + LOAD_DLL_FN (library, ts_node_eq); + LOAD_DLL_FN (library, ts_node_field_name_for_child); + LOAD_DLL_FN (library, ts_node_first_child_for_byte); + LOAD_DLL_FN (library, ts_node_first_named_child_for_byte); + LOAD_DLL_FN (library, ts_node_has_error); + LOAD_DLL_FN (library, ts_node_is_extra); + LOAD_DLL_FN (library, ts_node_is_missing); + LOAD_DLL_FN (library, ts_node_is_named); + LOAD_DLL_FN (library, ts_node_is_null); + LOAD_DLL_FN (library, ts_node_named_child); + LOAD_DLL_FN (library, ts_node_named_child_count); + LOAD_DLL_FN (library, ts_node_named_descendant_for_byte_range); + LOAD_DLL_FN (library, ts_node_next_named_sibling); + LOAD_DLL_FN (library, ts_node_next_sibling); + LOAD_DLL_FN (library, ts_node_parent); + LOAD_DLL_FN (library, ts_node_prev_named_sibling); + LOAD_DLL_FN (library, ts_node_prev_sibling); + LOAD_DLL_FN (library, ts_node_start_byte); + LOAD_DLL_FN (library, ts_node_string); + LOAD_DLL_FN (library, ts_node_type); + LOAD_DLL_FN (library, ts_parser_delete); + LOAD_DLL_FN (library, ts_parser_included_ranges); + LOAD_DLL_FN (library, ts_parser_language); + LOAD_DLL_FN (library, ts_parser_new); + LOAD_DLL_FN (library, ts_parser_parse); + LOAD_DLL_FN (library, ts_parser_set_included_ranges); + LOAD_DLL_FN (library, ts_parser_set_language); + LOAD_DLL_FN (library, ts_query_capture_name_for_id); + LOAD_DLL_FN (library, ts_query_cursor_delete); + LOAD_DLL_FN (library, ts_query_cursor_exec); + LOAD_DLL_FN (library, ts_query_cursor_new); + LOAD_DLL_FN (library, ts_query_cursor_next_match); + LOAD_DLL_FN (library, ts_query_cursor_set_byte_range); + LOAD_DLL_FN (library, ts_query_delete); + LOAD_DLL_FN (library, ts_query_new); + LOAD_DLL_FN (library, ts_query_predicates_for_pattern); + LOAD_DLL_FN (library, ts_query_string_value_for_id); + LOAD_DLL_FN (library, ts_set_allocator); + LOAD_DLL_FN (library, ts_tree_cursor_current_node); + LOAD_DLL_FN (library, ts_tree_cursor_goto_first_child); + LOAD_DLL_FN (library, ts_tree_cursor_goto_next_sibling); + LOAD_DLL_FN (library, ts_tree_cursor_goto_parent); + LOAD_DLL_FN (library, ts_tree_cursor_new); + LOAD_DLL_FN (library, ts_tree_delete); + LOAD_DLL_FN (library, ts_tree_edit); + LOAD_DLL_FN (library, ts_tree_get_changed_ranges); + LOAD_DLL_FN (library, ts_tree_root_node); + + return true; +} + +#define ts_language_version fn_ts_language_version +#define ts_node_child fn_ts_node_child +#define ts_node_child_by_field_name fn_ts_node_child_by_field_name +#define ts_node_child_count fn_ts_node_child_count +#define ts_node_descendant_for_byte_range fn_ts_node_descendant_for_byte_range +#define ts_node_end_byte fn_ts_node_end_byte +#define ts_node_eq fn_ts_node_eq +#define ts_node_field_name_for_child fn_ts_node_field_name_for_child +#define ts_node_first_child_for_byte fn_ts_node_first_child_for_byte +#define ts_node_first_named_child_for_byte fn_ts_node_first_named_child_for_byte +#define ts_node_has_error fn_ts_node_has_error +#define ts_node_is_extra fn_ts_node_is_extra +#define ts_node_is_missing fn_ts_node_is_missing +#define ts_node_is_named fn_ts_node_is_named +#define ts_node_is_null fn_ts_node_is_null +#define ts_node_named_child fn_ts_node_named_child +#define ts_node_named_child_count fn_ts_node_named_child_count +#define ts_node_named_descendant_for_byte_range fn_ts_node_named_descendant_for_byte_range +#define ts_node_next_named_sibling fn_ts_node_next_named_sibling +#define ts_node_next_sibling fn_ts_node_next_sibling +#define ts_node_parent fn_ts_node_parent +#define ts_node_prev_named_sibling fn_ts_node_prev_named_sibling +#define ts_node_prev_sibling fn_ts_node_prev_sibling +#define ts_node_start_byte fn_ts_node_start_byte +#define ts_node_string fn_ts_node_string +#define ts_node_type fn_ts_node_type +#define ts_parser_delete fn_ts_parser_delete +#define ts_parser_included_ranges fn_ts_parser_included_ranges +#define ts_parser_language fn_ts_parser_language +#define ts_parser_new fn_ts_parser_new +#define ts_parser_parse fn_ts_parser_parse +#define ts_parser_set_included_ranges fn_ts_parser_set_included_ranges +#define ts_parser_set_language fn_ts_parser_set_language +#define ts_query_capture_name_for_id fn_ts_query_capture_name_for_id +#define ts_query_cursor_delete fn_ts_query_cursor_delete +#define ts_query_cursor_exec fn_ts_query_cursor_exec +#define ts_query_cursor_new fn_ts_query_cursor_new +#define ts_query_cursor_next_match fn_ts_query_cursor_next_match +#define ts_query_cursor_set_byte_range fn_ts_query_cursor_set_byte_range +#define ts_query_delete fn_ts_query_delete +#define ts_query_new fn_ts_query_new +#define ts_query_predicates_for_pattern fn_ts_query_predicates_for_pattern +#define ts_query_string_value_for_id fn_ts_query_string_value_for_id +#define ts_set_allocator fn_ts_set_allocator +#define ts_tree_cursor_current_node fn_ts_tree_cursor_current_node +#define ts_tree_cursor_goto_first_child fn_ts_tree_cursor_goto_first_child +#define ts_tree_cursor_goto_next_sibling fn_ts_tree_cursor_goto_next_sibling +#define ts_tree_cursor_goto_parent fn_ts_tree_cursor_goto_parent +#define ts_tree_cursor_new fn_ts_tree_cursor_new +#define ts_tree_delete fn_ts_tree_delete +#define ts_tree_edit fn_ts_tree_edit +#define ts_tree_get_changed_ranges fn_ts_tree_get_changed_ranges +#define ts_tree_root_node fn_ts_tree_root_node + +#endif /* WINDOWSNT */ + + +/* Commentary + + The Emacs wrapper of tree-sitter does not expose everything the C + API provides, most notably: + + - It doesn't expose a syntax tree. The syntax tree is part of the + parser object, and updating the tree is handled on the C level. + + - It doesn't expose the tree cursor, either. Presumably, Lisp is + slow enough to make insignificant any performance advantages from + using the cursor. Not exposing the cursor also minimizes the + number of new types this adds to Emacs Lisp; currently, this adds + only the parser and node types. + + - Because updating the change is handled on the C level as each + change is made in the buffer, there is no way for Lisp to update + a node. But since we can just retrieve a new node, it shouldn't + be a limitation. + + - I didn't expose setting timeout and cancellation flag for a + parser, mainly because I don't think they are really necessary + in Emacs's use cases. + + - Many tree-sitter functions take a TSPoint, which is basically a + row and column. Emacs uses a gap buffer and does not keep + information about the row and column position of a buffer. + According to the author of tree-sitter, those functions only take + a TSPoint so that it can be moved alongside the byte position and + returned to the caller afterwards, and the position actually used + is the specified byte position. He also said that he _thinks_ + that just passing a byte position will also work. As a result, a + dummy value is used in place of each TSPoint. Judging by the + nature of parsing algorithms, I think it is safe to use only the + byte position, and I don't think this will change in the future. + + See: https://github.com/tree-sitter/tree-sitter/issues/445 + + treesit.h has some commentary on the two main data structure for + the parser and node. treesit_sync_visible_region has some + commentary on how we make tree-sitter play well with narrowing (the + tree-sitter parser only sees the visible region, so we need to + translate positions back and forth). Most action happens in + treesit_ensure_parsed, treesit_read_buffer and + treesit_record_change. + + A complete correspondence list between tree-sitter functions and + exposed Lisp functions can be found in the manual node (elisp)API + Correspondence. + + Placement of CHECK_xxx functions: call CHECK_xxx before using any + unchecked Lisp values; these include arguments of Lisp functions, + the return value of Fsymbol_value, and that of Fcar or Fcdr on + user-specified conses. + + Initializing tree-sitter: there are two entry points to tree-sitter + functions: 'treesit-parser-create' and + 'treesit-language-available-p'. Technically we only need to call + initialization function in those two functions, but in reality we + check at the beginning of every Lisp function. That should be more + fool-proof. + + Tree-sitter offset (0-based) and buffer position (1-based): + tree-sitter offset + buffer position = buffer position + buffer position - buffer position = tree-sitter offset + + Tree-sitter-related code in other files: + - src/alloc.c for gc for parser and node + - src/casefiddle.c & src/insdel.c for notifying tree-sitter + parser of buffer changes. + - lisp/emacs-lisp/cl-preloaded.el & data.c & lisp.h for parser and + node type. + - print.c for printing tree-sitter objects (node, parser, query). + + Regarding signals: only raise signals in Lisp functions. + + Casts from EMACS_INT and ptrdiff_t to uint32_t: We install checks + for buffer size and range and thus able to assume these casts never + overflow. + + We don't parse at every keystroke. Instead we only record the + changes at each keystroke, and only parse when requested. It is + possible that lazy parsing is worse: instead of dispersed little + pauses, now you have less frequent but larger pauses. I doubt + there will be any perceived difference, as the lazy parsing is + going to be pretty frequent anyway. Also this (lazy parsing) is + what the mailing list guys wanted. + + Because it is pretty slow (comparing to other tree-sitter + operations) for tree-sitter to parse the query and produce a query + object, it is very wasteful to reparse the query every time + treesit-query-capture is called, and it completely kills the + performance of querying in a loop for a moderate amount of times + (hundreds of queries takes seconds rather than milliseconds to + complete). Therefore we want some caching. We can either use a + search.c style transparent caching, or simply expose a new type, + compiled-ts-query and let the user to manually compile AOT. I + believe AOT compiling gives users more control, makes the + performance stable and easy to understand (compiled -> fast, + uncompiled -> slow), and avoids some edge cases transparent cache + could have (see below). So I implemented the AOT compilation. + + Problems a transparent cache could have: Suppose we store cache + entries in a fixed-length linked-list, and compare with EQ. 1) + One-off query could kick out useful cache. 2) if the user messed + up and the query doesn't EQ to the cache anymore, the performance + mysteriously drops. 3) what if a user uses so many stuff that the + default cache size (20) is not enough and we end up thrashing? + These are all imaginary scenarios but they are not impossible + :-) */ + + +/*** Initialization */ + +bool treesit_initialized = false; + +static bool +load_tree_sitter_if_necessary (bool required) +{ +#ifdef WINDOWSNT + static bool tried_to_initialize_once; + static bool tree_sitter_initialized; + + if (!tried_to_initialize_once) + { + Lisp_Object status; + + tried_to_initialize_once = true; + tree_sitter_initialized = init_treesit_functions (); + status = tree_sitter_initialized ? Qt : Qnil; + Vlibrary_cache = Fcons (Fcons (Qtree_sitter, status), Vlibrary_cache); + } + + if (required && !tree_sitter_initialized) + xsignal1 (Qtreesit_error, + build_string ("tree-sitter library not found or failed to load")); + + return tree_sitter_initialized; +#else + return true; +#endif +} + +static void * +treesit_calloc_wrapper (size_t n, size_t size) +{ + return xzalloc (n * size); +} + +static void +treesit_initialize (void) +{ + if (!treesit_initialized) + { + load_tree_sitter_if_necessary (true); + ts_set_allocator (xmalloc, treesit_calloc_wrapper, xrealloc, xfree); + treesit_initialized = true; + } +} + + +/*** Loading language library */ + +/* Translates a symbol treesit-<lang> to a C name + treesit_<lang>. */ +static void +treesit_symbol_to_c_name (char *symbol_name) +{ + for (int idx = 0; idx < strlen (symbol_name); idx++) + { + if (symbol_name[idx] == '-') + symbol_name[idx] = '_'; + } +} + +static bool +treesit_find_override_name (Lisp_Object language_symbol, Lisp_Object *name, + Lisp_Object *c_symbol) +{ + Lisp_Object tem; + + CHECK_LIST (Vtreesit_load_name_override_list); + + tem = Vtreesit_load_name_override_list; + + FOR_EACH_TAIL (tem) + { + Lisp_Object lang = XCAR (XCAR (tem)); + CHECK_SYMBOL (lang); + + if (EQ (lang, language_symbol)) + { + *name = Fnth (make_fixnum (1), XCAR (tem)); + CHECK_STRING (*name); + *c_symbol = Fnth (make_fixnum (2), XCAR (tem)); + CHECK_STRING (*c_symbol); + + return true; + } + } + + CHECK_LIST_END (tem, Vtreesit_load_name_override_list); + + return false; +} + +/* For example, if Vdynamic_library_suffixes is (".so", ".dylib"), + this function pushes "lib_base_name.so" and "lib_base_name.dylib" + into *path_candidates. Obviously path_candidates should be a Lisp + list of Lisp strings. */ +static void +treesit_load_language_push_for_each_suffix (Lisp_Object lib_base_name, + Lisp_Object *path_candidates) +{ + Lisp_Object suffixes; + + suffixes = Vdynamic_library_suffixes; + + FOR_EACH_TAIL (suffixes) + *path_candidates = Fcons (concat2 (lib_base_name, XCAR (suffixes)), + *path_candidates); +} + +/* Load the dynamic library of LANGUAGE_SYMBOL and return the pointer + to the language definition. + + If error occurs, return NULL and fill SIGNAL_SYMBOL and SIGNAL_DATA + with values suitable for xsignal. */ +static TSLanguage * +treesit_load_language (Lisp_Object language_symbol, + Lisp_Object *signal_symbol, Lisp_Object *signal_data) +{ + Lisp_Object symbol_name = Fsymbol_name (language_symbol); + + CHECK_LIST (Vtreesit_extra_load_path); + + /* Figure out the library name and C name. */ + Lisp_Object lib_base_name + = concat2 (build_pure_c_string ("libtree-sitter-"), symbol_name); + Lisp_Object base_name + = concat2 (build_pure_c_string ("tree-sitter-"), symbol_name); + + /* Override the library name and C name, if appropriate. */ + Lisp_Object override_name; + Lisp_Object override_c_name; + bool found_override = treesit_find_override_name (language_symbol, + &override_name, + &override_c_name); + if (found_override) + lib_base_name = override_name; + + /* Now we generate a list of possible library paths. */ + Lisp_Object path_candidates = Qnil; + /* First push just the filenames to the candidate list, which will + make dynlib_open look under standard system load paths. */ + treesit_load_language_push_for_each_suffix (lib_base_name, &path_candidates); + /* This is used for reporting errors (i.e., just filenames). */ + Lisp_Object base_candidates = path_candidates; + /* Then push ~/.emacs.d/tree-sitter paths. */ + Lisp_Object lib_name + = Fexpand_file_name (concat2 (build_string ("tree-sitter/"), lib_base_name), + Fsymbol_value (Quser_emacs_directory)); + treesit_load_language_push_for_each_suffix (lib_name, &path_candidates); + /* Then push paths from treesit-extra-load-path. */ + Lisp_Object tail; + + tail = Freverse (Vtreesit_extra_load_path); + + FOR_EACH_TAIL (tail) + { + Lisp_Object expanded_lib = Fexpand_file_name (lib_base_name, XCAR (tail)); + treesit_load_language_push_for_each_suffix (expanded_lib, + &path_candidates); + } + + /* Try loading the dynamic library by each path candidate. Stop + when succeed, record the error message and try the next one when + fail. */ + dynlib_handle_ptr handle; + const char *error; + + tail = path_candidates; + error = NULL; + handle = NULL; + + FOR_EACH_TAIL (tail) + { + char *library_name = SSDATA (XCAR (tail)); + dynlib_error (); + handle = dynlib_open (library_name); + error = dynlib_error (); + if (error == NULL) + break; + } + + if (error != NULL) + { + *signal_symbol = Qtreesit_load_language_error; + *signal_data = list3 (Qnot_found, base_candidates, + build_string ("No such file or directory")); + return NULL; + } + + /* Load TSLanguage. */ + eassume (handle != NULL); + dynlib_error (); + TSLanguage *(*langfn) (void); + char *c_name = xstrdup (SSDATA (base_name)); + treesit_symbol_to_c_name (c_name); + if (found_override) + c_name = SSDATA (override_c_name); + langfn = dynlib_sym (handle, c_name); + xfree (c_name); + error = dynlib_error (); + if (error != NULL) + { + *signal_symbol = Qtreesit_load_language_error; + *signal_data = list2 (Qsymbol_error, build_string (error)); + return NULL; + } + TSLanguage *lang = (*langfn) (); + + /* Check if language version matches tree-sitter version. */ + TSParser *parser = ts_parser_new (); + bool success = ts_parser_set_language (parser, lang); + ts_parser_delete (parser); + if (!success) + { + *signal_symbol = Qtreesit_load_language_error; + *signal_data = list2 (Qversion_mismatch, + make_fixnum (ts_language_version (lang))); + return NULL; + } + return lang; +} + +DEFUN ("treesit-language-available-p", Ftreesit_langauge_available_p, + Streesit_language_available_p, + 1, 2, 0, + doc: /* Return non-nil if LANGUAGE exists and is loadable. + +If DETAIL is non-nil, return (t . nil) when LANGUAGE is available, +(nil . DATA) when unavailable. DATA is the signal data of +`treesit-load-language-error'. */) + (Lisp_Object language, Lisp_Object detail) +{ + CHECK_SYMBOL (language); + treesit_initialize (); + Lisp_Object signal_symbol = Qnil; + Lisp_Object signal_data = Qnil; + if (treesit_load_language (language, &signal_symbol, &signal_data) == NULL) + { + if (NILP (detail)) + return Qnil; + else + return Fcons (Qnil, signal_data); + } + else + { + if (NILP (detail)) + return Qt; + else + return Fcons (Qt, Qnil); + } +} + +DEFUN ("treesit-language-version", + Ftreesit_language_version, + Streesit_language_version, + 0, 1, 0, + doc: /* Return the language ABI version of the tree-sitter library. + +By default, report the latest ABI version supported by the library for +loading language support modules. The library is backward-compatible +with language modules which use older ABI versions; if MIN-COMPATIBLE +is non-nil, return the oldest compatible ABI version. */) + (Lisp_Object min_compatible) +{ + if (NILP (min_compatible)) + return make_fixnum (TREE_SITTER_LANGUAGE_VERSION); + else + return make_fixnum (TREE_SITTER_MIN_COMPATIBLE_LANGUAGE_VERSION); +} + +/*** Parsing functions */ + +static void +treesit_check_parser (Lisp_Object obj) +{ + CHECK_TS_PARSER (obj); + if (XTS_PARSER (obj)->deleted) + xsignal1 (Qtreesit_parser_deleted, obj); +} + +/* An auxiliary function that saves a few lines of code. Assumes TREE + is not NULL. START_BYTE, OLD_END_BYTE, NEW_END_BYTE must not be + larger than UINT32_MAX. */ +static inline void +treesit_tree_edit_1 (TSTree *tree, ptrdiff_t start_byte, + ptrdiff_t old_end_byte, ptrdiff_t new_end_byte) +{ + eassert (start_byte >= 0); + eassert (start_byte <= old_end_byte); + eassert (start_byte <= new_end_byte); + TSPoint dummy_point = {0, 0}; + eassert (start_byte <= UINT32_MAX); + eassert (old_end_byte <= UINT32_MAX); + eassert (new_end_byte <= UINT32_MAX); + TSInputEdit edit = {(uint32_t) start_byte, + (uint32_t) old_end_byte, + (uint32_t) new_end_byte, + dummy_point, dummy_point, dummy_point}; + ts_tree_edit (tree, &edit); +} + +/* Update each parser's tree after the user made an edit. This + function does not parse the buffer and only updates the tree, so it + should be very fast. */ +void +treesit_record_change (ptrdiff_t start_byte, ptrdiff_t old_end_byte, + ptrdiff_t new_end_byte) +{ + Lisp_Object parser_list; + + parser_list = BVAR (current_buffer, ts_parser_list); + + FOR_EACH_TAIL_SAFE (parser_list) + { + CHECK_CONS (parser_list); + Lisp_Object lisp_parser = XCAR (parser_list); + treesit_check_parser (lisp_parser); + TSTree *tree = XTS_PARSER (lisp_parser)->tree; + /* See comment (ref:visible-beg-null) if you wonder why we don't + update visible_beg/end when tree is NULL. */ + if (tree != NULL) + { + eassert (start_byte <= old_end_byte); + eassert (start_byte <= new_end_byte); + /* Think the recorded change as a delete followed by an + insert, and think of them as moving unchanged text back + and forth. After all, the whole point of updating the + tree is to update the position of unchanged text. */ + ptrdiff_t visible_beg = XTS_PARSER (lisp_parser)->visible_beg; + ptrdiff_t visible_end = XTS_PARSER (lisp_parser)->visible_end; + eassert (visible_beg >= 0); + eassert (visible_beg <= visible_end); + + /* AFFECTED_START/OLD_END/NEW_END are (0-based) offsets from + VISIBLE_BEG. min(visi_end, max(visi_beg, value)) clips + value into [visi_beg, visi_end], and subtracting visi_beg + gives the offset from visi_beg. */ + ptrdiff_t start_offset = (min (visible_end, + max (visible_beg, start_byte)) + - visible_beg); + ptrdiff_t old_end_offset = (min (visible_end, + max (visible_beg, old_end_byte)) + - visible_beg); + ptrdiff_t new_end_offset = (min (visible_end, + max (visible_beg, new_end_byte)) + - visible_beg); + eassert (start_offset <= old_end_offset); + eassert (start_offset <= new_end_offset); + + treesit_tree_edit_1 (tree, start_offset, old_end_offset, + new_end_offset); + XTS_PARSER (lisp_parser)->need_reparse = true; + XTS_PARSER (lisp_parser)->timestamp++; + + /* VISIBLE_BEG/END records tree-sitter's range of view in + the buffer. We need to adjust them when tree-sitter's + view changes. */ + ptrdiff_t visi_beg_delta; + if (old_end_byte > new_end_byte) + /* Move backward. */ + visi_beg_delta = (min (visible_beg, new_end_byte) + - min (visible_beg, old_end_byte)); + else + /* Move forward. */ + visi_beg_delta = (old_end_byte < visible_beg + ? new_end_byte - old_end_byte : 0); + XTS_PARSER (lisp_parser)->visible_beg = visible_beg + visi_beg_delta; + XTS_PARSER (lisp_parser)->visible_end = (visible_end + + visi_beg_delta + + (new_end_offset + - old_end_offset)); + eassert (XTS_PARSER (lisp_parser)->visible_beg >= 0); + eassert (XTS_PARSER (lisp_parser)->visible_beg + <= XTS_PARSER (lisp_parser)->visible_end); + } + } +} + +/* Comment (ref:visible-beg-null) The purpose of visible_beg/end is to + keep track of "which part of the buffer does the tree-sitter tree + see", in order to update the tree correctly. Visible_beg/end have + two purposes: they "clip" buffer changes within them, and they + translate positions in the buffer to positions in the tree + (buffer position - visible_beg = tree position). + + Conceptually, visible_beg/end hold the visible region of the buffer + when we last reparsed. In-between two reparses, we don't really + care if the visible region of the buffer changes. + + Right before we reparse, we make tree-sitter's visible region + match that of the buffer, and update visible_beg/end. + + That is, the whole purpose of visible_beg/end (and also of + treesit_record_change and treesit_sync_visible_region) is to update + the tree (by ts_tree_edit). So if the tree is NULL, + visible_beg/end are considered uninitialized. Only when we already + have a tree, do we need to keep track of position changes and + update it correctly, so it can be fed into ts_parser_parse as the + old tree, so that tree-sitter will only parse the changed part, + incrementally. + + In a nutshell, tree-sitter incremental parsing in Emacs looks like: + + treesit_record_change (tree) \ + treesit_record_change (tree) | user edits buffer + ... / + + treesit_sync_visible_region (tree) \ treesit_ensure_parsed + ts_parser_parse(tree) -> tree / + + treesit_record_change (tree) \ + treesit_record_change (tree) | user edits buffer + ... / + + and so on. */ + +/* Make sure the tree's visible range is in sync with the buffer's + visible range, and PARSER's visible_beg and visible_end are in sync + with BUF_BEGV_BYTE and BUG_ZV_BYTE. When calling this function you + must make sure the current buffer's size in bytes is not larger than + UINT32_MAX. Basically, always call treesit_check_buffer_size before + this function. */ +static void +treesit_sync_visible_region (Lisp_Object parser) +{ + TSTree *tree = XTS_PARSER (parser)->tree; + struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer); + + /* If we are setting visible_beg/end for the first time, we can skip + the offset acrobatics and updating the tree below. */ + if (tree == NULL) + { + XTS_PARSER (parser)->visible_beg = BUF_BEGV_BYTE (buffer); + XTS_PARSER (parser)->visible_end = BUF_ZV_BYTE (buffer); + return; + } + + ptrdiff_t visible_beg = XTS_PARSER (parser)->visible_beg; + ptrdiff_t visible_end = XTS_PARSER (parser)->visible_end; + eassert (0 <= visible_beg); + eassert (visible_beg <= visible_end); + + eassert (BUF_BEGV_BYTE (buffer) <= UINT32_MAX); + eassert (BUF_ZV_BYTE (buffer) <= UINT32_MAX); + + /* Before we parse or set ranges, catch up with the narrowing + situation. We change visible_beg and visible_end to match + BUF_BEGV_BYTE and BUF_ZV_BYTE, and inform tree-sitter of the + change. We want to move the visible range of tree-sitter to + match the narrowed range. For example, + from ________|xxxx|__ + to |xxxx|__________ */ + + /* 1. Make sure visible_beg <= BUF_BEGV_BYTE. */ + if (visible_beg > BUF_BEGV_BYTE (buffer)) + { + /* Tree-sitter sees: insert at the beginning. */ + treesit_tree_edit_1 (tree, 0, 0, visible_beg - BUF_BEGV_BYTE (buffer)); + visible_beg = BUF_BEGV_BYTE (buffer); + eassert (visible_beg <= visible_end); + } + /* 2. Make sure visible_end = BUF_ZV_BYTE. */ + if (visible_end < BUF_ZV_BYTE (buffer)) + { + /* Tree-sitter sees: insert at the end. */ + treesit_tree_edit_1 (tree, visible_end - visible_beg, + visible_end - visible_beg, + BUF_ZV_BYTE (buffer) - visible_beg); + visible_end = BUF_ZV_BYTE (buffer); + eassert (visible_beg <= visible_end); + } + else if (visible_end > BUF_ZV_BYTE (buffer)) + { + /* Tree-sitter sees: delete at the end. */ + treesit_tree_edit_1 (tree, BUF_ZV_BYTE (buffer) - visible_beg, + visible_end - visible_beg, + BUF_ZV_BYTE (buffer) - visible_beg); + visible_end = BUF_ZV_BYTE (buffer); + eassert (visible_beg <= visible_end); + } + /* 3. Make sure visible_beg = BUF_BEGV_BYTE. */ + if (visible_beg < BUF_BEGV_BYTE (buffer)) + { + /* Tree-sitter sees: delete at the beginning. */ + treesit_tree_edit_1 (tree, 0, BUF_BEGV_BYTE (buffer) - visible_beg, 0); + visible_beg = BUF_BEGV_BYTE (buffer); + eassert (visible_beg <= visible_end); + } + eassert (0 <= visible_beg); + eassert (visible_beg <= visible_end); + + XTS_PARSER (parser)->visible_beg = visible_beg; + XTS_PARSER (parser)->visible_end = visible_end; +} + +static void +treesit_check_buffer_size (struct buffer *buffer) +{ + ptrdiff_t buffer_size_bytes = (BUF_Z_BYTE (buffer) - BUF_BEG_BYTE (buffer)); + if (buffer_size_bytes > UINT32_MAX) + xsignal2 (Qtreesit_buffer_too_large, + build_pure_c_string ("Buffer size cannot be larger than 4GB"), + make_fixnum (buffer_size_bytes)); +} + +static Lisp_Object treesit_make_ranges (const TSRange *, uint32_t, struct buffer *); + +static void +treesit_call_after_change_functions (TSTree *old_tree, TSTree *new_tree, + Lisp_Object parser) +{ + uint32_t len; + TSRange *ranges = ts_tree_get_changed_ranges (old_tree, new_tree, &len); + struct buffer *buf = XBUFFER (XTS_PARSER (parser)->buffer); + Lisp_Object lisp_ranges = treesit_make_ranges (ranges, len, buf); + xfree (ranges); + + specpdl_ref count = SPECPDL_INDEX (); + + /* let's trust the after change functions and not clone a new ranges + for each of them. */ + Lisp_Object functions = XTS_PARSER (parser)->after_change_functions; + FOR_EACH_TAIL (functions) + safe_call2 (XCAR (functions), lisp_ranges, parser); + + unbind_to (count, Qnil); +} + +/* Parse the buffer. We don't parse until we have to. When we have + to, we call this function to parse and update the tree. */ +static void +treesit_ensure_parsed (Lisp_Object parser) +{ + if (!XTS_PARSER (parser)->need_reparse) + return; + TSParser *treesit_parser = XTS_PARSER (parser)->parser; + TSTree *tree = XTS_PARSER (parser)->tree; + TSInput input = XTS_PARSER (parser)->input; + struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer); + + /* Before we parse, catch up with the narrowing situation. */ + treesit_check_buffer_size (buffer); + treesit_sync_visible_region (parser); + + TSTree *new_tree = ts_parser_parse (treesit_parser, tree, input); + /* This should be very rare (impossible, really): it only happens + when 1) language is not set (impossible in Emacs because the user + has to supply a language to create a parser), 2) parse canceled + due to timeout (impossible because we don't set a timeout), 3) + parse canceled due to cancellation flag (impossible because we + don't set the flag). (See comments for ts_parser_parse in + tree_sitter/api.h.) */ + if (new_tree == NULL) + { + Lisp_Object buf; + XSETBUFFER (buf, buffer); + xsignal1 (Qtreesit_parse_error, buf); + } + + if (tree != NULL) + { + treesit_call_after_change_functions (tree, new_tree, parser); + ts_tree_delete (tree); + } + + XTS_PARSER (parser)->tree = new_tree; + XTS_PARSER (parser)->need_reparse = false; +} + +/* This is the read function provided to tree-sitter to read from a + buffer. It reads one character at a time and automatically skips + the gap. */ +static const char* +treesit_read_buffer (void *parser, uint32_t byte_index, + TSPoint position, uint32_t *bytes_read) +{ + struct buffer *buffer = XBUFFER (((struct Lisp_TS_Parser *) parser)->buffer); + ptrdiff_t visible_beg = ((struct Lisp_TS_Parser *) parser)->visible_beg; + ptrdiff_t visible_end = ((struct Lisp_TS_Parser *) parser)->visible_end; + ptrdiff_t byte_pos = byte_index + visible_beg; + /* We will make sure visible_beg = BUF_BEGV_BYTE before re-parse (in + treesit_ensure_parsed), so byte_pos will never be smaller than + BUF_BEG_BYTE. */ + eassert (visible_beg = BUF_BEGV_BYTE (buffer)); + eassert (visible_end = BUF_ZV_BYTE (buffer)); + + /* Read one character. Tree-sitter wants us to set bytes_read to 0 + if it reads to the end of buffer. It doesn't say what it wants + for the return value in that case, so we just give it an empty + string. */ + char *beg; + int len; + /* This function could run from a user command, so it is better to + do nothing instead of raising an error. (It was a pain in the a** + to decrypt mega-if-conditions in Emacs source, so I wrote the two + branches separately, you are welcome.) */ + if (!BUFFER_LIVE_P (buffer)) + { + beg = NULL; + len = 0; + } + /* Reached visible end-of-buffer, tell tree-sitter to read no more. */ + else if (byte_pos >= visible_end) + { + beg = NULL; + len = 0; + } + /* Normal case, read a character. */ + else + { + beg = (char *) BUF_BYTE_ADDRESS (buffer, byte_pos); + len = BYTES_BY_CHAR_HEAD ((int) *beg); + } + /* We never let tree-sitter to parse buffers that large so this + assertion should never hit. */ + eassert (len < UINT32_MAX); + *bytes_read = (uint32_t) len; + return beg; +} + +/*** Functions for parser and node object */ + +/* Wrap the parser in a Lisp_Object to be used in the Lisp + machine. */ +Lisp_Object +make_treesit_parser (Lisp_Object buffer, TSParser *parser, + TSTree *tree, Lisp_Object language_symbol) +{ + struct Lisp_TS_Parser *lisp_parser; + + lisp_parser = ALLOCATE_PSEUDOVECTOR (struct Lisp_TS_Parser, + buffer, PVEC_TS_PARSER); + + lisp_parser->language_symbol = language_symbol; + lisp_parser->after_change_functions = Qnil; + lisp_parser->buffer = buffer; + lisp_parser->parser = parser; + lisp_parser->tree = tree; + TSInput input = {lisp_parser, treesit_read_buffer, TSInputEncodingUTF8}; + lisp_parser->input = input; + lisp_parser->need_reparse = true; + lisp_parser->visible_beg = BUF_BEGV_BYTE (XBUFFER (buffer)); + lisp_parser->visible_end = BUF_ZV_BYTE (XBUFFER (buffer)); + lisp_parser->timestamp = 0; + lisp_parser->deleted = false; + lisp_parser->has_range = false; + eassert (lisp_parser->visible_beg <= lisp_parser->visible_end); + return make_lisp_ptr (lisp_parser, Lisp_Vectorlike); +} + +/* Wrap the node in a Lisp_Object to be used in the Lisp machine. */ +Lisp_Object +make_treesit_node (Lisp_Object parser, TSNode node) +{ + struct Lisp_TS_Node *lisp_node; + + lisp_node = ALLOCATE_PSEUDOVECTOR (struct Lisp_TS_Node, + parser, PVEC_TS_NODE); + lisp_node->parser = parser; + lisp_node->node = node; + lisp_node->timestamp = XTS_PARSER (parser)->timestamp; + return make_lisp_ptr (lisp_node, Lisp_Vectorlike); +} + +/* Make a compiled query. QUERY has to be either a cons or a + string. */ +static Lisp_Object +make_treesit_query (Lisp_Object query, Lisp_Object language) +{ + TSQueryCursor *treesit_cursor = ts_query_cursor_new (); + struct Lisp_TS_Query *lisp_query; + + lisp_query = ALLOCATE_PSEUDOVECTOR (struct Lisp_TS_Query, + source, PVEC_TS_COMPILED_QUERY); + + lisp_query->language = language; + lisp_query->source = query; + lisp_query->query = NULL; + lisp_query->cursor = treesit_cursor; + return make_lisp_ptr (lisp_query, Lisp_Vectorlike); +} + +/* The following two functions are called from alloc.c:cleanup_vector. */ +void +treesit_delete_parser (struct Lisp_TS_Parser *lisp_parser) +{ + ts_tree_delete (lisp_parser->tree); + ts_parser_delete (lisp_parser->parser); +} + +void +treesit_delete_query (struct Lisp_TS_Query *lisp_query) +{ + ts_query_delete (lisp_query->query); + ts_query_cursor_delete (lisp_query->cursor); +} + +/* The following function is called from print.c:print_vectorlike. */ +bool +treesit_named_node_p (TSNode node) +{ + return ts_node_is_named (node); +} + +static const char* +treesit_query_error_to_string (TSQueryError error) +{ + switch (error) + { + case TSQueryErrorNone: + return "None"; + case TSQueryErrorSyntax: + return "Syntax error at"; + case TSQueryErrorNodeType: + return "Node type error at"; + case TSQueryErrorField: + return "Field error at"; + case TSQueryErrorCapture: + return "Capture error at"; + case TSQueryErrorStructure: + return "Structure error at"; + default: + return "Unknown error"; + } +} + +static Lisp_Object +treesit_compose_query_signal_data (uint32_t error_offset, + TSQueryError error_type) +{ + return list3 (build_string (treesit_query_error_to_string (error_type)), + make_fixnum (error_offset + 1), + build_pure_c_string ("Debug the query with `treesit-query-validate'")); +} + +/* Ensure the QUERY is compiled. Return the TSQuery. It could be + NULL if error occurs, in which case ERROR_OFFSET and ERROR_TYPE are + bound. If error occurs, return NULL, and assign SIGNAL_SYMBOL and + SIGNAL_DATA accordingly. */ +static TSQuery * +treesit_ensure_query_compiled (Lisp_Object query, Lisp_Object *signal_symbol, + Lisp_Object *signal_data) +{ + /* If query is already compiled (not null), return that, otherwise + compile and return it. */ + TSQuery *treesit_query = XTS_COMPILED_QUERY (query)->query; + if (treesit_query != NULL) + return treesit_query; + + /* Get query source and TSLanguage ready. */ + Lisp_Object source = XTS_COMPILED_QUERY (query)->source; + Lisp_Object language = XTS_COMPILED_QUERY (query)->language; + /* This is the main reason why we compile query lazily: to avoid + loading languages early. */ + TSLanguage *treesit_lang = treesit_load_language (language, signal_symbol, + signal_data); + if (treesit_lang == NULL) + return NULL; + + if (CONSP (source)) + source = Ftreesit_query_expand (source); + + /* Create TSQuery. */ + uint32_t error_offset; + TSQueryError error_type; + char *treesit_source = SSDATA (source); + treesit_query = ts_query_new (treesit_lang, treesit_source, + strlen (treesit_source), + &error_offset, &error_type); + if (treesit_query == NULL) + { + *signal_symbol = Qtreesit_query_error; + *signal_data = treesit_compose_query_signal_data (error_offset, + error_type); + } + XTS_COMPILED_QUERY (query)->query = treesit_query; + return treesit_query; +} + +DEFUN ("treesit-parser-p", + Ftreesit_parser_p, Streesit_parser_p, 1, 1, 0, + doc: /* Return t if OBJECT is a tree-sitter parser. */) + (Lisp_Object object) +{ + if (TS_PARSERP (object)) + return Qt; + else + return Qnil; +} + +DEFUN ("treesit-node-p", + Ftreesit_node_p, Streesit_node_p, 1, 1, 0, + doc: /* Return t if OBJECT is a tree-sitter node. */) + (Lisp_Object object) +{ + if (TS_NODEP (object)) + return Qt; + else + return Qnil; +} + +DEFUN ("treesit-compiled-query-p", + Ftreesit_compiled_query_p, Streesit_compiled_query_p, 1, 1, 0, + doc: /* Return t if OBJECT is a compiled tree-sitter query. */) + (Lisp_Object object) +{ + if (TS_COMPILED_QUERY_P (object)) + return Qt; + else + return Qnil; +} + +DEFUN ("treesit-query-p", + Ftreesit_query_p, Streesit_query_p, 1, 1, 0, + doc: /* Return t if OBJECT is a generic tree-sitter query. */) + (Lisp_Object object) +{ + if (TS_COMPILED_QUERY_P (object) + || CONSP (object) || STRINGP (object)) + return Qt; + else + return Qnil; +} + +DEFUN ("treesit-query-language", + Ftreesit_query_language, Streesit_query_language, 1, 1, 0, + doc: /* Return the language of QUERY. +QUERY has to be a compiled query. */) + (Lisp_Object query) +{ + CHECK_TS_COMPILED_QUERY (query); + return XTS_COMPILED_QUERY (query)->language; +} + +DEFUN ("treesit-node-parser", + Ftreesit_node_parser, Streesit_node_parser, + 1, 1, 0, + doc: /* Return the parser to which NODE belongs. */) + (Lisp_Object node) +{ + CHECK_TS_NODE (node); + return XTS_NODE (node)->parser; +} + +DEFUN ("treesit-parser-create", + Ftreesit_parser_create, Streesit_parser_create, + 1, 3, 0, + doc: /* Create and return a parser in BUFFER for LANGUAGE. + +The parser is automatically added to BUFFER's parser list, as +returned by `treesit-parser-list'. +LANGUAGE is a language symbol. If BUFFER is nil or omitted, it +defaults to the current buffer. If BUFFER already has a parser for +LANGUAGE, return that parser, but if NO-REUSE is non-nil, always +create a new parser. */) + (Lisp_Object language, Lisp_Object buffer, Lisp_Object no_reuse) +{ + treesit_initialize (); + + CHECK_SYMBOL (language); + struct buffer *buf; + if (NILP (buffer)) + buf = current_buffer; + else + { + CHECK_BUFFER (buffer); + buf = XBUFFER (buffer); + } + treesit_check_buffer_size (buf); + + /* See if we can reuse a parser. */ + for (Lisp_Object tail = BVAR (buf, ts_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)) + return XCAR (tail); + } + + /* Load language. */ + Lisp_Object signal_symbol = Qnil; + Lisp_Object signal_data = Qnil; + TSParser *parser = ts_parser_new (); + TSLanguage *lang = treesit_load_language (language, &signal_symbol, + &signal_data); + if (lang == NULL) + xsignal (signal_symbol, signal_data); + /* We check language version when loading a language, so this should + always succeed. */ + ts_parser_set_language (parser, lang); + + /* Create parser. */ + Lisp_Object lisp_parser = make_treesit_parser (Fcurrent_buffer (), + parser, NULL, + language); + + /* Update parser-list. */ + BVAR (buf, ts_parser_list) = Fcons (lisp_parser, BVAR (buf, ts_parser_list)); + + return lisp_parser; +} + +DEFUN ("treesit-parser-delete", + Ftreesit_parser_delete, Streesit_parser_delete, + 1, 1, 0, + doc: /* Delete PARSER from its buffer's parser list. +See `treesit-parser-list' for the buffer's parser list. */) + (Lisp_Object parser) +{ + treesit_check_parser (parser); + + Lisp_Object buffer = XTS_PARSER (parser)->buffer; + struct buffer *buf = XBUFFER (buffer); + + BVAR (buf, ts_parser_list) + = Fdelete (parser, BVAR (buf, ts_parser_list)); + + XTS_PARSER (parser)->deleted = true; + return Qnil; +} + +DEFUN ("treesit-parser-list", + Ftreesit_parser_list, Streesit_parser_list, + 0, 1, 0, + doc: /* Return BUFFER's parser list. +BUFFER defaults to the current buffer. */) + (Lisp_Object buffer) +{ + struct buffer *buf; + if (NILP (buffer)) + buf = current_buffer; + else + { + CHECK_BUFFER (buffer); + buf = XBUFFER (buffer); + } + /* Return a fresh list so messing with that list doesn't affect our + internal data. */ + Lisp_Object return_list = Qnil; + Lisp_Object tail; + + tail = BVAR (buf, ts_parser_list); + + FOR_EACH_TAIL (tail) + return_list = Fcons (XCAR (tail), return_list); + + return Freverse (return_list); +} + +DEFUN ("treesit-parser-buffer", + Ftreesit_parser_buffer, Streesit_parser_buffer, + 1, 1, 0, + doc: /* Return the buffer of PARSER. */) + (Lisp_Object parser) +{ + treesit_check_parser (parser); + Lisp_Object buf; + XSETBUFFER (buf, XBUFFER (XTS_PARSER (parser)->buffer)); + return buf; +} + +DEFUN ("treesit-parser-language", + Ftreesit_parser_language, Streesit_parser_language, + 1, 1, 0, + doc: /* Return PARSER's language symbol. +This symbol is the one used to create the parser. */) + (Lisp_Object parser) +{ + treesit_check_parser (parser); + return XTS_PARSER (parser)->language_symbol; +} + +/*** Parser API */ + +DEFUN ("treesit-parser-root-node", + Ftreesit_parser_root_node, Streesit_parser_root_node, + 1, 1, 0, + doc: /* Return the root node of PARSER. */) + (Lisp_Object parser) +{ + treesit_check_parser (parser); + treesit_initialize (); + treesit_ensure_parsed (parser); + TSNode root_node = ts_tree_root_node (XTS_PARSER (parser)->tree); + return make_treesit_node (parser, root_node); +} + +/* Checks that the RANGES argument of + treesit-parser-set-included-ranges is valid. */ +static void +treesit_check_range_argument (Lisp_Object ranges) +{ + struct buffer *buffer = current_buffer; + ptrdiff_t point_min = BUF_BEGV (buffer); + ptrdiff_t point_max = BUF_ZV (buffer); + EMACS_INT last_point = point_min; + Lisp_Object tail; + + tail = ranges; + + CHECK_LIST (tail); + + FOR_EACH_TAIL (tail) + { + CHECK_CONS (tail); + Lisp_Object range = XCAR (tail); + CHECK_CONS (range); + CHECK_FIXNUM (XCAR (range)); + CHECK_FIXNUM (XCDR (range)); + EMACS_INT beg = XFIXNUM (XCAR (range)); + EMACS_INT end = XFIXNUM (XCDR (range)); + if (!(last_point <= beg && beg <= end && end <= point_max)) + xsignal2 (Qtreesit_range_invalid, + build_pure_c_string ("RANGE is either overlapping," + " out-of-order or out-of-range"), + ranges); + last_point = end; + } + + CHECK_LIST_END (tail, ranges); +} + +/* Generate a list of ranges in Lisp from RANGES. Assumes tree-sitter + tree and the buffer has the same visible region (wrt narrowing). + This function doesn't take ownership of RANGES. BUFFER is used to + convert between tree-sitter buffer offset and buffer position. */ +static Lisp_Object +treesit_make_ranges (const TSRange *ranges, uint32_t len, + struct buffer *buffer) +{ + Lisp_Object list = Qnil; + for (int idx = 0; idx < len; idx++) + { + TSRange range = ranges[idx]; + uint32_t beg_byte = range.start_byte + BUF_BEGV_BYTE (buffer); + uint32_t end_byte = range.end_byte + BUF_BEGV_BYTE (buffer); + eassert (BUF_BEGV_BYTE (buffer) <= beg_byte); + eassert (beg_byte <= end_byte); + eassert (end_byte <= BUF_ZV_BYTE (buffer)); + + Lisp_Object lisp_range + = Fcons (make_fixnum (buf_bytepos_to_charpos (buffer, beg_byte)), + make_fixnum (buf_bytepos_to_charpos (buffer, end_byte))); + list = Fcons (lisp_range, list); + } + return Fnreverse (list); +} + +DEFUN ("treesit-parser-set-included-ranges", + Ftreesit_parser_set_included_ranges, + Streesit_parser_set_included_ranges, + 2, 2, 0, + doc: /* Limit PARSER to RANGES. + +RANGES is a list of (BEG . END), each (BEG . END) defines a region in +which the parser should operate. Regions must not overlap, and the +regions should come in order in the list. Signal +`treesit-set-range-error' if the argument is invalid, or something +else went wrong. If RANGES is nil, the PARSER is to parse the whole +buffer. */) + (Lisp_Object parser, Lisp_Object ranges) +{ + treesit_check_parser (parser); + if (!NILP (ranges)) + CHECK_CONS (ranges); + treesit_check_range_argument (ranges); + + treesit_initialize (); + /* Before we parse, catch up with narrowing/widening. */ + treesit_check_buffer_size (XBUFFER (XTS_PARSER (parser)->buffer)); + treesit_sync_visible_region (parser); + + bool success; + if (NILP (ranges)) + { + XTS_PARSER (parser)->has_range = false; + /* If RANGES is nil, make parser to parse the whole document. + To do that we give tree-sitter a 0 length, the range is a + dummy. */ + TSRange treesit_range = {{0, 0}, {0, 0}, 0, 0}; + success = ts_parser_set_included_ranges (XTS_PARSER (parser)->parser, + &treesit_range , 0); + } + else + { + /* Set ranges for PARSER. */ + XTS_PARSER (parser)->has_range = true; + + if (list_length (ranges) > UINT32_MAX) + xsignal (Qargs_out_of_range, list2 (ranges, Flength (ranges))); + uint32_t len = (uint32_t) list_length (ranges); + TSRange *treesit_ranges = xmalloc (sizeof (TSRange) * len); + struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer); + + for (int idx = 0; !NILP (ranges); idx++, ranges = XCDR (ranges)) + { + Lisp_Object range = XCAR (ranges); + EMACS_INT beg_byte = buf_charpos_to_bytepos (buffer, + XFIXNUM (XCAR (range))); + EMACS_INT end_byte = buf_charpos_to_bytepos (buffer, + XFIXNUM (XCDR (range))); + /* Shouldn't violate assertion since we just checked for + buffer size at the beginning of this function. */ + eassert (beg_byte - BUF_BEGV_BYTE (buffer) <= UINT32_MAX); + eassert (end_byte - BUF_BEGV_BYTE (buffer) <= UINT32_MAX); + /* We don't care about start and end points, put in dummy + values. */ + TSRange rg = {{0, 0}, {0, 0}, + (uint32_t) beg_byte - BUF_BEGV_BYTE (buffer), + (uint32_t) end_byte - BUF_BEGV_BYTE (buffer)}; + treesit_ranges[idx] = rg; + } + success = ts_parser_set_included_ranges (XTS_PARSER (parser)->parser, + treesit_ranges, len); + /* Although XFIXNUM could signal, it should be impossible + because we have checked the input by treesit_check_range_argument. + So there is no need for unwind-protect. */ + xfree (treesit_ranges); + } + + if (!success) + xsignal2 (Qtreesit_range_invalid, + build_pure_c_string ("Something went wrong when setting ranges"), + ranges); + + XTS_PARSER (parser)->need_reparse = true; + return Qnil; +} + +DEFUN ("treesit-parser-included-ranges", + Ftreesit_parser_included_ranges, + Streesit_parser_included_ranges, + 1, 1, 0, + doc: /* Return the ranges set for PARSER. +See `treesit-parser-set-ranges'. If no ranges are set for PARSER, +return nil. */) + (Lisp_Object parser) +{ + treesit_check_parser (parser); + treesit_initialize (); + + /* When the parser doesn't have a range set and we call + ts_parser_included_ranges on it, it doesn't return an empty list, + but rather return some garbled data. (A single range where + start_byte = 0, end_byte = UINT32_MAX). So we need to track + whether the parser is ranged ourselves. */ + if (!XTS_PARSER (parser)->has_range) + return Qnil; + + uint32_t len; + const TSRange *ranges + = ts_parser_included_ranges (XTS_PARSER (parser)->parser, &len); + + /* Our return value depends on the buffer state (BUF_BEGV_BYTE, + etc), so we need to sync up. */ + treesit_check_buffer_size (XBUFFER (XTS_PARSER (parser)->buffer)); + treesit_sync_visible_region (parser); + + struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer); + return treesit_make_ranges (ranges, len, buffer); +} + +DEFUN ("treesit-parser-notifiers", Ftreesit_parser_notifiers, + Streesit_parser_notifiers, + 1, 1, 0, + doc: /* Return the list of after-change notifier functions for PARSER. */) + (Lisp_Object parser) +{ + treesit_check_parser (parser); + + Lisp_Object return_list = Qnil; + Lisp_Object tail = XTS_PARSER (parser)->after_change_functions; + FOR_EACH_TAIL (tail) + return_list = Fcons (XCAR (tail), return_list); + + return return_list; +} + +DEFUN ("treesit-parser-add-notifier", Ftreesit_parser_add_notifier, + Streesit_parser_add_notifier, + 2, 2, 0, + doc: /* Add FUNCTION to the list of PARSER's after-change notifiers. +FUNCTION must be a function symbol, rather than a lambda form. +FUNCTION should take 2 arguments, RANGES and PARSER. RANGES is a list +of cons cells of the form (START . END), where START and END are buffer +positions. PARSER is the parser issuing the notification. */) + (Lisp_Object parser, Lisp_Object function) +{ + treesit_check_parser (parser); + /* For simplicity we don't accept lambda functions. */ + CHECK_SYMBOL (function); + + Lisp_Object functions = XTS_PARSER (parser)->after_change_functions; + if (NILP (Fmemq (function, functions))) + XTS_PARSER (parser)->after_change_functions = Fcons (function, functions); + return Qnil; +} + +DEFUN ("treesit-parser-remove-notifier", Ftreesit_parser_remove_notifier, + Streesit_parser_remove_notifier, + 2, 2, 0, + doc: /* Remove FUNCTION from the list of PARSER's after-change notifiers. + FUNCTION must be a function symbol, rather than a lambda form. +FUNCTION should take 2 arguments, RANGES and PARSER. RANGES is a list +of cons of the form (START . END), where START and END are buffer +positions. PARSER is the parser issuing the notification. */) + (Lisp_Object parser, Lisp_Object function) +{ + treesit_check_parser (parser); + /* For simplicity we don't accept lambda functions. */ + CHECK_SYMBOL (function); + + Lisp_Object functions = XTS_PARSER (parser)->after_change_functions; + if (!NILP (Fmemq (function, functions))) + XTS_PARSER (parser)->after_change_functions = Fdelq (function, functions); + return Qnil; +} + +/*** Node API */ + +/* Check that OBJ is a positive integer and signal an error if + otherwise. */ +static void +treesit_check_positive_integer (Lisp_Object obj) +{ + CHECK_INTEGER (obj); + if (XFIXNUM (obj) < 0) + xsignal1 (Qargs_out_of_range, obj); +} + +static void +treesit_check_node (Lisp_Object obj) +{ + CHECK_TS_NODE (obj); + if (!treesit_node_uptodate_p (obj)) + xsignal1 (Qtreesit_node_outdated, obj); +} + +bool +treesit_node_uptodate_p (Lisp_Object obj) +{ + Lisp_Object lisp_parser = XTS_NODE (obj)->parser; + return XTS_NODE (obj)->timestamp == XTS_PARSER (lisp_parser)->timestamp; +} + +DEFUN ("treesit-node-type", + Ftreesit_node_type, Streesit_node_type, 1, 1, 0, + doc: /* Return the NODE's type as a string. +If NODE is nil, return nil. */) + (Lisp_Object node) +{ + if (NILP (node)) return Qnil; + treesit_check_node (node); + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + const char *type = ts_node_type (treesit_node); + return build_string (type); +} + +DEFUN ("treesit-node-start", + Ftreesit_node_start, Streesit_node_start, 1, 1, 0, + doc: /* Return the NODE's start position in its buffer. +If NODE is nil, return nil. */) + (Lisp_Object node) +{ + if (NILP (node)) return Qnil; + treesit_check_node (node); + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg; + uint32_t start_byte_offset = ts_node_start_byte (treesit_node); + struct buffer *buffer + = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer); + ptrdiff_t start_pos + = buf_bytepos_to_charpos (buffer, + start_byte_offset + visible_beg); + return make_fixnum (start_pos); +} + +DEFUN ("treesit-node-end", + Ftreesit_node_end, Streesit_node_end, 1, 1, 0, + doc: /* Return the NODE's end position in its buffer. +If NODE is nil, return nil. */) + (Lisp_Object node) +{ + if (NILP (node)) return Qnil; + treesit_check_node (node); + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg; + uint32_t end_byte_offset = ts_node_end_byte (treesit_node); + struct buffer *buffer + = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer); + ptrdiff_t end_pos + = buf_bytepos_to_charpos (buffer, end_byte_offset + visible_beg); + return make_fixnum (end_pos); +} + +DEFUN ("treesit-node-string", + Ftreesit_node_string, Streesit_node_string, 1, 1, 0, + doc: /* Return the string representation of NODE. +If NODE is nil, return nil. */) + (Lisp_Object node) +{ + if (NILP (node)) return Qnil; + treesit_check_node (node); + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + char *string = ts_node_string (treesit_node); + return build_string (string); +} + +DEFUN ("treesit-node-parent", + Ftreesit_node_parent, Streesit_node_parent, 1, 1, 0, + doc: /* Return the immediate parent of NODE. +Return nil if NODE has no parent. If NODE is nil, return nil. */) + (Lisp_Object node) +{ + if (NILP (node)) return Qnil; + treesit_check_node (node); + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + TSNode parent = ts_node_parent (treesit_node); + + if (ts_node_is_null (parent)) + return Qnil; + + return make_treesit_node (XTS_NODE (node)->parser, parent); +} + +DEFUN ("treesit-node-child", + Ftreesit_node_child, Streesit_node_child, 2, 3, 0, + doc: /* Return the Nth child of NODE. + +Return nil if there is no Nth child. If NAMED is non-nil, look for +named child only. NAMED defaults to nil. If NODE is nil, return +nil. + +N could be negative, e.g., -1 represents the last child. */) + (Lisp_Object node, Lisp_Object n, Lisp_Object named) +{ + if (NILP (node)) return Qnil; + treesit_check_node (node); + CHECK_INTEGER (n); + EMACS_INT idx = XFIXNUM (n); + + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + TSNode child; + + /* Process negative index. */ + if (idx < 0) + { + if (NILP (named)) + idx = ts_node_child_count (treesit_node) + idx; + else + idx = ts_node_named_child_count (treesit_node) + idx; + } + if (idx < 0) + return Qnil; + if (idx > UINT32_MAX) + xsignal1 (Qargs_out_of_range, n); + + if (NILP (named)) + child = ts_node_child (treesit_node, (uint32_t) idx); + else + child = ts_node_named_child (treesit_node, (uint32_t) idx); + + if (ts_node_is_null (child)) + return Qnil; + + return make_treesit_node (XTS_NODE (node)->parser, child); +} + +DEFUN ("treesit-node-check", + Ftreesit_node_check, Streesit_node_check, 2, 2, 0, + doc: /* Return non-nil if NODE has PROPERTY, nil otherwise. + +PROPERTY could be `named', `missing', `extra', `outdated', or `has-error'. + +Named nodes correspond to named rules in the language definition, +whereas "anonymous" nodes correspond to string literals in the +language definition. + +Missing nodes are inserted by the parser in order to recover from +certain kinds of syntax errors, i.e., should be there but not there. + +Extra nodes represent things like comments, which are not required the +language definition, but can appear anywhere. + +A node is "outdated" if the parser has reparsed at least once after +the node was created. + +A node "has error" if itself is a syntax error or contains any syntax +errors. */) + (Lisp_Object node, Lisp_Object property) +{ + if (NILP (node)) return Qnil; + CHECK_TS_NODE (node); + CHECK_SYMBOL (property); + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + bool result; + + if (EQ (property, Qoutdated)) + return treesit_node_uptodate_p (node) ? Qnil : Qt; + + treesit_check_node (node); + if (EQ (property, Qnamed)) + result = ts_node_is_named (treesit_node); + else if (EQ (property, Qmissing)) + result = ts_node_is_missing (treesit_node); + else if (EQ (property, Qextra)) + result = ts_node_is_extra (treesit_node); + else if (EQ (property, Qhas_error)) + result = ts_node_has_error (treesit_node); + else + signal_error ("Expecting `named', `missing', `extra', " + "`outdated', or `has-error', but got", + property); + return result ? Qt : Qnil; +} + +DEFUN ("treesit-node-field-name-for-child", + Ftreesit_node_field_name_for_child, + Streesit_node_field_name_for_child, 2, 2, 0, + doc: /* Return the field name of the Nth child of NODE. + +Return nil if there's no Nth child, or if it has no field. +If NODE is nil, return nil. + +N counts all children, i.e., named ones and anonymous ones. + +N could be negative, e.g., -1 represents the last child. */) + (Lisp_Object node, Lisp_Object n) +{ + if (NILP (node)) + return Qnil; + treesit_check_node (node); + CHECK_INTEGER (n); + EMACS_INT idx = XFIXNUM (n); + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + + /* Process negative index. */ + if (idx < 0) + idx = ts_node_child_count (treesit_node) + idx; + if (idx < 0) + return Qnil; + if (idx > UINT32_MAX) + xsignal1 (Qargs_out_of_range, n); + + const char *name + = ts_node_field_name_for_child (treesit_node, (uint32_t) idx); + + if (name == NULL) + return Qnil; + + return build_string (name); +} + +DEFUN ("treesit-node-child-count", + Ftreesit_node_child_count, + Streesit_node_child_count, 1, 2, 0, + doc: /* Return the number of children of NODE. + +If NAMED is non-nil, count named children only. NAMED defaults to +nil. If NODE is nil, return nil. */) + (Lisp_Object node, Lisp_Object named) +{ + if (NILP (node)) + return Qnil; + treesit_check_node (node); + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + uint32_t count; + if (NILP (named)) + count = ts_node_child_count (treesit_node); + else + count = ts_node_named_child_count (treesit_node); + return make_fixnum (count); +} + +DEFUN ("treesit-node-child-by-field-name", + Ftreesit_node_child_by_field_name, + Streesit_node_child_by_field_name, 2, 2, 0, + doc: /* Return the child of NODE with FIELD-NAME. +Return nil if there is no such child. If NODE is nil, return nil. */) + (Lisp_Object node, Lisp_Object field_name) +{ + if (NILP (node)) + return Qnil; + treesit_check_node (node); + CHECK_STRING (field_name); + treesit_initialize (); + + char *name_str = SSDATA (field_name); + TSNode treesit_node = XTS_NODE (node)->node; + TSNode child + = ts_node_child_by_field_name (treesit_node, name_str, + strlen (name_str)); + + if (ts_node_is_null (child)) + return Qnil; + + return make_treesit_node (XTS_NODE (node)->parser, child); +} + +DEFUN ("treesit-node-next-sibling", + Ftreesit_node_next_sibling, + Streesit_node_next_sibling, 1, 2, 0, + doc: /* Return the next sibling of NODE. + +Return nil if there is no next sibling. If NAMED is non-nil, look for named +siblings only. NAMED defaults to nil. If NODE is nil, return nil. */) + (Lisp_Object node, Lisp_Object named) +{ + if (NILP (node)) return Qnil; + treesit_check_node (node); + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + TSNode sibling; + if (NILP (named)) + sibling = ts_node_next_sibling (treesit_node); + else + sibling = ts_node_next_named_sibling (treesit_node); + + if (ts_node_is_null (sibling)) + return Qnil; + + return make_treesit_node (XTS_NODE (node)->parser, sibling); +} + +DEFUN ("treesit-node-prev-sibling", + Ftreesit_node_prev_sibling, + Streesit_node_prev_sibling, 1, 2, 0, + doc: /* Return the previous sibling of NODE. + +Return nil if there is no previous sibling. If NAMED is non-nil, look +for named siblings only. NAMED defaults to nil. If NODE is nil, +return nil. */) + (Lisp_Object node, Lisp_Object named) +{ + if (NILP (node)) return Qnil; + treesit_check_node (node); + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + TSNode sibling; + + if (NILP (named)) + sibling = ts_node_prev_sibling (treesit_node); + else + sibling = ts_node_prev_named_sibling (treesit_node); + + if (ts_node_is_null (sibling)) + return Qnil; + + return make_treesit_node (XTS_NODE (node)->parser, sibling); +} + +DEFUN ("treesit-node-first-child-for-pos", + Ftreesit_node_first_child_for_pos, + Streesit_node_first_child_for_pos, 2, 3, 0, + doc: /* Return the first child of NODE for buffer position POS. + +Specifically, return the first child that extends beyond POS. +Return nil if there is no such child. +If NAMED is non-nil, look for named children only. NAMED defaults to nil. +Note that this function returns an immediate child, not the smallest +(grand)child. If NODE is nil, return nil. */) + (Lisp_Object node, Lisp_Object pos, Lisp_Object named) +{ + if (NILP (node)) + return Qnil; + treesit_check_node (node); + treesit_check_positive_integer (pos); + + struct buffer *buf = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer); + ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg; + ptrdiff_t byte_pos = buf_charpos_to_bytepos (buf, XFIXNUM (pos)); + + if (byte_pos < BUF_BEGV_BYTE (buf) || byte_pos > BUF_ZV_BYTE (buf)) + xsignal1 (Qargs_out_of_range, pos); + + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + TSNode child; + if (NILP (named)) + child = ts_node_first_child_for_byte (treesit_node, byte_pos - visible_beg); + else + child = ts_node_first_named_child_for_byte (treesit_node, + byte_pos - visible_beg); + + if (ts_node_is_null (child)) + return Qnil; + + return make_treesit_node (XTS_NODE (node)->parser, child); +} + +DEFUN ("treesit-node-descendant-for-range", + Ftreesit_node_descendant_for_range, + Streesit_node_descendant_for_range, 3, 4, 0, + doc: /* Return the smallest node that covers buffer positions BEG to END. + +The returned node is a descendant of NODE. +Return nil if there is no such node. +If NAMED is non-nil, look for named child only. NAMED defaults to nil. +If NODE is nil, return nil. */) + (Lisp_Object node, Lisp_Object beg, Lisp_Object end, Lisp_Object named) +{ + if (NILP (node)) return Qnil; + treesit_check_node (node); + CHECK_INTEGER (beg); + CHECK_INTEGER (end); + + struct buffer *buf = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer); + ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg; + ptrdiff_t byte_beg = buf_charpos_to_bytepos (buf, XFIXNUM (beg)); + ptrdiff_t byte_end = buf_charpos_to_bytepos (buf, XFIXNUM (end)); + + /* Checks for BUFFER_BEG <= BEG <= END <= BUFFER_END. */ + if (!(BUF_BEGV_BYTE (buf) <= byte_beg + && byte_beg <= byte_end + && byte_end <= BUF_ZV_BYTE (buf))) + xsignal2 (Qargs_out_of_range, beg, end); + + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + TSNode child; + if (NILP (named)) + child = ts_node_descendant_for_byte_range (treesit_node, byte_beg - visible_beg, + byte_end - visible_beg); + else + child = ts_node_named_descendant_for_byte_range (treesit_node, + byte_beg - visible_beg, + byte_end - visible_beg); + + if (ts_node_is_null (child)) + return Qnil; + + return make_treesit_node (XTS_NODE (node)->parser, child); +} + +DEFUN ("treesit-node-eq", + Ftreesit_node_eq, + Streesit_node_eq, 2, 2, 0, + doc: /* Return non-nil if NODE1 and NODE2 are the same node. +If any one of NODE1 and NODE2 is nil, return nil. */) + (Lisp_Object node1, Lisp_Object node2) +{ + if (NILP (node1) || NILP (node2)) + return Qnil; + CHECK_TS_NODE (node1); + CHECK_TS_NODE (node2); + + treesit_initialize (); + + TSNode treesit_node_1 = XTS_NODE (node1)->node; + TSNode treesit_node_2 = XTS_NODE (node2)->node; + + bool same_node = ts_node_eq (treesit_node_1, treesit_node_2); + return same_node ? Qt : Qnil; +} + +/*** Query functions */ + +DEFUN ("treesit-pattern-expand", + Ftreesit_pattern_expand, + Streesit_pattern_expand, 1, 1, 0, + doc: /* Expand PATTERN to its string form. + +PATTERN can be + + :anchor + :? + :* + :+ + :equal + :match + (TYPE PATTERN...) + [PATTERN...] + FIELD-NAME: + @CAPTURE-NAME + (_) + _ + \"TYPE\" + +See Info node `(elisp)Pattern Matching' for detailed explanation. */) + (Lisp_Object pattern) +{ + if (EQ (pattern, QCanchor)) + return build_pure_c_string ("."); + if (EQ (pattern, intern_c_string (":?"))) + return build_pure_c_string ("?"); + if (EQ (pattern, intern_c_string (":*"))) + return build_pure_c_string ("*"); + if (EQ (pattern, intern_c_string (":+"))) + return build_pure_c_string ("+"); + if (EQ (pattern, QCequal)) + return build_pure_c_string ("#equal"); + if (EQ (pattern, QCmatch)) + return build_pure_c_string ("#match"); + Lisp_Object opening_delimeter + = build_pure_c_string (VECTORP (pattern) ? "[" : "("); + Lisp_Object closing_delimiter + = build_pure_c_string (VECTORP (pattern) ? "]" : ")"); + if (VECTORP (pattern) || CONSP (pattern)) + return concat3 (opening_delimeter, + Fmapconcat (Qtreesit_pattern_expand, + pattern, + build_pure_c_string (" ")), + closing_delimiter); + return CALLN (Fformat, build_pure_c_string ("%S"), pattern); +} + +DEFUN ("treesit-query-expand", + Ftreesit_query_expand, + Streesit_query_expand, 1, 1, 0, + doc: /* Expand sexp QUERY to its string form. + +A PATTERN in QUERY can be + + :anchor + :? + :* + :+ + :equal + :match + (TYPE PATTERN...) + [PATTERN...] + FIELD-NAME: + @CAPTURE-NAME + (_) + _ + \"TYPE\" + +See Info node `(elisp)Pattern Matching' for detailed explanation. */) + (Lisp_Object query) +{ + return Fmapconcat (Qtreesit_pattern_expand, + query, build_pure_c_string (" ")); +} + +/* This struct is used for passing captures to be check against + predicates. Captures we check for are the ones in START before + END. For example, if START and END are + + START END + v v + (1 . (2 . (3 . (4 . (5 . (6 . nil)))))) + + We only look at captures 1 2 3. */ +struct capture_range +{ + Lisp_Object start; + Lisp_Object end; +}; + +/* Collect predicates for this match and return them in a list. Each + predicate is a list of strings and symbols. */ +static Lisp_Object +treesit_predicates_for_pattern (TSQuery *query, uint32_t pattern_index) +{ + uint32_t len; + const TSQueryPredicateStep *predicate_list + = ts_query_predicates_for_pattern (query, pattern_index, &len); + Lisp_Object result = Qnil; + Lisp_Object predicate = Qnil; + for (int idx = 0; idx < len; idx++) + { + TSQueryPredicateStep step = predicate_list[idx]; + switch (step.type) + { + case TSQueryPredicateStepTypeCapture: + { + uint32_t str_len; + const char *str = ts_query_capture_name_for_id (query, + step.value_id, + &str_len); + predicate = Fcons (intern_c_string_1 (str, str_len), + predicate); + break; + } + case TSQueryPredicateStepTypeString: + { + uint32_t str_len; + const char *str = ts_query_string_value_for_id (query, + step.value_id, + &str_len); + predicate = Fcons (make_string (str, str_len), predicate); + break; + } + case TSQueryPredicateStepTypeDone: + result = Fcons (Fnreverse (predicate), result); + predicate = Qnil; + break; + } + } + return Fnreverse (result); +} + +/* 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 +treesit_predicate_capture_name_to_text (Lisp_Object name, + struct capture_range captures) +{ + Lisp_Object 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)); + break; + } + } + + if (NILP (node)) + xsignal3 (Qtreesit_query_error, + build_pure_c_string ("Cannot find captured node"), + name, build_pure_c_string ("A predicate can only refer" + " to captured nodes in the " + "same pattern")); + + 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)); + set_buffer_internal (old_buffer); + return text; +} + +/* 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. */ +static bool +treesit_predicate_equal (Lisp_Object args, struct capture_range captures) +{ + if (XFIXNUM (Flength (args)) != 2) + xsignal2 (Qtreesit_query_error, + build_pure_c_string ("Predicate `equal' requires " + "two arguments but only given"), + Flength (args)); + + 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)); + + 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. */ +static bool +treesit_predicate_match (Lisp_Object args, struct capture_range captures) +{ + if (XFIXNUM (Flength (args)) != 2) + xsignal2 (Qtreesit_query_error, + build_pure_c_string ("Predicate `equal' requires two " + "arguments but only given"), + Flength (args)); + + Lisp_Object regexp = XCAR (args); + Lisp_Object capture_name = XCAR (XCDR (args)); + + /* It's probably common to get the argument order backwards. Catch + this mistake early and show helpful explanation, because Emacs + loves you. (We put the regexp first because that's what + string-match does.) */ + if (!STRINGP (regexp)) + xsignal1 (Qtreesit_query_error, + build_pure_c_string ("The first argument to `match' should " + "be a regexp string, not a capture name")); + if (!SYMBOLP (capture_name)) + xsignal1 (Qtreesit_query_error, + build_pure_c_string ("The second argument to `match' should " + "be a capture name, not a string")); + + Lisp_Object text = treesit_predicate_capture_name_to_text (capture_name, + captures); + + if (fast_string_match (regexp, text) >= 0) + return true; + else + return false; +} + +/* About predicates: I decide to hard-code predicates in C instead of + implementing an extensible system where predicates are translated + to Lisp functions, and new predicates can be added by extending a + list of functions, because I really couldn't imagine any useful + predicates besides equal and match. If we later found out that + such system is indeed useful and necessary, it can be easily + added. */ + +/* If all predicates in PREDICATES passes, return true; otherwise + return false. */ +static bool +treesit_eval_predicates (struct capture_range captures, Lisp_Object predicates) +{ + bool pass = true; + /* Evaluate each predicates. */ + for (Lisp_Object tail = predicates; + !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, build_pure_c_string ("equal")))) + pass = treesit_predicate_equal (args, captures); + else if (!NILP (Fstring_equal (fn, build_pure_c_string ("match")))) + pass = treesit_predicate_match (args, captures); + else + xsignal3 (Qtreesit_query_error, + build_pure_c_string ("Invalid predicate"), + fn, build_pure_c_string ("Currently Emacs only supports" + " equal and match predicate")); + } + /* If all predicates passed, add captures to result list. */ + return pass; +} + +DEFUN ("treesit-query-compile", + Ftreesit_query_compile, + Streesit_query_compile, 2, 3, 0, + doc: /* Compile QUERY to a compiled query. + +Querying with a compiled query is much faster than an uncompiled one. +LANGUAGE is the language this query is for. + +If EAGER is non-nil, immediately load LANGUAGE and compile the query. +Otherwise defer the compilation until the query is first used. + +Signal `treesit-query-error' if QUERY is malformed or something else +goes wrong. (This only happens if EAGER is non-nil.) +You can use `treesit-query-validate' to validate and debug a query. */) + (Lisp_Object language, Lisp_Object query, Lisp_Object eager) +{ + if (NILP (Ftreesit_query_p (query))) + wrong_type_argument (Qtreesit_query_p, query); + CHECK_SYMBOL (language); + if (TS_COMPILED_QUERY_P (query)) + return query; + + treesit_initialize (); + + Lisp_Object lisp_query = make_treesit_query (query, language); + + /* Maybe actually compile. */ + if (NILP (eager)) + return lisp_query; + else + { + Lisp_Object signal_symbol = Qnil; + Lisp_Object signal_data = Qnil; + TSQuery *treesit_query = treesit_ensure_query_compiled (lisp_query, + &signal_symbol, + &signal_data); + + if (treesit_query == NULL) + xsignal (signal_symbol, signal_data); + + return lisp_query; + } +} + +DEFUN ("treesit-query-capture", + Ftreesit_query_capture, + Streesit_query_capture, 2, 5, 0, + doc: /* Query NODE with patterns in QUERY. + +Return a list of (CAPTURE_NAME . NODE). CAPTURE_NAME is the name +assigned to the node in PATTERN. NODE is the captured node. + +QUERY is either a string query, a sexp query, or a compiled query. +See Info node `(elisp)Pattern Matching' for how to write a query in +either string or sexp form. When using repeatedly, a compiled query +is much faster than a string or sexp one, so it is recommend to +compile your query if it will be used repeatedly. + +BEG and END, if both non-nil, specify the region of buffer positions +in which the query is executed. Any matching node whose span overlaps +with the region between BEG and END are captured, it doesn't have to +be completely in the region. + +If NODE-ONLY is non-nil, return a list of nodes. + +Besides a node, NODE can also be a parser, in which case the root node +of that parser is used. +NODE can also be a language symbol, in which case the root node of a +parser for that language is used. If such a parser doesn't exist, it +is created. + +Signal `treesit-query-error' if QUERY is malformed or something else +goes wrong. You can use `treesit-query-validate' to validate and debug +the query. */) + (Lisp_Object node, Lisp_Object query, + Lisp_Object beg, Lisp_Object end, Lisp_Object node_only) +{ + if (!NILP (beg)) + CHECK_INTEGER (beg); + if (!NILP (end)) + CHECK_INTEGER (end); + + if (!(TS_COMPILED_QUERY_P (query) + || CONSP (query) || STRINGP (query))) + wrong_type_argument (Qtreesit_query_p, query); + + /* Resolve NODE into an actual node. */ + Lisp_Object lisp_node; + if (TS_NODEP (node)) + lisp_node = node; + else if (TS_PARSERP (node)) + 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); + + treesit_initialize (); + + /* 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; + const TSLanguage *lang + = ts_parser_language (XTS_PARSER (lisp_parser)->parser); + + /* Initialize query objects. At the end of this block, we should + have a working TSQuery and a TSQueryCursor. */ + 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)); + cursor = ts_query_cursor_new (); + needs_to_free_query_and_cursor = true; + } + + /* WARN: After this point, free treesit_query and cursor before every + signal and return. */ + + /* Set query range. */ + if (!NILP (beg) && !NILP (end)) + { + EMACS_INT beg_byte = XFIXNUM (beg); + EMACS_INT end_byte = XFIXNUM (end); + /* We never let tree-sitter run on buffers too large, so these + assertion should never hit. */ + eassert (beg_byte - visible_beg <= UINT32_MAX); + eassert (end_byte - visible_beg <= UINT32_MAX); + ts_query_cursor_set_byte_range (cursor, (uint32_t) beg_byte - visible_beg, + (uint32_t) end_byte - visible_beg); + } + + /* Execute query. */ + ts_query_cursor_exec (cursor, treesit_query, treesit_node); + TSQueryMatch match; + + /* Go over each match, collect captures and predicates. Include the + captures in the RESULT list unconditionally as we get them, then + test for predicates. If predicates pass, then all good, if + predicates don't pass, revert the result back to the result + before this loop (PREV_RESULT). (Predicates control the entire + match.) This way we don't need to create a list of captures in + every for loop and nconc it to RESULT every time. That is indeed + the initial implementation in which Yoav found nconc being the + bottleneck (98.4% of the running time spent on nconc). */ + Lisp_Object result = Qnil; + Lisp_Object prev_result = result; + while (ts_query_cursor_next_match (cursor, &match)) + { + /* Record the checkpoint that we may roll back to. */ + prev_result = result; + /* Get captured nodes. */ + const TSQueryCapture *captures = match.captures; + for (int idx = 0; idx < match.capture_count; idx++) + { + uint32_t capture_name_len; + TSQueryCapture capture = captures[idx]; + Lisp_Object captured_node = make_treesit_node (lisp_parser, + capture.node); + + Lisp_Object cap; + if (NILP (node_only)) + { + const char *capture_name + = ts_query_capture_name_for_id (treesit_query, capture.index, + &capture_name_len); + cap = Fcons (intern_c_string_1 (capture_name, capture_name_len), + captured_node); + } + else + cap = captured_node; + + result = Fcons (cap, result); + } + /* Get predicates. */ + Lisp_Object predicates + = treesit_predicates_for_pattern (treesit_query, + match.pattern_index); + + /* 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. */ + result = prev_result; + } + if (needs_to_free_query_and_cursor) + { + ts_query_delete (treesit_query); + ts_query_cursor_delete (cursor); + } + return Fnreverse (result); +} + +/*** Navigation */ + +/* Return the next/previous named/unnamed sibling of NODE. FORWARD + controls the direction and NAMED controls the nameness. */ +static TSNode +treesit_traverse_sibling_helper (TSNode node, bool forward, bool named) +{ + if (forward) + { + if (named) + return ts_node_next_named_sibling (node); + else + return ts_node_next_sibling (node); + } + else + { + if (named) + return ts_node_prev_named_sibling (node); + else + return ts_node_prev_sibling (node); + } +} + +/* Return the first/last named/unnamed child of NODE. FORWARD controls + the direction and NAMED controls the nameness. */ +static TSNode +treesit_traverse_child_helper (TSNode node, bool forward, bool named) +{ + if (forward) + { + if (named) + return ts_node_named_child (node, 0); + else + return ts_node_child (node, 0); + } + else + { + if (named) + { + uint32_t count = ts_node_named_child_count (node); + uint32_t idx = count == 0 ? 0 : count - 1; + return ts_node_named_child (node, idx); + } + else + { + uint32_t count = ts_node_child_count (node); + uint32_t idx = count == 0 ? 0 : count - 1; + return ts_node_child (node, idx); + } + } +} + +/* Return true if NODE matches PRED. PRED can be a string or a + function. This function assumes PRED is either a string or a + function. */ +static bool +treesit_traverse_match_predicate (TSNode node, Lisp_Object pred, + Lisp_Object parser) +{ + if (STRINGP (pred)) + { + const char *type = ts_node_type (node); + return fast_c_string_match (pred, type, strlen (type)) >= 0; + } + else + { + Lisp_Object lisp_node = make_treesit_node (parser, node); + return !NILP (CALLN (Ffuncall, pred, lisp_node)); + } + +} + +/* Traverse the parse tree starting from ROOT (but ROOT is not + matches against PRED). PRED can be a function (takes a node and + returns nil/non-nil),or a string (treated as regexp matching the + node's type, ignores case, must be all single byte characters). If + the node satisfies PRED , terminate, set ROOT to that node, and + return true. If no node satisfies PRED, return FALSE. PARSER is + the parser of ROOT. + + LIMIT is the number of levels we descend in the tree. If NO_LIMIT + is true, LIMIT is ignored. FORWARD controls the direction in which + we traverse the tree, true means forward, false backward. If NAMED + is true, only traverse named nodes, if false, all nodes. If + SKIP_ROOT is true, don't match ROOT. */ +static bool +treesit_search_dfs (TSNode *root, Lisp_Object pred, Lisp_Object parser, + bool named, bool forward, ptrdiff_t limit, bool no_limit, + bool skip_root) +{ + /* TSTreeCursor doesn't allow us to move backward, so we can't use + it. We could use limit == -1 to indicate no_limit == true, but + separating them is safer. */ + TSNode node = *root; + + if (!skip_root && treesit_traverse_match_predicate (node, pred, parser)) + { + *root = node; + return true; + } + + if (!no_limit && limit <= 0) + return false; + else + { + int count = (named + ? ts_node_named_child_count (node) + : ts_node_child_count (node)); + for (int offset = 0; offset < count; offset++) + { + uint32_t idx = forward ? offset : count - offset - 1; + TSNode child = (named + ? ts_node_named_child (node, idx) + : ts_node_child (node, idx)); + + if (!ts_node_is_null (child) + && treesit_search_dfs (&child, pred, parser, named, + forward, limit - 1, no_limit, false)) + { + *root = child; + return true; + } + } + return false; + } +} + +/* Go through the whole tree linearly, leaf-first, starting from + START. PRED, PARSER, NAMED, FORWARD are the same as in + ts_search_subtre. If UP_ONLY is true, never go to children, only + sibling and parents. */ +static bool +treesit_search_forward (TSNode *start, Lisp_Object pred, Lisp_Object parser, + bool named, bool forward) +{ + TSNode node = *start; + + /* We don't search for subtree and always search from the leaf + nodes. This way repeated call of this function traverses each + node in the tree once and only once: + + (while node (setq node (treesit-search-forward node))) + */ + bool initial = true; + while (true) + { + if (!initial /* We don't match START. */ + && treesit_traverse_match_predicate (node, pred, parser)) + { + *start = node; + return true; + } + initial = false; + + TSNode next = treesit_traverse_sibling_helper (node, forward, named); + while (ts_node_is_null (next)) + { + /* There is no next sibling, go to parent. */ + node = ts_node_parent (node); + if (ts_node_is_null (node)) + return false; + + if (treesit_traverse_match_predicate (node, pred, parser)) + { + *start = node; + return true; + } + next = treesit_traverse_sibling_helper (node, forward, named); + } + /* We are at the next sibling, deep dive into the first leaf + node. */ + TSNode next_next = treesit_traverse_child_helper (next, forward, named); + while (!ts_node_is_null (next_next)) + { + next = next_next; + next_next = treesit_traverse_child_helper (next, forward, named); + } + /* At this point NEXT is a leaf node. */ + node = next; + } +} + +DEFUN ("treesit-search-subtree", + Ftreesit_search_subtree, + Streesit_search_subtree, 2, 5, 0, + doc: /* Traverse the parse tree of NODE depth-first using PREDICATE. + +Traverse the subtree of NODE, and match PREDICATE with each node along +the way. PREDICATE is a regexp string that matches against each +node's type, or a function that takes a node and returns nil/non-nil. + +By default, only traverse named nodes, but if ALL is non-nil, traverse +all nodes. If BACKWARD is non-nil, traverse backwards. If LIMIT is +non-nil, only traverse nodes up to that number of levels down in the tree. + +Return the first matched node, or nil if none matches. */) + (Lisp_Object node, Lisp_Object predicate, Lisp_Object backward, + Lisp_Object all, Lisp_Object limit) +{ + CHECK_TS_NODE (node); + CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate), + list3 (Qor, Qstringp, Qfunctionp), predicate); + CHECK_SYMBOL (all); + CHECK_SYMBOL (backward); + + ptrdiff_t the_limit = 0; + bool no_limit = false; + if (NILP (limit)) + no_limit = true; + else + { + CHECK_FIXNUM (limit); + the_limit = XFIXNUM (limit); + } + + treesit_initialize (); + + TSNode treesit_node = XTS_NODE (node)->node; + Lisp_Object parser = XTS_NODE (node)->parser; + if (treesit_search_dfs (&treesit_node, predicate, parser, NILP (all), + NILP (backward), the_limit, no_limit, false)) + return make_treesit_node (parser, treesit_node); + else + return Qnil; +} + +DEFUN ("treesit-search-forward", + Ftreesit_search_forward, + Streesit_search_forward, 2, 4, 0, + doc: /* Search for node matching PREDICATE in the parse tree of START. + +Start traversing the tree from node START, and match PREDICATE with +each node (except START itself) along the way. PREDICATE is a regexp +string that matches against each node's type, or a function that takes +a node and returns non-nil if it matches. + +By default, only search for named nodes, but if ALL is non-nil, search +for all nodes. If BACKWARD is non-nil, search backwards. + +Return the first matched node, or nil if none matches. + +For a tree like below, where START is marked by S, traverse as +numbered from 1 to 12: + + 12 + | + S--------3----------11 + | | | + o--o-+--o 1--+--2 6--+-----10 + | | | | + o o +-+-+ +--+--+ + | | | | | + 4 5 7 8 9 + +Note that this function doesn't traverse the subtree of START, and it +always traverse leaf nodes first, then upwards. */) + (Lisp_Object start, Lisp_Object predicate, Lisp_Object backward, + Lisp_Object all) +{ + CHECK_TS_NODE (start); + CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate), + list3 (Qor, Qstringp, Qfunctionp), predicate); + CHECK_SYMBOL (all); + CHECK_SYMBOL (backward); + + treesit_initialize (); + + TSNode treesit_start = XTS_NODE (start)->node; + Lisp_Object parser = XTS_NODE (start)->parser; + if (treesit_search_forward (&treesit_start, predicate, parser, NILP (all), + NILP (backward))) + return make_treesit_node (parser, treesit_start); + else + return Qnil; +} + +/* Recursively traverse the tree under CURSOR, and append the result + subtree to PARENT's cdr. See more in Ftreesit_induce_sparse_tree. + Note that the top-level children list is reversed, because + reasons. */ +static void +treesit_build_sparse_tree (TSTreeCursor *cursor, Lisp_Object parent, + Lisp_Object pred, Lisp_Object process_fn, + ptrdiff_t limit, bool no_limit, Lisp_Object parser) +{ + + TSNode node = ts_tree_cursor_current_node (cursor); + bool match = treesit_traverse_match_predicate (node, pred, parser); + if (match) + { + /* If this node matches pred, add a new node to the parent's + children list. */ + Lisp_Object lisp_node = make_treesit_node (parser, node); + if (!NILP (process_fn)) + lisp_node = CALLN (Ffuncall, process_fn, lisp_node); + + Lisp_Object this = Fcons (lisp_node, Qnil); + Fsetcdr (parent, Fcons (this, Fcdr (parent))); + /* Now for children nodes, this is the new parent. */ + parent = this; + } + /* Go through each child. */ + if ((no_limit || limit > 0) + && ts_tree_cursor_goto_first_child (cursor)) + { + do + { + /* Make sure not to use node after the recursive funcall. + Then C compilers should be smart enough not to copy NODE + to stack. */ + treesit_build_sparse_tree (cursor, parent, pred, process_fn, + limit - 1, no_limit, parser); + } + while (ts_tree_cursor_goto_next_sibling (cursor)); + /* Don't forget to come back to this node. */ + ts_tree_cursor_goto_parent (cursor); + } + /* Before we go, reverse children in the sparse tree. */ + if (match) + /* When match == true, "parent" is actually the node we added in + this layer (parent = this). */ + Fsetcdr (parent, Fnreverse (Fcdr (parent))); +} + +DEFUN ("treesit-induce-sparse-tree", + Ftreesit_induce_sparse_tree, + Streesit_induce_sparse_tree, 2, 4, 0, + doc: /* Create a sparse tree of ROOT's subtree. + +This takes the subtree under ROOT, and combs it so only the nodes +that match PREDICATE are left, like picking out grapes on the vine. +PREDICATE is a regexp string that matches against each node's type. + +For a subtree on the left that consist of both numbers and letters, if +PREDICATE is "is letter", the returned tree is the one on the right. + + a a a + | | | + +---+---+ +---+---+ +---+---+ + | | | | | | | | | + b 1 2 b | | b c d + | | => | | => | + c +--+ c + e + | | | | | + +--+ d 4 +--+ d + | | | + e 5 e + +If PROCESS-FN is non-nil, it should be a function of one argument. In +that case, instead of returning the matched nodes, pass each node to +PROCESS-FN, and use its return value instead. + +If non-nil, LIMIT is the number of levels to go down the tree from ROOT. + +Each node in the returned tree looks like (NODE . (CHILD ...)). The +root of this tree might be nil, if ROOT doesn't match PREDICATE. + +If no node matches PREDICATE, return nil. + +PREDICATE can also be a function that takes a node and returns +nil/non-nil, but it is slower and more memory consuming than using +a regexp. */) + (Lisp_Object root, Lisp_Object predicate, Lisp_Object process_fn, + Lisp_Object limit) +{ + CHECK_TS_NODE (root); + CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate), + list3 (Qor, Qstringp, Qfunctionp), predicate); + + if (!NILP (process_fn)) + CHECK_TYPE (FUNCTIONP (process_fn), Qfunctionp, process_fn); + ptrdiff_t the_limit = 0; + bool no_limit = false; + if (NILP (limit)) + no_limit = true; + else + { + CHECK_FIXNUM (limit); + the_limit = XFIXNUM (limit); + } + + treesit_initialize (); + + TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (root)->node); + Lisp_Object parser = XTS_NODE (root)->parser; + Lisp_Object parent = Fcons (Qnil, Qnil); + treesit_build_sparse_tree (&cursor, parent, predicate, process_fn, + the_limit, no_limit, parser); + Fsetcdr (parent, Fnreverse (Fcdr (parent))); + if (NILP (Fcdr (parent))) + return Qnil; + else + return parent; +} + +#endif /* HAVE_TREE_SITTER */ + +DEFUN ("treesit-available-p", Ftreesit_available_p, + Streesit_available_p, 0, 0, 0, + doc: /* Return non-nil if tree-sitter support is built-in and available. */) + (void) +{ +#if HAVE_TREE_SITTER + return load_tree_sitter_if_necessary (false) ? Qt : Qnil; +#else + return Qnil; +#endif +} + + +/*** Initialization */ + +/* Initialize the tree-sitter routines. */ +void +syms_of_treesit (void) +{ +#if HAVE_TREE_SITTER + DEFSYM (Qtreesit_parser_p, "treesit-parser-p"); + DEFSYM (Qtreesit_node_p, "treesit-node-p"); + DEFSYM (Qtreesit_compiled_query_p, "treesit-compiled-query-p"); + DEFSYM (Qtreesit_query_p, "treesit-query-p"); + DEFSYM (Qnamed, "named"); + DEFSYM (Qmissing, "missing"); + DEFSYM (Qextra, "extra"); + DEFSYM (Qoutdated, "outdated"); + DEFSYM (Qhas_error, "has-error"); + + DEFSYM (QCanchor, ":anchor"); + DEFSYM (QCequal, ":equal"); + DEFSYM (QCmatch, ":match"); + + DEFSYM (Qnot_found, "not-found"); + DEFSYM (Qsymbol_error, "symbol-error"); + DEFSYM (Qversion_mismatch, "version-mismatch"); + + DEFSYM (Qtreesit_error, "treesit-error"); + DEFSYM (Qtreesit_query_error, "treesit-query-error"); + DEFSYM (Qtreesit_parse_error, "treesit-parse-error"); + DEFSYM (Qtreesit_range_invalid, "treesit-range-invalid"); + DEFSYM (Qtreesit_buffer_too_large, + "treesit-buffer-too-large"); + DEFSYM (Qtreesit_load_language_error, + "treesit-load-language-error"); + DEFSYM (Qtreesit_node_outdated, + "treesit-node-outdated"); + DEFSYM (Quser_emacs_directory, + "user-emacs-directory"); + DEFSYM (Qtreesit_parser_deleted, "treesit-parser-deleted"); + DEFSYM (Qtreesit_pattern_expand, "treesit-pattern-expand"); + + DEFSYM (Qor, "or"); + +#ifdef WINDOWSNT + DEFSYM (Qtree_sitter, "tree-sitter"); +#endif + + define_error (Qtreesit_error, "Generic tree-sitter error", Qerror); + define_error (Qtreesit_query_error, "Query pattern is malformed", + Qtreesit_error); + /* Should be impossible, no need to document this error. */ + define_error (Qtreesit_parse_error, "Parse failed", + Qtreesit_error); + define_error (Qtreesit_range_invalid, + "RANGES are invalid, they have to be ordered and not overlapping", + Qtreesit_error); + define_error (Qtreesit_buffer_too_large, "Buffer too large (> 4GB)", + Qtreesit_error); + define_error (Qtreesit_load_language_error, + "Cannot load language definition", + Qtreesit_error); + define_error (Qtreesit_node_outdated, + "This node is outdated, please retrieve a new one", + Qtreesit_error); + define_error (Qtreesit_parser_deleted, + "This parser is deleted and cannot be used", + Qtreesit_error); + + DEFVAR_LISP ("treesit-load-name-override-list", + Vtreesit_load_name_override_list, + doc: + /* An override list for unconventional tree-sitter libraries. + +By default, Emacs assumes the dynamic library for LANG is +libtree-sitter-LANG.EXT, where EXT is the OS specific extension for +dynamic libraries. Emacs also assumes that the name of the C function +the library provides is tree_sitter_LANG. If that is not the case, +you can add an entry + + (LANG LIBRARY-BASE-NAME FUNCTION-NAME) + +to this list, where LIBRARY-BASE-NAME is the filename of the dynamic +library without the file-name extension, and FUNCTION-NAME is the +function provided by the library. */); + Vtreesit_load_name_override_list = Qnil; + + DEFVAR_LISP ("treesit-extra-load-path", + Vtreesit_extra_load_path, + doc: + /* Additional directories to look for tree-sitter language definitions. +The value should be a list of directories. +When trying to load a tree-sitter language definition, +Emacs first looks in the directories mentioned in this variable, +then in the `tree-sitter' subdirectory of `user-emacs-directory', and +then in the system default locations for dynamic libraries, in that order. */); + Vtreesit_extra_load_path = Qnil; + + defsubr (&Streesit_language_available_p); + defsubr (&Streesit_language_version); + + defsubr (&Streesit_parser_p); + defsubr (&Streesit_node_p); + defsubr (&Streesit_compiled_query_p); + defsubr (&Streesit_query_p); + defsubr (&Streesit_query_language); + + defsubr (&Streesit_node_parser); + + defsubr (&Streesit_parser_create); + defsubr (&Streesit_parser_delete); + defsubr (&Streesit_parser_list); + defsubr (&Streesit_parser_buffer); + defsubr (&Streesit_parser_language); + + defsubr (&Streesit_parser_root_node); + /* defsubr (&Streesit_parse_string); */ + + defsubr (&Streesit_parser_set_included_ranges); + defsubr (&Streesit_parser_included_ranges); + + defsubr (&Streesit_parser_notifiers); + defsubr (&Streesit_parser_add_notifier); + defsubr (&Streesit_parser_remove_notifier); + + defsubr (&Streesit_node_type); + defsubr (&Streesit_node_start); + defsubr (&Streesit_node_end); + defsubr (&Streesit_node_string); + defsubr (&Streesit_node_parent); + defsubr (&Streesit_node_child); + defsubr (&Streesit_node_check); + defsubr (&Streesit_node_field_name_for_child); + defsubr (&Streesit_node_child_count); + defsubr (&Streesit_node_child_by_field_name); + defsubr (&Streesit_node_next_sibling); + defsubr (&Streesit_node_prev_sibling); + defsubr (&Streesit_node_first_child_for_pos); + defsubr (&Streesit_node_descendant_for_range); + defsubr (&Streesit_node_eq); + + defsubr (&Streesit_pattern_expand); + defsubr (&Streesit_query_expand); + defsubr (&Streesit_query_compile); + defsubr (&Streesit_query_capture); + + defsubr (&Streesit_search_subtree); + defsubr (&Streesit_search_forward); + defsubr (&Streesit_induce_sparse_tree); +#endif /* HAVE_TREE_SITTER */ + defsubr (&Streesit_available_p); +} diff --git a/src/treesit.h b/src/treesit.h new file mode 100644 index 00000000000..6f6423ff472 --- /dev/null +++ b/src/treesit.h @@ -0,0 +1,199 @@ +/* Header file for the tree-sitter integration. + +Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#ifndef EMACS_TREESIT_H +#define EMACS_TREESIT_H + +#include <config.h> + +#ifdef HAVE_TREE_SITTER + +#include <tree_sitter/api.h> +#include "lisp.h" + +INLINE_HEADER_BEGIN + +/* A wrapper for a tree-sitter parser, but also contains a parse tree + and other goodies for convenience. */ +struct Lisp_TS_Parser +{ + union vectorlike_header header; + /* A symbol representing the language this parser uses. See the + manual for more explanation. */ + Lisp_Object language_symbol; + /* A list of functions to call after re-parse. Every function is + called with the changed ranges and the parser. The changed + ranges is a list of (BEG . END). */ + Lisp_Object after_change_functions; + /* The buffer associated with this parser. */ + Lisp_Object buffer; + /* The pointer to the tree-sitter parser. Never NULL. */ + TSParser *parser; + /* Pointer to the syntax tree. Initially is NULL, so check for NULL + before use. */ + TSTree *tree; + /* Teaches tree-sitter how to read an Emacs buffer. */ + TSInput input; + /* Re-parsing an unchanged buffer is not free for tree-sitter, so we + only make it re-parse when need_reparse == true. That usually + means some change is made in the buffer. But others could set + this field to true to force tree-sitter to re-parse. */ + bool need_reparse; + /* These two positions record the buffer byte position (1-based) of + the "visible region" that tree-sitter sees. Before re-parse, we + move these positions to match BUF_BEGV_BYTE and BUF_ZV_BYTE. + Note that we don't need to synchronize these positions when + retrieving them in a function that involves a node: if the node + is not outdated, these positions are synchronized. See comment + (ref:visible-beg-null) in treesit.c for more explanation. */ + ptrdiff_t visible_beg; + ptrdiff_t visible_end; + /* This counter is incremented every time a change is made to the + buffer in treesit_record_change. The node retrieved from this parser + inherits this timestamp. This way we can make sure the node is + not outdated when we access its information. */ + ptrdiff_t timestamp; + /* If this field is true, parser functions raises + treesit-parser-deleted signal. */ + bool deleted; + /* If this field is true, the parser has ranges set. See + Ftreesit_parser_included_ranges for why we need this. */ + bool has_range; +}; + +/* A wrapper around a tree-sitter node. */ +struct Lisp_TS_Node +{ + union vectorlike_header header; + /* This prevents gc from collecting the tree before the node is done + with it. TSNode contains a pointer to the tree it belongs to, + and the parser object, when collected by gc, will free that + tree. */ + Lisp_Object parser; + TSNode node; + /* A node inherits its parser's timestamp at creation time. The + parser's timestamp increments as the buffer changes. This way we + can make sure the node is not outdated when we access its + information. */ + ptrdiff_t timestamp; +}; + +/* A compiled tree-sitter query. + + When we create a query object by treesit-compile-query, it is not + immediately compiled, because that would require the language + definition to be loaded. For example, python.el contains + + (defvar xxx (treesit-compile-query ...)) + + and (require 'python.el) requires python's language definition to + be available. In the case of python.el, Emacs requires it when + building, so that breaks the build. */ +struct Lisp_TS_Query +{ + union vectorlike_header header; + /* Language symbol for the query. */ + Lisp_Object language; + /* Source lisp (sexp or string) query. */ + Lisp_Object source; + /* Pointer to the query object. This can be NULL, meaning this + query is not initialized/compiled. We compile the query when + it is used the first time (in treesit-query-capture). */ + TSQuery *query; + /* Pointer to a cursor. If we are storing the query object, we + might as well store a cursor, too. */ + TSQueryCursor *cursor; +}; + +INLINE bool +TS_PARSERP (Lisp_Object x) +{ + return PSEUDOVECTORP (x, PVEC_TS_PARSER); +} + +INLINE struct Lisp_TS_Parser * +XTS_PARSER (Lisp_Object a) +{ + eassert (TS_PARSERP (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_TS_Parser); +} + +INLINE bool +TS_NODEP (Lisp_Object x) +{ + return PSEUDOVECTORP (x, PVEC_TS_NODE); +} + +INLINE struct Lisp_TS_Node * +XTS_NODE (Lisp_Object a) +{ + eassert (TS_NODEP (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_TS_Node); +} + +INLINE bool +TS_COMPILED_QUERY_P (Lisp_Object x) +{ + return PSEUDOVECTORP (x, PVEC_TS_COMPILED_QUERY); +} + +INLINE struct Lisp_TS_Query * +XTS_COMPILED_QUERY (Lisp_Object a) +{ + eassert (TS_COMPILED_QUERY_P (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_TS_Query); +} + +INLINE void +CHECK_TS_PARSER (Lisp_Object parser) +{ + CHECK_TYPE (TS_PARSERP (parser), Qtreesit_parser_p, parser); +} + +INLINE void +CHECK_TS_NODE (Lisp_Object node) +{ + CHECK_TYPE (TS_NODEP (node), Qtreesit_node_p, node); +} + +INLINE void +CHECK_TS_COMPILED_QUERY (Lisp_Object query) +{ + CHECK_TYPE (TS_COMPILED_QUERY_P (query), + Qtreesit_compiled_query_p, query); +} + +INLINE_HEADER_END + +extern void treesit_record_change (ptrdiff_t, ptrdiff_t, ptrdiff_t); +extern Lisp_Object make_treesit_parser (Lisp_Object, TSParser *, TSTree *, + Lisp_Object); +extern Lisp_Object make_treesit_node (Lisp_Object, TSNode); + +extern bool treesit_node_uptodate_p (Lisp_Object); + +extern void treesit_delete_parser (struct Lisp_TS_Parser *); +extern void treesit_delete_query (struct Lisp_TS_Query *); +extern bool treesit_named_node_p (TSNode); + +#endif /* HAVE_TREE_SITTER */ + +extern void syms_of_treesit (void); + +#endif /* EMACS_TREESIT_H */ diff --git a/src/xdisp.c b/src/xdisp.c index b5f013ea6a1..5dcf21dc4ce 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -34576,8 +34576,11 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, } #endif /* HAVE_WINDOW_SYSTEM */ + /* CHARPOS can be beyond the last position of STRING due, e.g., to + min-width 'display' property. Fix that, to let all the calls to + get-text-property below do their thing. */ if (STRINGP (string)) - pos = make_fixnum (charpos); + pos = make_fixnum (min (charpos, SCHARS (string) - 1)); /* Set the help text and mouse pointer. If the mouse is on a part of the mode line without any text (e.g. past the right edge of diff --git a/src/xfns.c b/src/xfns.c index 95092ce05f4..36b51a30112 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -8455,10 +8455,10 @@ compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx, int min_x, min_y, max_x, max_y = -1; /* User-specified position? */ - left = Fcdr (Fassq (Qleft, parms)); - top = Fcdr (Fassq (Qtop, parms)); - right = Fcdr (Fassq (Qright, parms)); - bottom = Fcdr (Fassq (Qbottom, parms)); + left = CDR (Fassq (Qleft, parms)); + top = CDR (Fassq (Qtop, parms)); + right = CDR (Fassq (Qright, parms)); + bottom = CDR (Fassq (Qbottom, parms)); /* Move the tooltip window where the mouse pointer is. Resize and show it. */ @@ -8824,14 +8824,14 @@ Text larger than the specified size is clipped. */) for (tail = parms; CONSP (tail); tail = XCDR (tail)) { elt = XCAR (tail); - parm = Fcar (elt); + parm = CAR (elt); /* The left, top, right and bottom parameters are handled by compute_tip_xy so they can be ignored here. */ if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright) && !EQ (parm, Qbottom)) { last = Fassq (parm, tip_last_parms); - if (NILP (Fequal (Fcdr (elt), Fcdr (last)))) + if (NILP (Fequal (CDR (elt), CDR (last)))) { /* We lost, delete the old tooltip. */ delete = true; @@ -8852,9 +8852,9 @@ Text larger than the specified size is clipped. */) for (tail = tip_last_parms; CONSP (tail); tail = XCDR (tail)) { elt = XCAR (tail); - parm = Fcar (elt); + parm = CAR (elt); if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright) - && !EQ (parm, Qbottom) && !NILP (Fcdr (elt))) + && !EQ (parm, Qbottom) && !NILP (CDR (elt))) { /* We lost, delete the old tooltip. */ delete = true; @@ -8975,8 +8975,8 @@ Text larger than the specified size is clipped. */) make_fixnum (w->pixel_height), Qnil, Qnil); /* Add the frame's internal border to calculated size. */ - width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); - height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + width = XFIXNUM (CAR (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + height = XFIXNUM (CDR (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); /* Calculate position of tooltip frame. */ compute_tip_xy (tip_f, parms, dx, dy, width, height, &root_x, &root_y); @@ -9728,10 +9728,12 @@ selected frame's display. */) (Lisp_Object time_object, Lisp_Object terminal) { struct x_display_info *dpyinfo; - Time time; + uint32_t time; + /* time should be a 32-bit integer, regardless of what the size of + the X type `Time' is on this system. */ dpyinfo = check_x_display_info (terminal); - CONS_TO_INTEGER (time_object, Time, time); + CONS_TO_INTEGER (time_object, uint32_t, time); x_set_last_user_time_from_lisp (dpyinfo, time); return Qnil; diff --git a/src/xselect.c b/src/xselect.c index a381fa23522..844ef7220a9 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -308,7 +308,7 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, /* We know it's not the CAR, so it's easy. */ Lisp_Object rest = dpyinfo->terminal->Vselection_alist; for (; CONSP (rest); rest = XCDR (rest)) - if (EQ (prev_value, Fcar (XCDR (rest)))) + if (EQ (prev_value, CAR (XCDR (rest)))) { XSETCDR (rest, XCDR (XCDR (rest))); break; @@ -369,7 +369,7 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, specbind (Qinhibit_quit, Qt); CHECK_SYMBOL (target_type); - handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist)); + handler_fn = CDR (Fassq (target_type, Vselection_converter_alist)); if (CONSP (handler_fn)) handler_fn = XCDR (handler_fn); @@ -1129,14 +1129,14 @@ x_clear_frame_selections (struct frame *f) while (CONSP (t->Vselection_alist) && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (t->Vselection_alist))))))) { - selection = Fcar (Fcar (t->Vselection_alist)); + selection = CAR (CAR (t->Vselection_alist)); if (!x_should_preserve_selection (selection)) /* Run the `x-lost-selection-functions' abnormal hook. */ CALLN (Frun_hook_with_args, Qx_lost_selection_functions, selection); else - lost = Fcons (Fcar (t->Vselection_alist), lost); + lost = Fcons (CAR (t->Vselection_alist), lost); tset_selection_alist (t, XCDR (t->Vselection_alist)); } diff --git a/src/xterm.c b/src/xterm.c index af652a0d856..ec605f5e914 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -18621,7 +18621,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* Set the provided time as the user time, which is required for SetInputFocus to work correctly after taking the input focus. */ - x_display_set_last_user_time (dpyinfo, event->xclient.data.l[1], + + /* Time can be sign extended if retrieved from a client message. + Make sure it is always 32 bits, or systems with 64-bit longs + will crash after 24 days of X server uptime. (bug#59480) */ + x_display_set_last_user_time (dpyinfo, (event->xclient.data.l[1] + & 0xffffffff), true, true); goto done; } @@ -21425,7 +21430,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (!NILP (tab_bar_arg)) inev.ie.arg = tab_bar_arg; } - if (FRAME_X_EMBEDDED_P (f)) + + if (FRAME_X_EMBEDDED_P (f) + && !FRAME_NO_ACCEPT_FOCUS (f)) xembed_send_message (f, event->xbutton.time, XEMBED_REQUEST_FOCUS, 0, 0, 0); } @@ -23193,7 +23200,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (!NILP (tab_bar_arg)) inev.ie.arg = tab_bar_arg; } - if (FRAME_X_EMBEDDED_P (f)) + + if (FRAME_X_EMBEDDED_P (f) + && !FRAME_NO_ACCEPT_FOCUS (f)) xembed_send_message (f, xev->time, XEMBED_REQUEST_FOCUS, 0, 0, 0); } @@ -25456,6 +25465,17 @@ x_clean_failable_requests (struct x_display_info *dpyinfo) + (last - first)); } +/* Protect a section of X requests: ignore errors generated by X + requests made from now until `x_stop_ignoring_errors'. Each call + must be paired with a call to `x_stop_ignoring_errors', and + recursive calls inside the protected section are not allowed. + + The advantage over x_catch_errors followed by + x_uncatch_errors_after_check is that this function does not sync to + catch errors if requests were made. It should be used instead of + those two functions for catching errors around requests that do not + require a reply. */ + void x_ignore_errors_for_next_request (struct x_display_info *dpyinfo) { @@ -25463,7 +25483,13 @@ x_ignore_errors_for_next_request (struct x_display_info *dpyinfo) unsigned long next_request; #ifdef HAVE_GTK3 GdkDisplay *gdpy; +#endif + /* This code is not reentrant, so be sure nothing calls it + recursively in response to input. */ + block_input (); + +#ifdef HAVE_GTK3 /* GTK 3 tends to override our own error handler inside certain callbacks, which this can be called from. Instead of trying to restore our own, add a trap for the following requests with @@ -25532,6 +25558,8 @@ x_stop_ignoring_errors (struct x_display_info *dpyinfo) if (gdpy) gdk_x11_display_error_trap_pop_ignored (gdpy); #endif + + unblock_input (); } /* Undo the last x_catch_errors call. @@ -27517,9 +27545,14 @@ static void x_raise_frame (struct frame *f) { block_input (); + if (FRAME_VISIBLE_P (f)) - XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f)); - XFlush (FRAME_X_DISPLAY (f)); + { + XRaiseWindow (FRAME_X_DISPLAY (f), + FRAME_OUTER_WINDOW (f)); + XFlush (FRAME_X_DISPLAY (f)); + } + unblock_input (); } @@ -27567,8 +27600,6 @@ x_lower_frame (struct frame *f) XLowerWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f)); - XFlush (FRAME_X_DISPLAY (f)); - #ifdef HAVE_XWIDGETS /* Make sure any X windows owned by xwidget views of the parent still display below the lowered frame. */ @@ -27576,6 +27607,8 @@ x_lower_frame (struct frame *f) if (FRAME_PARENT_FRAME (f)) lower_frame_xwidget_views (FRAME_PARENT_FRAME (f)); #endif + + XFlush (FRAME_X_DISPLAY (f)); } static void @@ -27826,6 +27859,10 @@ x_focus_frame (struct frame *f, bool noactivate) struct x_display_info *dpyinfo; Time time; + /* The code below is not reentrant wrt to dpyinfo->x_focus_frame and + friends being set. */ + block_input (); + dpyinfo = FRAME_DISPLAY_INFO (f); if (FRAME_X_EMBEDDED_P (f)) @@ -27856,7 +27893,7 @@ x_focus_frame (struct frame *f, bool noactivate) the current workspace, and mapping it, etc, before moving input focus to the frame. */ x_ewmh_activate_frame (f); - return; + goto out; } if (NILP (Vx_no_window_manager)) @@ -27890,6 +27927,9 @@ x_focus_frame (struct frame *f, bool noactivate) matter. */ CurrentTime); } + + out: + unblock_input (); } diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el index 1302fbe30ca..0fa3c6facf1 100644 --- a/test/lib-src/emacsclient-tests.el +++ b/test/lib-src/emacsclient-tests.el @@ -19,7 +19,9 @@ ;;; Commentary: -;; +;; Tests for the emacsclient executable. For tests involving the +;; interaction between emacsclient and an Emacs server, see +;; test/lisp/server-tests.el. ;;; Code: diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 6e6671efca5..1107e09b51b 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -697,29 +697,29 @@ machine Libera.Chat password b ;; with slightly more realistic and less legible values. (ert-deftest auth-source-pass-extra-query-keywords--suffixed-user () - (let ((store (sort (copy-sequence '(("x.com:42/bar" (secret . "a")) - ("bar@x.com" (secret . "b")) + (let ((store (sort (copy-sequence '(("x.com:42/b@r" (secret . "a")) + ("b@r@x.com" (secret . "b")) ("x.com" (secret . "?")) - ("bar@y.org" (secret . "c")) + ("b@r@y.org" (secret . "c")) ("fake.com" (secret . "?")) - ("fake.com/bar" (secret . "d")) - ("y.org/bar" (secret . "?")) - ("bar@fake.com" (secret . "e")))) + ("fake.com/b@r" (secret . "d")) + ("y.org/b@r" (secret . "?")) + ("b@r@fake.com" (secret . "e")))) (lambda (&rest _) (zerop (random 2)))))) (auth-source-pass--with-store store (auth-source-pass-enable) (let* ((auth-source-pass-extra-query-keywords t) (results (auth-source-search :host '("x.com" "fake.com" "y.org") - :user "bar" + :user "b@r" :require '(:user) :max 5))) (dolist (result results) (setf (plist-get result :secret) (auth-info-password result))) (should (equal results - '((:host "x.com" :user "bar" :secret "b") - (:host "x.com" :user "bar" :port "42" :secret "a") - (:host "fake.com" :user "bar" :secret "e") - (:host "fake.com" :user "bar" :secret "d") - (:host "y.org" :user "bar" :secret "c")))))))) + '((:host "x.com" :user "b@r" :secret "b") + (:host "x.com" :user "b@r" :port "42" :secret "a") + (:host "fake.com" :user "b@r" :secret "e") + (:host "fake.com" :user "b@r" :secret "d") + (:host "y.org" :user "b@r" :secret "c")))))))) ;; This is a more distilled version of `suffixed-user', above. It ;; better illustrates that search order takes precedence over "/user" diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 2e9353a09b8..fa55eea95e2 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -61,6 +61,15 @@ (ert-resource-file filename)) (buffer-string)))) +(defun icalendar-tests--get-error-string-for-export (diary-string) + "Call icalendar-export for DIARY-STRING and return resulting error-string." + (let ((file (make-temp-file "export.ics"))) + (with-temp-buffer + (insert diary-string) + (icalendar-export-region (point-min) (point-max) file)) + (with-current-buffer (get-buffer "*icalendar-errors*") + (buffer-string)))) + ;; ====================================================================== ;; Tests of functions ;; ====================================================================== @@ -982,6 +991,40 @@ END:VALARM '(2 ((email ("att.one@email.com" "att.two@email.com")) (audio) (display))))) ;; ====================================================================== +;; #bug56241 +;; ====================================================================== +(defun icalendar-tests--diary-float (&rest args) + (apply #'diary-float args)) + +(ert-deftest icalendar-export-bug-56241-dotted-pair () + "See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=56241#5" + (let ((icalendar-export-sexp-enumeration-days 366)) + (mapc (lambda (diary-string) + (should (string= "" (icalendar-tests--get-error-string-for-export + diary-string)))) + '("%%(diary-float 7 0 1) First Sunday in July 1" + "%%(icalendar-tests--diary-float 7 0 1) First Sunday in July 2")))) + + +;; (ert-deftest icalendar-export-bug-56241-sexp-does-not-match () +;; "Reported in #bug56241 -- needs to be fixed!" +;; (let ((icalendar-export-sexp-enumeration-days 0)) +;; (mapc (lambda (diary-string) +;; (should (string= "" (icalendar-tests--get-error-string-for-export +;; diary-string)))) +;; '("%%(diary-float 7 0 1) First Sunday in July 1" +;; "%%(icalendar-tests--diary-float 7 0 1) First Sunday in July 2")))) + +(ert-deftest icalendar-export-bug-56241-nested-sexps () + "Reported in #bug56241 -- needs to be fixed!" + (let ((icalendar-export-sexp-enumeration-days 366)) + (mapc (lambda (diary-string) + (should (string= "" (icalendar-tests--get-error-string-for-export + diary-string)))) + '("%%(= (calendar-day-of-week date) 0) Sunday 1" + "%%(= 0 (calendar-day-of-week date)) Sunday 2")))) + +;; ====================================================================== ;; Import tests ;; ====================================================================== @@ -1439,12 +1482,15 @@ DTEND;VALUE=DATE:19570922 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=09;BYMONTHDAY=21 SUMMARY:ff birthday (%d years old)") - - (icalendar-tests--test-export - nil - nil - "%%(diary-offset '(diary-float t 3 4) 1) asdf" - nil) + ;; FIXME: this testcase verifies that icalendar-export fails to + ;; export the nested sexp. After repairing bug56241 icalendar-export + ;; works correctly for this sexp but now the testcase fails. + ;; Therefore this testcase is disabled for the time being. + ;; (icalendar-tests--test-export + ;; nil + ;; nil + ;; "%%(diary-offset '(diary-float t 3 4) 1) asdf" + ;; nil) ;; FIXME! diff --git a/test/lisp/erc/erc-sasl-tests.el b/test/lisp/erc/erc-sasl-tests.el new file mode 100644 index 00000000000..64593ca270c --- /dev/null +++ b/test/lisp/erc/erc-sasl-tests.el @@ -0,0 +1,344 @@ +;;; erc-sasl-tests.el --- Tests for erc-sasl. -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert-x) +(require 'erc-sasl) + +(ert-deftest erc-sasl--mechanism-offered-p () + (let ((erc-sasl--options '((mechanism . external)))) + (should (erc-sasl--mechanism-offered-p "foo,external")) + (should (erc-sasl--mechanism-offered-p "external,bar")) + (should (erc-sasl--mechanism-offered-p "foo,external,bar")) + (should-not (erc-sasl--mechanism-offered-p "fooexternal")) + (should-not (erc-sasl--mechanism-offered-p "externalbar")))) + +(ert-deftest erc-sasl--read-password--basic () + (ert-info ("Explicit erc-sasl-password") + (let ((erc-sasl--options '((password . "foo")))) + (should (string= (erc-sasl--read-password nil) "foo")))) + + (ert-info ("Explicit session password") + (let ((erc-session-password "foo") + (erc-sasl--options '((password . :password)))) + (should (string= (erc-sasl--read-password nil) "foo")))) + + (ert-info ("Fallback to prompt skip auth-source") + (should-not erc-sasl-auth-source-function) + (let ((erc-session-password "bar") + (erc-networks--id (erc-networks--id-create nil))) + (should (string= (ert-simulate-keys "bar\r" + (erc-sasl--read-password "?")) + "bar")))) + + (ert-info ("Prompt when auth-source fails and `erc-sasl-password' null") + (let ((erc-sasl--options '((password))) + (erc-sasl-auth-source-function #'ignore)) + (should (string= (ert-simulate-keys "baz\r" + (erc-sasl--read-password "pwd:")) + "baz"))))) + +(ert-deftest erc-sasl--read-password--auth-source () + (ert-with-temp-file netrc-file + :text (string-join + (list + ;; If you swap these first 2 lines, *1 below fails + "machine FSF.chat port 6697 user bob password sesame" + "machine GNU/chat port 6697 user bob password spam" + "machine MyHost port irc password 123") + "\n") + (let* ((auth-sources (list netrc-file)) + (erc-session-server "irc.gnu.org") + (erc-session-port 6697) + (erc-networks--id (erc-networks--id-create nil)) + calls + (erc-sasl-auth-source-function + (lambda (&rest r) + (push r calls) + (apply #'erc--auth-source-search r))) + erc-server-announced-name ; too early + auth-source-do-cache) + + (ert-info ("Symbol as password specifies machine") + (let ((erc-sasl--options '((user . "bob") (password . FSF.chat))) + (erc-networks--id (make-erc-networks--id))) + (should (string= (erc-sasl--read-password nil) "sesame")) + (should (equal (pop calls) '(:user "bob" :host "FSF.chat"))))) + + (ert-info ("ID for :host and `erc-session-username' for :user") ; *1 + (let ((erc-session-username "bob") + (erc-sasl--options '((user . :user) (password))) + (erc-networks--id (erc-networks--id-create 'GNU/chat))) + (should (string= (erc-sasl--read-password nil) "spam")) + (should (equal (pop calls) '(:user "bob" :host "GNU/chat"))))) + + (ert-info ("ID for :host and current nick for :user") ; *1 + (let ((erc-server-current-nick "bob") + (erc-sasl--options '((user . :nick) (password))) + (erc-networks--id (erc-networks--id-create 'GNU/chat))) + (should (string= (erc-sasl--read-password nil) "spam")) + (should (equal (pop calls) '(:user "bob" :host "GNU/chat"))))) + + (ert-info ("Symbol as password, entry lacks user field") + (let ((erc-server-current-nick "fake") + (erc-sasl--options '((user . :nick) (password . MyHost))) + (erc-networks--id (erc-networks--id-create 'GNU/chat))) + (should (string= (erc-sasl--read-password nil) "123")) + (should (equal (pop calls) '(:user "fake" :host "MyHost")))))))) + +(ert-deftest erc-sasl-create-client--plain () + (let* ((erc-session-password "password123") + (erc-session-username "tester") + (erc-sasl--options '((user . :user) (password . :password))) + (erc-session-port 1667) + (erc-session-server "localhost") + (client (erc-sasl--create-client 'plain)) + (result (sasl-next-step client nil))) + (should (equal (format "%S" [erc-sasl--plain-response + "\0tester\0password123"]) + (format "%S" result))) + (should (string= (sasl-step-data result) "\0tester\0password123")) + (should-not (sasl-next-step client result))) + (should (equal (assoc-default "PLAIN" sasl-mechanism-alist) '(sasl-plain)))) + +(ert-deftest erc-sasl-create-client--external () + (let* ((erc-server-current-nick "tester") + (erc-sasl--options '((user . :nick) (password . :password))) + (client (erc-sasl--create-client 'external)) ; unused ^ + (result (sasl-next-step client nil))) + (should (equal (format "%S" [ignore nil]) (format "%S" result))) + (should-not (sasl-step-data result)) + (should-not (sasl-next-step client result))) + (should-not (member "EXTERNAL" sasl-mechanisms)) + (should-not (assoc-default "EXTERNAL" sasl-mechanism-alist))) + +(ert-deftest erc-sasl-create-client--scram-sha-1 () + (let* ((erc-sasl--options '((user . "jilles") (password . "sesame") + (authzid . "jilles"))) + (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" "")) + (sasl-unique-id-function (lambda () (pop mock-rvs))) + (client (erc-sasl--create-client 'scram-sha-1)) + (step (sasl-next-step client nil))) + (ert-info ("Client's initial request") + (let ((req "n,a=jilles,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs")) + (should (equal (format "%S" + `[erc-compat--29-sasl-scram-client-first-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's initial response") + (let ((resp (concat "r=c5RqLCZy0L4fGkKAZ0hujFBsXQoKcivqCw9iDZPSpb," + "s=5mJO6d4rjCnsBU1X," + "i=4096")) + (req (concat "c=bixhPWppbGxlcyw=," + "r=c5RqLCZy0L4fGkKAZ0hujFBsXQoKcivqCw9iDZPSpb," + "p=OVUhgPu8wEm2cDoVLfaHzVUYPWU="))) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should (equal (format "%S" + `[erc-sasl--scram-sha-1-client-final-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's final message") + (let ((resp "v=ZWR23c9MJir0ZgfGf5jEtLOn6Ng=")) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should-not (sasl-step-data step))))) + (should (eq sasl-unique-id-function #'sasl-unique-id-function))) + +(ert-deftest erc-sasl-create-client--scram-sha-256 () + (unless (featurep 'sasl-scram-sha256) + (ert-skip "Emacs lacks sasl-scram-sha256")) + (let* ((erc-server-current-nick "jilles") + (erc-session-password "sesame") + (erc-sasl--options '((user . :nick) (password . :password) + (authzid . "jilles"))) + (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" "")) + (sasl-unique-id-function (lambda () (pop mock-rvs))) + (client (erc-sasl--create-client 'scram-sha-256)) + (step (sasl-next-step client nil))) + (ert-info ("Client's initial request") + (let ((req "n,a=jilles,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs")) + (should (equal (format "%S" + `[erc-compat--29-sasl-scram-client-first-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's initial response") + (let ((resp (concat + "r=c5RqLCZy0L4fGkKAZ0hujFBse697140729d8445fb95ec94ceacb14b3," + "s=MTk2M2VkMzM5ZmU0NDRiYmI0MzIyOGVhN2YwNzYwNmI=," + "i=4096")) + (req (concat + "c=bixhPWppbGxlcyw=," + "r=c5RqLCZy0L4fGkKAZ0hujFBse697140729d8445fb95ec94ceacb14b3," + "p=1vDesVBzJmv0lX0Ae1kHFtdVHkC6j4gISKVqaR45HFg="))) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should (equal (format "%S" + `[erc-sasl--scram-sha-256-client-final-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's final message") + (let ((resp "v=gUePTYSZN9xgcE06KSyKO9fUmSwH26qifoapXyEs75s=")) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should-not (sasl-step-data step))))) + (should (eq sasl-unique-id-function #'sasl-unique-id-function))) + +(ert-deftest erc-sasl-create-client--scram-sha-256--no-authzid () + (unless (featurep 'sasl-scram-sha256) + (ert-skip "Emacs lacks sasl-scram-sha256")) + (let* ((erc-server-current-nick "jilles") + (erc-session-password "sesame") + (erc-sasl--options '((user . :nick) (password . :password) (authzid))) + (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" "")) + (sasl-unique-id-function (lambda () (pop mock-rvs))) + (client (erc-sasl--create-client 'scram-sha-256)) + (step (sasl-next-step client nil))) + (ert-info ("Client's initial request") + (let ((req "n,,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs")) + (should (equal (format "%S" + `[erc-compat--29-sasl-scram-client-first-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's initial response") + (let ((resp (concat + "r=c5RqLCZy0L4fGkKAZ0hujFBsd4067f0afdb54c3dbd4fe645b84cae37," + "s=ZTg1MmE1YmFhZGI1NDcyMjk3NzYwZmRjZDM3Y2I1OTM=," + "i=4096")) + (req (concat + "c=biws," + "r=c5RqLCZy0L4fGkKAZ0hujFBsd4067f0afdb54c3dbd4fe645b84cae37," + "p=LP4sjJrjJKp5qTsARyZCppXpKLu4FMM284hNESPvGhI="))) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should (equal (format "%S" + `[erc-sasl--scram-sha-256-client-final-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's final message") + (let ((resp "v=847WXfnmReGyE1qlq1And6R4bPBNROTZ7EMS/QrJtUM=")) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should-not (sasl-step-data step))))) + (should (eq sasl-unique-id-function #'sasl-unique-id-function))) + +(ert-deftest erc-sasl-create-client--scram-sha-512--no-authzid () + (unless (featurep 'sasl-scram-sha256) + (ert-skip "Emacs lacks sasl-scram-sha512")) + (let* ((erc-server-current-nick "jilles") + (erc-session-password "sesame") + (erc-sasl--options '((user . :nick) (password . :password) (authzid))) + (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" "")) + (sasl-unique-id-function (lambda () (pop mock-rvs))) + (client (erc-sasl--create-client 'scram-sha-512)) + (step (sasl-next-step client nil))) + (ert-info ("Client's initial request") + (let ((req "n,,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs")) + (should (equal (format "%S" + `[erc-compat--29-sasl-scram-client-first-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's initial response") + (let ((resp (concat + "r=c5RqLCZy0L4fGkKAZ0hujFBs54c592745ce14e559fcc3f27b15464f6," + "s=YzMzOWZiY2U0YzcwNDA0M2I4ZGE2M2ZjOTBjODExZTM=," + "i=4096")) + (req (concat + "c=biws," + "r=c5RqLCZy0L4fGkKAZ0hujFBs54c592745ce14e559fcc3f27b15464f6," + "p=vMBb9tKxFAfBtel087/GLbo4objAIYr1wM+mFv/jYLKXE" + "NUF0vynm81qQbywQE5ScqFFdAfwYMZq/lj4s0V1OA=="))) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should (equal (format + "%S" `[erc-sasl--scram-sha-512-client-final-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's final message") + (let ((resp (concat "v=Va7NIvt8wCdhvxnv+bZriSxGoto6On5EVnRHO/ece8zs0" + "qpQassdqir1Zlwh3e3EmBq+kcSy+ClNCsbzBpXe/w=="))) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should-not (sasl-step-data step))))) + (should (eq sasl-unique-id-function #'sasl-unique-id-function))) + +(defconst erc-sasl-tests-ecdsa-key-file " +-----BEGIN EC PARAMETERS----- +BggqhkjOPQMBBw== +-----END EC PARAMETERS----- +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIIJueQ3W2IrGbe9wKdOI75yGS7PYZSj6W4tg854hlsvmoAoGCCqGSM49 +AwEHoUQDQgAEAZmaVhNSMmV5r8FXPvKuMnqDKyIA9pDHN5TNMfiF3mMeikGgK10W +IRX9cyi2wdYg9mUUYyh9GKdBCYHGUJAiCA== +-----END EC PRIVATE KEY----- +") + +(ert-deftest erc-sasl-create-client-ecdsa () + :tags '(:unstable) + ;; This is currently useless because it just roundtrips shelling out + ;; to pkeyutl. + (ert-skip "Placeholder") + (unless (executable-find "openssl") + (ert-skip "System lacks openssl")) + (ert-with-temp-file keyfile + :prefix "ecdsa_key" + :suffix ".pem" + :text erc-sasl-tests-ecdsa-key-file + (let* ((erc-server-current-nick "jilles") + (erc-sasl--options `((password . ,keyfile))) + (client (erc-sasl--create-client 'ecdsa-nist256p-challenge)) + (step (sasl-next-step client nil))) + (ert-info ("Client's initial request") + (should (equal (format "%S" [erc-sasl--ecdsa-first "jilles"]) + (format "%S" step))) + (should (string= (sasl-step-data step) "jilles"))) + (ert-info ("Server's initial response") + (let ((resp (concat "\0\1\2\3\4\5\6\7\10\11\12\13\14\15\16\17\20" + "\21\22\23\24\25\26\27\30\31\32\33\34\35\36\37"))) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (ert-with-temp-file sigfile + :prefix "ecdsa_sig" + :suffix ".sig" + :text (sasl-step-data step) + (with-temp-buffer + (set-buffer-multibyte nil) + (insert resp) + (let ((ec (call-process-region + (point-min) (point-max) + "openssl" 'delete t nil "pkeyutl" + "-inkey" keyfile "-sigfile" sigfile + "-verify"))) + (unless (zerop ec) + (message "%s" (buffer-string))) + (should (zerop ec))))))) + (should-not (sasl-next-step client step))))) + +;;; erc-sasl-tests.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-association-nick.el b/test/lisp/erc/erc-scenarios-base-association-nick.el index 3e848be4df2..b46c996bc0a 100644 --- a/test/lisp/erc/erc-scenarios-base-association-nick.el +++ b/test/lisp/erc/erc-scenarios-base-association-nick.el @@ -25,13 +25,24 @@ (eval-when-compile (require 'erc-join)) -;; You register a new nick, disconnect, and log back in, but your nick -;; is not granted, so ERC obtains a backtick'd version. You open a -;; query buffer for NickServ, and ERC names it using the net-ID (which -;; includes the backtick'd nick) as a suffix. The original -;; (disconnected) NickServ buffer gets renamed with *its* net-ID as -;; well. You then identify to NickServ, and the dead session is no -;; longer considered distinct. +;; You register a new nick in a dedicated query buffer, disconnect, +;; and log back in, but your nick is not granted (maybe you just +;; turned off SASL). In any case, ERC obtains a backtick'd version. +;; You open a query buffer for NickServ, and ERC gives you the +;; existing one. And after you identify, all buffers retain their +;; names, although your net ID has changed internally. +;; +;; If ERC would've instead failed (or intentionally refused) to make +;; the association, you would've ended up with a new NickServ buffer +;; named after the new net ID as a suffix (based on the backtick'd +;; nick), for example, NickServ@foonet/tester`. And the original +;; (disconnected) NickServ buffer would've gotten suffixed with *its* +;; net-ID as well, e.g., NickServ@foonet/tester. And after +;; identifying, you would've seen ERC merge the two as well as their +;; server buffers. While this alternate behavior may arguably be a +;; more honest reflection of reality, it's also quite inconvenient. +;; For a clearer example, see the original version of this file +;; introduced by "Add user-oriented test scenarios for ERC". (ert-deftest erc-scenarios-base-association-nick-bumped () :tags '(:expensive-test) @@ -67,30 +78,29 @@ (funcall expect 5 "ERC finished")))) (with-current-buffer "foonet" - (erc-cmd-RECONNECT)) + (erc-cmd-RECONNECT) + (funcall expect 10 "User modes for tester`")) - (erc-d-t-wait-for 10 "Nick request rejection prevents reassociation (good)" - (get-buffer "foonet/tester`")) + (ert-info ("Server buffer reassociated with new nick") + (should-not (get-buffer "foonet/tester`"))) (ert-info ("Ask NickServ to change nick") - (with-current-buffer "foonet/tester`" - (funcall expect 3 "already in use") + (with-current-buffer "foonet" (funcall expect 3 "debug mode") (erc-cmd-QUERY "NickServ")) - (erc-d-t-wait-for 1 "Dead NickServ query buffer renamed, now qualified" - (get-buffer "NickServ@foonet/tester")) + (ert-info ( "NickServ buffer reassociated") + (should-not (get-buffer "NickServ@foonet/tester`")) + (should-not (get-buffer "NickServ@foonet/tester"))) - (with-current-buffer "NickServ@foonet/tester`" ; new one + (with-current-buffer "NickServ" ; new one (erc-scenarios-common-say "IDENTIFY tester changeme") - (funcall expect 5 "You're now logged in as tester") - (ert-info ("Original buffer found, reused") - (erc-d-t-wait-for 2 (equal (buffer-name) "NickServ"))))) + (funcall expect 5 "You're now logged in as tester"))) - (ert-info ("Ours is the only NickServ buffer that remains") + (ert-info ("Still just one NickServ buffer") (should-not (cdr (erc-scenarios-common-buflist "NickServ")))) - (ert-info ("Visible network ID truncated to one component") + (ert-info ("As well as one server buffer") (should (not (get-buffer "foonet/tester`"))) (should (not (get-buffer "foonet/tester"))) (should (get-buffer "foonet"))))) @@ -135,29 +145,29 @@ ;; Since we use reconnect, a new buffer won't be created ;; TODO add variant with clean `erc' invocation (with-current-buffer "foonet" - (erc-cmd-RECONNECT)) + (erc-cmd-RECONNECT) + (funcall expect 10 "User modes for dummy")) - (ert-info ("Server-initiated renick") - (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet/dummy")) - (should-not (get-buffer "foonet/tester")) - (funcall expect 15 "debug mode")) + (ert-info ("Server-initiated renick associated correctly") + (with-current-buffer "foonet" + (funcall expect 15 "debug mode") + (should-not (get-buffer "foonet/dummy")) + (should-not (get-buffer "foonet/tester"))) - (erc-d-t-wait-for 1 "Old query renamed, now qualified" - (get-buffer "bob@foonet/tester")) + (ert-info ("Old query reassociated") + (should (get-buffer "bob")) + (should-not (get-buffer "bob@foonet/tester")) + (should-not (get-buffer "bob@foonet/dummy"))) - (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "bob@foonet/dummy")) + (with-current-buffer "foonet" (erc-cmd-NICK "tester") - (ert-info ("Buffers combined") - (erc-d-t-wait-for 2 (equal (buffer-name) "bob"))))) + (funcall expect 5 "You're now logged in as tester"))) - (with-current-buffer "foonet" - (funcall expect 5 "You're now logged in as tester")) - - (ert-info ("Ours is the only bob buffer that remains") + (ert-info ("Ours is still the only bob buffer that remains") (should-not (cdr (erc-scenarios-common-buflist "bob")))) - (ert-info ("Visible network ID truncated to one component") - (should (not (get-buffer "foonet/dummy"))) - (should (get-buffer "foonet"))))) + (ert-info ("Visible network ID still truncated to one component") + (should (not (get-buffer "foonet/tester"))) + (should (not (get-buffer "foonet/dummy")))))) ;;; erc-scenarios-base-association-nick.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el b/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el index 474739d01be..2ffa86aff64 100644 --- a/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el +++ b/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el @@ -106,7 +106,7 @@ (erc-d-t-search-for 1 "<joe>") (erc-d-t-absent-for 0.1 "<bob>") (should (eq erc-server-process erc-server-process-bar)) - (erc-d-t-search-for 10 "keeps you from dishonour") + (erc-d-t-search-for 10 "joe: It is a rupture") (erc-d-t-wait-for 5 (not (erc-server-process-alive))))) (when more (funcall more)))) diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el new file mode 100644 index 00000000000..417705de09c --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-local-modules.el @@ -0,0 +1,243 @@ +;;; erc-scenarios-local-modules.el --- Local modules tests for ERC -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. +;; +;; This file is part of GNU Emacs. +;; +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Code: + +;;; Commentary: + +;; These tests all use `sasl' because, as of ERC 5.5, it's the one +;; and only local module. + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-sasl) + +;; This asserts that a local module's options and its inclusion in +;; (and absence from) `erc-update-modules' can be let-bound. + +(ert-deftest erc-scenarios-base-local-modules--reconnect-let () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "sasl") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'plain 'plain)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect with options let-bound") + (with-current-buffer + ;; This won't work unless the library is already loaded + (let ((erc-modules (cons 'sasl erc-modules)) + (erc-sasl-mechanism 'plain) + (erc-sasl-password "password123")) + (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester")) + (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "ExampleOrg")) + + (ert-info ("First connection succeeds") + (funcall expect 10 "This server is in debug mode") + (erc-cmd-QUIT "") + (funcall expect 10 "finished")) + + (should-not (memq 'sasl erc-modules)) + (erc-d-t-wait-for 10 (not (erc-server-process-alive))) + (erc-cmd-RECONNECT) + + (ert-info ("Second connection succeeds") + (funcall expect 10 "This server is in debug mode") + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))))) + +;; After quitting a session for which `sasl' is enabled, you +;; disconnect and toggle `erc-sasl-mode' off. You then reconnect +;; using an alternate nickname. You again disconnect and reconnect, +;; this time immediately, and the mode stays disabled. Finally, you +;; once again disconnect, toggle the mode back on, and reconnect. You +;; are authenticated successfully, just like in the initial session. +;; +;; This is meant to show that a user's local mode settings persist +;; between sessions. It also happens to show (in round four, below) +;; that a server renicking a user on 001 after a 903 is handled just +;; like a user-initiated renick, although this is not the main thrust. + +(ert-deftest erc-scenarios-base-local-modules--mode-persistence () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/local-modules") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (expect (erc-d-t-make-expecter)) + (server-buffer-name (format "127.0.0.1:%d" port))) + + (ert-info ("Round one, initial authentication succeeds as expected") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :password "changeme" + :full-name "tester") + (should (string= (buffer-name) server-buffer-name)) + (funcall expect 10 "You are now logged in as tester")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) + (funcall expect 10 "This server is in debug mode") + (erc-cmd-JOIN "#chan") + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 20 "She is Lavinia, therefore must")) + + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + + (ert-info ("Round two, nick rejected, alternate granted") + (with-current-buffer "foonet" + + (ert-info ("Toggle mode off, reconnect") + (erc-sasl-mode -1) + (erc-cmd-RECONNECT)) + + (funcall expect 10 "User modes for tester`") + (should-not (cdr (erc-scenarios-common-buflist "foonet"))) + (should (equal (buffer-name) "foonet")) + (should-not (cdr (erc-scenarios-common-buflist "#chan"))) + + (with-current-buffer "#chan" + (funcall expect 10 "Some enigma, some riddle")) + + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + + (ert-info ("Round three, send alternate nick initially") + (with-current-buffer "foonet" + + (ert-info ("Keep mode off, reconnect") + (should-not erc-sasl-mode) + (should (local-variable-p 'erc-sasl-mode)) + (erc-cmd-RECONNECT)) + + (funcall expect 10 "User modes for tester`") + (should-not (cdr (erc-scenarios-common-buflist "foonet"))) + (should (equal (buffer-name) "foonet")) + (should-not (cdr (erc-scenarios-common-buflist "#chan"))) + + (with-current-buffer "#chan" + (funcall expect 10 "Let our reciprocal vows be remembered.")) + + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + + (ert-info ("Round four, authenticated successfully again") + (with-current-buffer "foonet" + + (ert-info ("Toggle mode on, reconnect") + (should-not erc-sasl-mode) + (should (local-variable-p 'erc-sasl-mode)) + (erc-sasl-mode +1) + (erc-cmd-RECONNECT)) + + (funcall expect 10 "User modes for tester") + (should-not (cdr (erc-scenarios-common-buflist "foonet"))) + (should (equal (buffer-name) "foonet")) + (should-not (cdr (erc-scenarios-common-buflist "#chan"))) + + (with-current-buffer "#chan" + (funcall expect 10 "Well met; good morrow, Titus and Hortensius.")) + + (erc-cmd-QUIT ""))))) + +;; For local modules, the twin toggle commands `erc-FOO-enable' and +;; `erc-FOO-disable' affect all buffers of a connection, whereas +;; `erc-FOO-mode' continues to operate only on the current buffer. + +(ert-deftest erc-scenarios-base-local-modules--toggle-helpers () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/local-modules") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'first 'second 'fourth)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (expect (erc-d-t-make-expecter)) + (server-buffer-name (format "127.0.0.1:%d" port))) + + (ert-info ("Initial authentication succeeds as expected") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :password "changeme" + :full-name "tester") + (should (string= (buffer-name) server-buffer-name)) + (funcall expect 10 "You are now logged in as tester")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) + (funcall expect 10 "This server is in debug mode") + (erc-cmd-JOIN "#chan") + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 20 "She is Lavinia, therefore must")) + + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + + (ert-info ("Disabling works from a target buffer.") + (with-current-buffer "#chan" + (should erc-sasl-mode) + (call-interactively #'erc-sasl-disable) + (should-not erc-sasl-mode) + (should (local-variable-p 'erc-sasl-mode)) + (should-not (buffer-local-value 'erc-sasl-mode (get-buffer "foonet"))) + (erc-cmd-RECONNECT) + (with-current-buffer "#chan" + (funcall expect 10 "Some enigma, some riddle") + (should-not erc-sasl-mode) ; regression + (should (local-variable-p 'erc-sasl-mode)))) + + (with-current-buffer "foonet" + (should (local-variable-p 'erc-sasl-mode)) + (funcall expect 10 "User modes for tester`") + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + + (ert-info ("Enabling works from a target buffer") + (with-current-buffer "#chan" + (call-interactively #'erc-sasl-enable) + (should (local-variable-p 'erc-sasl-mode)) + (should erc-sasl-mode) + (erc-cmd-RECONNECT) + (funcall expect 10 "Well met; good morrow, Titus and Hortensius.") + (erc-cmd-QUIT "")) + + (with-current-buffer "foonet" + (should (local-variable-p 'erc-sasl-mode)) + (should erc-sasl-mode) + (funcall expect 10 "User modes for tester"))))) + +;;; erc-scenarios-local-modules.el ends here diff --git a/test/lisp/erc/erc-scenarios-sasl.el b/test/lisp/erc/erc-scenarios-sasl.el new file mode 100644 index 00000000000..6c5e78d0c8d --- /dev/null +++ b/test/lisp/erc/erc-scenarios-sasl.el @@ -0,0 +1,144 @@ +;;; erc-scenarios-sasl.el --- SASL tests for ERC -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. +;; +;; This file is part of GNU Emacs. +;; +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-sasl) + +(ert-deftest erc-scenarios-sasl--plain () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "sasl") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'plain)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (erc-sasl-password "password123") + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) + + (ert-info ("Notices received") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "ExampleOrg")) + (funcall expect 10 "This server is in debug mode") + ;; Regression "\0\0\0\0 ..." caused by (fillarray passphrase 0) + (should (string= erc-sasl-password "password123")))))) + +(ert-deftest erc-scenarios-sasl--external () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "sasl") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'external)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (erc-sasl-mechanism 'external) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) + + (ert-info ("Notices received") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "ExampleOrg")) + (funcall expect 10 "Authentication successful") + (funcall expect 10 "This server is in debug mode"))))) + +(ert-deftest erc-scenarios-sasl--plain-fail () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "sasl") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'plain-failed)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (erc-sasl-password "wrong") + (erc-sasl-mechanism 'plain) + (expect (erc-d-t-make-expecter)) + (buf nil)) + + (ert-info ("Connect") + (setq buf (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester")) + (let ((err (should-error + (with-current-buffer buf + (funcall expect 20 "Connection failed!"))))) + (should (string-search "please review" (cadr err))) + (with-current-buffer buf + (funcall expect 10 "Opening connection") + (funcall expect 20 "SASL authentication failed") + (should-not (erc-server-process-alive))))))) + +(defun erc-scenarios--common--sasl (mech) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "sasl") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t mech)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (erc-sasl-user :nick) + (erc-sasl-mechanism mech) + (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" "")) + (sasl-unique-id-function (lambda () (pop mock-rvs))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "jilles" + :password "sesame" + :full-name "jilles") + (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) + + (ert-info ("Notices received") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "jaguar")) + (funcall expect 10 "Found your hostname") + (funcall expect 20 "marked as being away"))))) + +(ert-deftest erc-scenarios-sasl--scram-sha-1 () + :tags '(:expensive-test) + (let ((erc-sasl-authzid "jilles")) + (erc-scenarios--common--sasl 'scram-sha-1))) + +(ert-deftest erc-scenarios-sasl--scram-sha-256 () + :tags '(:expensive-test) + (unless (featurep 'sasl-scram-sha256) + (ert-skip "Emacs lacks sasl-scram-sha256")) + (erc-scenarios--common--sasl 'scram-sha-256)) + +;;; erc-scenarios-sasl.el ends here diff --git a/test/lisp/erc/erc-services-tests.el b/test/lisp/erc/erc-services-tests.el index 7ff2e36e77c..2547c5e01a8 100644 --- a/test/lisp/erc/erc-services-tests.el +++ b/test/lisp/erc/erc-services-tests.el @@ -62,9 +62,13 @@ :x ("x") :require (:secret)))))) +(defun erc-services-tests--wrap-search (s) + (lambda (&rest r) (erc--unfun (apply s r)))) + ;; Some of the following may be related to bug#23438. (defun erc-services-tests--auth-source-standard (search) + (setq search (erc-services-tests--wrap-search search)) (ert-info ("Session wins") (let ((erc-session-server "irc.gnu.org") @@ -93,6 +97,7 @@ (should (string= (funcall search :user "#chan") "baz"))))) (defun erc-services-tests--auth-source-announced (search) + (setq search (erc-services-tests--wrap-search search)) (let* ((erc--isupport-params (make-hash-table)) (erc-server-parameters '(("CHANTYPES" . "&#"))) (erc--target (erc--target-from-string "&chan"))) @@ -124,6 +129,7 @@ (should (string= (funcall search :user "#chan") "foo"))))))) (defun erc-services-tests--auth-source-overrides (search) + (setq search (erc-services-tests--wrap-search search)) (let* ((erc-session-server "irc.gnu.org") (erc-server-announced-name "my.gnu.org") (erc-network 'GNU.chat) @@ -537,18 +543,20 @@ (erc-network 'FSF.chat) (erc-server-current-nick "tester") (erc-networks--id (erc-networks--id-create nil)) - (erc-session-port 6697)) + (erc-session-port 6697) + (search (erc-services-tests--wrap-search + #'erc-nickserv-get-password))) (ert-info ("Lookup custom option") - (should (string= (erc-nickserv-get-password "alice") "foo"))) + (should (string= (funcall search "alice") "foo"))) (ert-info ("Auth source") (ert-info ("Network") - (should (string= (erc-nickserv-get-password "bob") "sesame"))) + (should (string= (funcall search "bob") "sesame"))) (ert-info ("Network ID") (let ((erc-networks--id (erc-networks--id-create 'GNU/chat))) - (should (string= (erc-nickserv-get-password "bob") "spam"))))) + (should (string= (funcall search "bob") "spam"))))) (ert-info ("Read input") (should (string= diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index ff5d8026973..4d0d69cd7b6 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -530,6 +530,28 @@ (when noninteractive (kill-buffer "*#fake*"))) +(ert-deftest erc--debug-irc-protocol-mask-secrets () + (should-not erc-debug-irc-protocol) + (should erc--debug-irc-protocol-mask-secrets) + (with-temp-buffer + (setq erc-server-process (start-process "fake" (current-buffer) "true") + erc-server-current-nick "tester" + erc-session-server "myproxy.localhost" + erc-session-port 6667) + (let ((inhibit-message noninteractive)) + (erc-toggle-debug-irc-protocol) + (erc-log-irc-protocol + (concat "PASS :" (erc--unfun (lambda () "changeme")) "\r\n") + 'outgoing) + (set-process-query-on-exit-flag erc-server-process nil)) + (with-current-buffer "*erc-protocol*" + (goto-char (point-min)) + (search-forward "\r\n\r\n") + (search-forward "myproxy.localhost:6667 >> PASS :????????" (pos-eol))) + (when noninteractive + (kill-buffer "*erc-protocol*") + (should-not erc-debug-irc-protocol)))) + (ert-deftest erc-log-irc-protocol () (should-not erc-debug-irc-protocol) (with-temp-buffer @@ -1178,4 +1200,160 @@ (kill-buffer "baznet") (kill-buffer "#chan"))) +(ert-deftest erc-migrate-modules () + (should (equal (erc-migrate-modules '(autojoin timestamp button)) + '(autojoin stamp button))) + ;; Default unchanged + (should (equal (erc-migrate-modules erc-modules) erc-modules))) + +(ert-deftest erc--update-modules () + (let (calls + erc-modules + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (cl-letf (((symbol-function 'require) + (lambda (s &rest _) (push s calls))) + + ;; Local modules + ((symbol-function 'erc-fake-bar-mode) + (lambda (n) (push (cons 'fake-bar n) calls))) + + ;; Global modules + ((symbol-function 'erc-fake-foo-mode) + (lambda (n) (push (cons 'fake-foo n) calls))) + ((get 'erc-fake-foo-mode 'standard-value) 'ignore) + ((symbol-function 'erc-autojoin-mode) + (lambda (n) (push (cons 'autojoin n) calls))) + ((get 'erc-autojoin-mode 'standard-value) 'ignore) + ((symbol-function 'erc-networks-mode) + (lambda (n) (push (cons 'networks n) calls))) + ((get 'erc-networks-mode 'standard-value) 'ignore) + ((symbol-function 'erc-completion-mode) + (lambda (n) (push (cons 'completion n) calls))) + ((get 'erc-completion-mode 'standard-value) 'ignore)) + + (ert-info ("Local modules") + (setq erc-modules '(fake-foo fake-bar)) + (should (equal (erc--update-modules) '(erc-fake-bar-mode))) + ;; Bar the feature is still required but the mode is not activated + (should (equal (nreverse calls) + '(erc-fake-foo (fake-foo . 1) erc-fake-bar))) + (setq calls nil)) + + (ert-info ("Module name overrides") + (setq erc-modules '(completion autojoin networks)) + (should-not (erc--update-modules)) ; no locals + (should (equal (nreverse calls) '( erc-pcomplete (completion . 1) + erc-join (autojoin . 1) + erc-networks (networks . 1)))) + (setq calls nil))))) + +(ert-deftest erc--merge-local-modes () + + (ert-info ("No existing modes") + (let ((old '((a) (b . t))) + (new '(erc-c-mode erc-d-mode))) + (should (equal (erc--merge-local-modes new old) + '((erc-c-mode erc-d-mode)))))) + + (ert-info ("Active existing added, inactive existing removed, deduped") + (let ((old '((a) (erc-b-mode) (c . t) (erc-d-mode . t) (erc-e-mode . t))) + (new '(erc-b-mode erc-d-mode))) + (should (equal (erc--merge-local-modes new old) + '((erc-d-mode erc-e-mode) . (erc-b-mode))))))) + +(ert-deftest define-erc-module--global () + (let ((global-module '(define-erc-module mname malias + "Some docstring" + ((ignore a) (ignore b)) + ((ignore c) (ignore d))))) + + (should (equal (macroexpand global-module) + `(progn + + (define-minor-mode erc-mname-mode + "Toggle ERC mname mode. +With a prefix argument ARG, enable mname if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil. +Some docstring" + :global t + :group 'erc-mname + (if erc-mname-mode + (erc-mname-enable) + (erc-mname-disable))) + + (defun erc-mname-enable () + "Enable ERC mname mode." + (interactive) + (cl-pushnew 'mname erc-modules) + (setq erc-mname-mode t) + (ignore a) (ignore b)) + + (defun erc-mname-disable () + "Disable ERC mname mode." + (interactive) + (setq erc-modules (delq 'mname erc-modules)) + (setq erc-mname-mode nil) + (ignore c) (ignore d)) + + (defalias 'erc-malias-mode #'erc-mname-mode) + + (put 'erc-mname-mode 'definition-name 'mname) + (put 'erc-mname-enable 'definition-name 'mname) + (put 'erc-mname-disable 'definition-name 'mname)))))) + +(ert-deftest define-erc-module--local () + (let* ((global-module '(define-erc-module mname malias + "Some docstring" + ((ignore a) (ignore b)) + ((ignore c) (ignore d)) + 'local)) + (got (macroexpand global-module)) + (arg-en (cadr (nth 2 (nth 2 got)))) + (arg-dis (cadr (nth 2 (nth 3 got))))) + + (should (equal got + `(progn + (define-minor-mode erc-mname-mode + "Toggle ERC mname mode. +With a prefix argument ARG, enable mname if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil. +Some docstring" + :global nil + :group 'erc-mname + (if erc-mname-mode + (erc-mname-enable) + (erc-mname-disable))) + + (defun erc-mname-enable (&optional ,arg-en) + "Enable ERC mname mode. +With ARG, do so in all buffers for the current connection." + (interactive "p") + (when (derived-mode-p 'erc-mode) + (if ,arg-en + (erc-with-all-buffers-of-server + erc-server-process nil + (erc-mname-enable)) + (setq erc-mname-mode t) + (ignore a) (ignore b)))) + + (defun erc-mname-disable (&optional ,arg-dis) + "Disable ERC mname mode. +With ARG, do so in all buffers for the current connection." + (interactive "p") + (when (derived-mode-p 'erc-mode) + (if ,arg-dis + (erc-with-all-buffers-of-server + erc-server-process nil + (erc-mname-disable)) + (setq erc-mname-mode nil) + (ignore c) (ignore d)))) + + (defalias 'erc-malias-mode #'erc-mname-mode) + + (put 'erc-mname-mode 'definition-name 'mname) + (put 'erc-mname-enable 'definition-name 'mname) + (put 'erc-mname-disable 'definition-name 'mname)))))) + ;;; erc-tests.el ends here diff --git a/test/lisp/erc/resources/base/local-modules/first.eld b/test/lisp/erc/resources/base/local-modules/first.eld new file mode 100644 index 00000000000..f9181a80fb7 --- /dev/null +++ b/test/lisp/erc/resources/base/local-modules/first.eld @@ -0,0 +1,53 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP REQ :sasl")) +((nick 1 "NICK tester")) +((user 1 "USER tester 0 * :tester")) + +((authenticate 5 "AUTHENTICATE PLAIN") + (0.0 ":irc.foonet.org CAP * ACK sasl") + (0.0 "AUTHENTICATE +")) + +((authenticate 5 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==") + (0.0 ":irc.foonet.org 900 * * tester :You are now logged in as tester") + (0.01 ":irc.foonet.org 903 * :Authentication successful")) + +((cap 3.2 "CAP END") + (0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0") + (0.2 ":irc.foonet.org 003 tester :This server was created Sun, 20 Nov 2022 23:10:36 UTC") + (0.0 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0.0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0.0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0.0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.0 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.0 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.0 ":irc.foonet.org 254 tester 1 :channels formed") + (0.0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.0 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.0 ":irc.foonet.org 221 tester +i") + (0.0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode 10 "MODE tester +i") + (0.02 ":irc.foonet.org 221 tester +i")) + +((join 10 "JOIN #chan") + (0.00 ":tester!~u@u9iqi96sfwk9s.irc JOIN #chan") + (0.06 ":irc.foonet.org 353 tester = #chan :@bob alice tester") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.02 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester, welcome!") + (0.04 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: Either your unparagoned mistress is dead, or she's outprized by a trifle.")) + +((mode 12 "MODE #chan") + (0.00 ":irc.foonet.org 324 tester #chan +nt") + (0.02 ":irc.foonet.org 329 tester #chan 1668985854") + (0.98 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: Come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of ? Come me to what was done to her.") + (0.01 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: She is Lavinia, therefore must be lov'd.")) + +((quit 10 "QUIT :\2ERC\2") + (0.02 ":tester!~u@u9iqi96sfwk9s.irc QUIT :Quit")) + +((drop 0 DROP)) diff --git a/test/lisp/erc/resources/base/local-modules/fourth.eld b/test/lisp/erc/resources/base/local-modules/fourth.eld new file mode 100644 index 00000000000..fd6d62b6cc2 --- /dev/null +++ b/test/lisp/erc/resources/base/local-modules/fourth.eld @@ -0,0 +1,53 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP REQ :sasl")) +((nick 10 "NICK tester`")) +((user 10 "USER tester 0 * :tester")) + +((authenticate 10 "AUTHENTICATE PLAIN") + (0.0 ":irc.foonet.org CAP * ACK sasl") + (0.0 "AUTHENTICATE +")) + +((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==") + (0.00 ":irc.foonet.org 900 * * tester :You are now logged in as tester") + (0.01 ":irc.foonet.org 903 * :Authentication successful")) + +((cap 10 "CAP END") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0") + (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 20 Nov 2022 23:10:36 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.13 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0.01 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0.03 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.03 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.02 ":irc.foonet.org 221 tester +i") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode 10 "MODE tester +i") + (0.0 ":irc.foonet.org 221 tester +i")) + +((join 10 "JOIN #chan") + (0.00 ":tester!~u@u9iqi96sfwk9s.irc JOIN #chan") + (0.09 ":irc.foonet.org 353 tester = #chan :alice tester @bob") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester, welcome!") + (0.00 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester, welcome!") + (0.03 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: And both shall cease, without your remedy.") + (0.02 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: Nay, tarry; I'll go along with thee: I can tell thee pretty tales of the duke.")) + +((mode 10 "MODE #chan") + (0.00 ":irc.foonet.org 324 tester #chan +nt") + (0.01 ":irc.foonet.org 329 tester #chan 1668985854") + (0.03 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: Do: I'll take the sacrament on't, how and which way you will.") + (0.00 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: Worthy Macbeth, we stay upon your leisure.") + (0.00 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: Well met; good morrow, Titus and Hortensius.")) + +((quit 10 "QUIT :\2ERC\2") + (0.03 ":tester!~u@u9iqi96sfwk9s.irc QUIT :Quit")) diff --git a/test/lisp/erc/resources/base/local-modules/second.eld b/test/lisp/erc/resources/base/local-modules/second.eld new file mode 100644 index 00000000000..a96103b2aa1 --- /dev/null +++ b/test/lisp/erc/resources/base/local-modules/second.eld @@ -0,0 +1,47 @@ +;; -*- mode: lisp-data; -*- +((pass 10 "PASS :changeme")) +((nick 1 "NICK tester")) +((user 1 "USER tester 0 * :tester") + (0.0 ":irc.foonet.org 433 * tester :Nickname is reserved by a different account")) + +((nick 10 "NICK tester`") + (0.01 ":irc.foonet.org FAIL NICK NICKNAME_RESERVED tester :Nickname is reserved by a different account") + (0.06 ":irc.foonet.org 001 tester` :Welcome to the foonet IRC Network tester`") + (0.01 ":irc.foonet.org 002 tester` :Your host is irc.foonet.org, running version ergo-v2.8.0") + (0.01 ":irc.foonet.org 003 tester` :This server was created Sun, 20 Nov 2022 23:10:36 UTC") + (0.01 ":irc.foonet.org 004 tester` irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.01 ":irc.foonet.org 005 tester` AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0.01 ":irc.foonet.org 005 tester` MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester` draft/CHATHISTORY=100 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester` :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester` 0 :IRC Operators online") + (0.02 ":irc.foonet.org 253 tester` 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester` 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester` :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester` 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester` 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 422 tester` :MOTD File is missing") + (0.02 ":irc.foonet.org 221 tester` +i") + (0.00 ":irc.foonet.org NOTICE tester` :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode 12 "MODE tester` +i") + (0.0 ":irc.foonet.org 221 tester` +i")) + +((join 10 "JOIN #chan") + (0.00 ":tester`!~u@u9iqi96sfwk9s.irc JOIN #chan") + (0.08 ":irc.foonet.org 353 tester` = #chan :@bob alice tester`") + (0.01 ":irc.foonet.org 366 tester` #chan :End of NAMES list") + (0.00 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester`, welcome!") + (0.01 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester`, welcome!") + (0.05 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: And Jove, for your love, would infringe an oath.")) + +((mode 10 "MODE #chan") + (0.00 ":irc.foonet.org 324 tester` #chan +nt") + (0.02 ":irc.foonet.org 329 tester` #chan 1668985854") + (0.07 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: To you that know them not. This to my mother.") + (0.00 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: Some enigma, some riddle: come, thy l'envoy; begin.")) + +((quit 1 "QUIT :\2ERC\2") + (0.03 ":tester`!~u@u9iqi96sfwk9s.irc QUIT")) + +((drop 0 DROP)) diff --git a/test/lisp/erc/resources/base/local-modules/third.eld b/test/lisp/erc/resources/base/local-modules/third.eld new file mode 100644 index 00000000000..19bdd6efcce --- /dev/null +++ b/test/lisp/erc/resources/base/local-modules/third.eld @@ -0,0 +1,43 @@ +;; -*- mode: lisp-data; -*- +((pass 10 "PASS :changeme")) +((nick 1 "NICK tester`")) +((user 1 "USER tester 0 * :tester") + (0.06 ":irc.foonet.org 001 tester` :Welcome to the foonet IRC Network tester`") + (0.01 ":irc.foonet.org 002 tester` :Your host is irc.foonet.org, running version ergo-v2.8.0") + (0.01 ":irc.foonet.org 003 tester` :This server was created Sun, 20 Nov 2022 23:10:36 UTC") + (0.01 ":irc.foonet.org 004 tester` irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.01 ":irc.foonet.org 005 tester` AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0.01 ":irc.foonet.org 005 tester` MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester` draft/CHATHISTORY=100 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester` :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester` 0 :IRC Operators online") + (0.02 ":irc.foonet.org 253 tester` 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester` 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester` :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester` 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester` 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 422 tester` :MOTD File is missing") + (0.02 ":irc.foonet.org 221 tester` +i") + (0.00 ":irc.foonet.org NOTICE tester` :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode 12 "MODE tester` +i") + (0.0 ":irc.foonet.org 221 tester` +i")) + +((join 10 "JOIN #chan") + (0.00 ":tester`!~u@u9iqi96sfwk9s.irc JOIN #chan") + (0.08 ":irc.foonet.org 353 tester` = #chan :@bob alice tester`") + (0.01 ":irc.foonet.org 366 tester` #chan :End of NAMES list") + (0.00 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester`, welcome!") + (0.01 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :tester`, welcome!") + (0.05 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: With pomp, with triumph, and with revelling.")) + +((mode 10 "MODE #chan") + (0.00 ":irc.foonet.org 324 tester` #chan +nt") + (0.02 ":irc.foonet.org 329 tester` #chan 1668985854") + (0.00 ":alice!~u@2fzfcku68ehqa.irc PRIVMSG #chan :bob: No remedy, my lord, when walls are so wilful to hear without warning.") + (0.01 ":bob!~u@2fzfcku68ehqa.irc PRIVMSG #chan :alice: Let our reciprocal vows be remembered. You have many opportunities to cut him off; if your will want not, time and place will be fruitfully offered. There is nothing done if he return the conqueror; then am I the prisoner, and his bed my gaol; from the loathed warmth whereof deliver me, and supply the place for your labor.")) + +((quit 1 "QUIT :\2ERC\2") + (0.03 ":tester`!~u@u9iqi96sfwk9s.irc QUIT :Quit")) + +((drop 0 DROP)) diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld b/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld index 2c3d297b9cf..686a47f68a3 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld @@ -36,6 +36,6 @@ (0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: Why, will shall break it; will, and nothing else.") (0.1 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: Yes, a dozen; and as many to the vantage, as would store the world they played for.") (0.05 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: As he regards his aged father's life.") - (0.05 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonour in doing it.")) + (0.05 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonor in doing it.")) ((drop 0 DROP)) diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet.eld b/test/lisp/erc/resources/base/netid/bouncer/barnet.eld index abfcc6ed481..d0fe3af8ea4 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/barnet.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/barnet.eld @@ -36,6 +36,6 @@ (0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: Why, will shall break it; will, and nothing else.") (0.1 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: Yes, a dozen; and as many to the vantage, as would store the world they played for.") (0.05 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: As he regards his aged father's life.") - (0.05 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonour in doing it.")) + (0.05 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonor in doing it.")) ((linger 1 LINGER)) diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld index 36b1cc23081..4994e9c5503 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic-barnet.eld @@ -30,4 +30,4 @@ (0 ":irc.barnet.org 329 tester #chan 1620805269") (0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: Yes, a dozen; and as many to the vantage, as would store the world they played for.") (0.05 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: As he regards his aged father's life.") - (0.05 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonour in doing it.")) + (0.05 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonor in doing it.")) diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld index 5dbea50f865..a47998e7d32 100644 --- a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld +++ b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld @@ -29,4 +29,4 @@ (0 ":irc.foonet.org 329 tester #chan 1620805269") (0.1 ":alice!~u@awyxgybtkx7uq.irc PRIVMSG #chan :bob: Yes, a dozen; and as many to the vantage, as would store the world they played for.") (0.05 ":bob!~u@awyxgybtkx7uq.irc PRIVMSG #chan :alice: As he regards his aged father's life.") - (0.05 ":alice!~u@awyxgybtkx7uq.irc PRIVMSG #chan :bob: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonour in doing it.")) + (0.05 ":alice!~u@awyxgybtkx7uq.irc PRIVMSG #chan :bob: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonor in doing it.")) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index ef65125241f..601c9e95c88 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -296,7 +296,7 @@ buffer-naming collisions involving bouncers in ERC." (erc-d-t-search-for 1 "<joe>") (erc-d-t-absent-for 0.1 "<bob>") (erc-d-t-wait-for 5 (eq erc-server-process erc-server-process-bar)) - (erc-d-t-search-for 15 "keeps you from dishonour") + (erc-d-t-search-for 15 "joe: It is a rupture") (erc-d-t-wait-for 5 (not (erc-server-process-alive))))) (when after (funcall after)))) diff --git a/test/lisp/erc/resources/sasl/external.eld b/test/lisp/erc/resources/sasl/external.eld new file mode 100644 index 00000000000..2cd237ec4d4 --- /dev/null +++ b/test/lisp/erc/resources/sasl/external.eld @@ -0,0 +1,33 @@ +;; -*- mode: lisp-data; -*- +((cap-req 10 "CAP REQ :sasl")) +((nick 1 "NICK tester")) +((user 1 "USER tester 0 * :tester")) + +((auth-req 3.2 "AUTHENTICATE EXTERNAL") + (0.0 ":irc.example.org CAP * ACK :sasl") + (0.0 "AUTHENTICATE +")) + +((auth-noop 3.2 "AUTHENTICATE +") + (0.0 ":irc.example.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.example.org 903 * :Authentication successful")) + +((cap-end 3.2 "CAP END") + (0.0 ":irc.example.org 001 tester :Welcome to the ExampleOrg IRC Network tester") + (0.01 ":irc.example.org 002 tester :Your host is irc.example.org, running version oragono-2.6.1") + (0.01 ":irc.example.org 003 tester :This server was created Sat, 17 Jul 2021 09:06:42 UTC") + (0.01 ":irc.example.org 004 tester irc.example.org oragono-2.6.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 ":irc.example.org 005 tester AWAYLEN=200 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0.01 ":irc.example.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY :are supported by this server") + (0.01 ":irc.example.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0.0 ":irc.example.org 251 tester :There are 1 users and 0 invisible on 1 server(s)") + (0.0 ":irc.example.org 252 tester 0 :IRC Operators online") + (0.0 ":irc.example.org 253 tester 0 :unregistered connections") + (0.0 ":irc.example.org 254 tester 0 :channels formed") + (0.0 ":irc.example.org 255 tester :I have 1 clients and 0 servers") + (0.0 ":irc.example.org 265 tester 1 1 :Current local users 1, max 1") + (0.21 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1") + (0.0 ":irc.example.org 422 tester :MOTD File is missing")) + +((mode-user 1.2 "MODE tester +i") + (0.0 ":irc.example.org 221 tester +Zi") + (0.0 ":irc.example.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) diff --git a/test/lisp/erc/resources/sasl/plain-failed.eld b/test/lisp/erc/resources/sasl/plain-failed.eld new file mode 100644 index 00000000000..336700290c5 --- /dev/null +++ b/test/lisp/erc/resources/sasl/plain-failed.eld @@ -0,0 +1,16 @@ +;; -*- mode: lisp-data; -*- +((cap-req 10 "CAP REQ :sasl")) +((nick 1 "NICK tester")) +((user 1 "USER tester 0 * :tester") + (0.0 ":irc.foonet.org NOTICE * :*** Looking up your hostname...") + (0.0 ":irc.foonet.org NOTICE * :*** Found your hostname") + (0.0 ":irc.foonet.org CAP * ACK :cap-notify sasl")) + +((authenticate-plain 3.2 "AUTHENTICATE PLAIN") + (0.0 ":irc.foonet.org AUTHENTICATE +")) + +((authenticate-gimme 3.2 "AUTHENTICATE AHRlc3RlcgB3cm9uZw==") + (0.0 ":irc.foonet.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.foonet.org 904 * :SASL authentication failed: Invalid account credentials")) + +((cap-end 3.2 "CAP END")) diff --git a/test/lisp/erc/resources/sasl/plain.eld b/test/lisp/erc/resources/sasl/plain.eld new file mode 100644 index 00000000000..1341cd78e5e --- /dev/null +++ b/test/lisp/erc/resources/sasl/plain.eld @@ -0,0 +1,39 @@ +;; -*- mode: lisp-data; -*- +((cap-req 10 "CAP REQ :sasl")) +((nick 1 "NICK tester")) +((user 1 "USER tester 0 * :tester") + (0.0 ":irc.example.org NOTICE * :*** Looking up your hostname...") + (0.0 ":irc.example.org NOTICE * :*** Found your hostname") + (0.0 ":irc.example.org CAP * ACK :sasl")) + +((authenticate-plain 3.2 "AUTHENTICATE PLAIN") + (0.0 ":irc.example.org AUTHENTICATE +")) + +((authenticate-gimme 3.2 "AUTHENTICATE AHRlc3RlcgBwYXNzd29yZDEyMw==") + (0.0 ":irc.example.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.example.org 903 * :Authentication successful")) + +((cap-end 3.2 "CAP END") + (0.0 ":irc.example.org 001 tester :Welcome to the ExampleOrg IRC Network tester") + (0.01 ":irc.example.org 002 tester :Your host is irc.example.org, running version oragono-2.6.1") + (0.01 ":irc.example.org 003 tester :This server was created Sat, 17 Jul 2021 09:06:42 UTC") + (0.01 ":irc.example.org 004 tester irc.example.org oragono-2.6.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 ":irc.example.org 005 tester AWAYLEN=200 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0.01 ":irc.example.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY :are supported by this server") + (0.01 ":irc.example.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0.0 ":irc.example.org 251 tester :There are 1 users and 0 invisible on 1 server(s)") + (0.0 ":irc.example.org 252 tester 0 :IRC Operators online") + (0.0 ":irc.example.org 253 tester 0 :unregistered connections") + (0.0 ":irc.example.org 254 tester 0 :channels formed") + (0.0 ":irc.example.org 255 tester :I have 1 clients and 0 servers") + (0.0 ":irc.example.org 265 tester 1 1 :Current local users 1, max 1") + (0.21 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1") + (0.0 ":irc.example.org 422 tester :MOTD File is missing")) + +((mode-user 1.2 "MODE tester +i") + (0.0 ":irc.example.org 221 tester +Zi") + (0.0 ":irc.example.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((quit 5 "QUIT :\2ERC\2") + (0 ":tester!~u@yuvqisyu7m7qs.irc QUIT :Quit")) +((drop 1 DROP)) diff --git a/test/lisp/erc/resources/sasl/scram-sha-1.eld b/test/lisp/erc/resources/sasl/scram-sha-1.eld new file mode 100644 index 00000000000..49980e9e12a --- /dev/null +++ b/test/lisp/erc/resources/sasl/scram-sha-1.eld @@ -0,0 +1,47 @@ +;;; -*- mode: lisp-data -*- +((cap-req 5.2 "CAP REQ :sasl")) +((nick 10 "NICK jilles")) +((user 10 "USER user 0 * :jilles") + (0 "NOTICE AUTH :*** Processing connection to jaguar.test") + (0 "NOTICE AUTH :*** Looking up your hostname...") + (0 "NOTICE AUTH :*** Checking Ident") + (0 "NOTICE AUTH :*** No Ident response") + (0 "NOTICE AUTH :*** Found your hostname") + (0 ":jaguar.test CAP jilles ACK :sasl")) + +((auth-init 10 "AUTHENTICATE SCRAM-SHA-1") + (0 "AUTHENTICATE +")) + +((auth-challenge 10 "AUTHENTICATE bixhPWppbGxlcyxuPWppbGxlcyxyPWM1UnFMQ1p5MEw0ZkdrS0FaMGh1akZCcw==") + (0 "AUTHENTICATE cj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnNYUW9LY2l2cUN3OWlEWlBTcGIscz01bUpPNmQ0cmpDbnNCVTFYLGk9NDA5Ng==")) + +((auth-final 10 "AUTHENTICATE Yz1iaXhoUFdwcGJHeGxjeXc9LHI9YzVScUxDWnkwTDRmR2tLQVowaHVqRkJzWFFvS2NpdnFDdzlpRFpQU3BiLHA9T1ZVaGdQdTh3RW0yY0RvVkxmYUh6VlVZUFdVPQ==") + (0 "AUTHENTICATE dj1aV1IyM2M5TUppcjBaZ2ZHZjVqRXRMT242Tmc9")) + +((auth-done 10 "AUTHENTICATE +") + (0 ":jaguar.test 900 jilles jilles!jilles@localhost.stack.nl jilles :You are now logged in as jilles") + (0 ":jaguar.test 903 jilles :SASL authentication successful")) + +((cap-end 10.2 "CAP END") + (0 ":jaguar.test 001 jilles :Welcome to the jaguar IRC Network jilles!~jilles@127.0.0.1") + (0 ":jaguar.test 002 jilles :Your host is jaguar.test, running version InspIRCd-3") + (0 ":jaguar.test 003 jilles :This server was created 09:44:05 Dec 24 2020") + (0 ":jaguar.test 004 jilles jaguar.test InspIRCd-3 BILRSWcghiorswz ABEFHIJLMNOQRSTXYabcefghijklmnopqrstuvz :BEFHIJLXYabefghjkloqv") + (0 ":jaguar.test 005 jilles ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=rfc1459 CHANLIMIT=#:120 CHANMODES=IXbeg,k,BEFHJLfjl,AMNOQRSTcimnprstuz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server") + (0 ":jaguar.test 005 jilles EXTBAN=,ANOQRSTUacmnprz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=jaguar :are supported by this server") + (0 ":jaguar.test 005 jilles NICKLEN=31 PREFIX=(Yqaohv)!~&@%+ REMOVE SAFELIST SECURELIST=60 SILENCE=32 STATUSMSG=!~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=11 USERMODES=,,s,BILRSWcghiorwz WATCH=30 :are supported by this server") + (0 ":jaguar.test 005 jilles :are supported by this server") + (0 ":jaguar.test 251 jilles :There are 740 users and 108 invisible on 11 servers") + (0 ":jaguar.test 252 jilles 10 :operator(s) online") + (0 ":jaguar.test 254 jilles 373 :channels formed") + (0 ":jaguar.test 255 jilles :I have 28 clients and 1 servers") + (0 ":jaguar.test 265 jilles :Current local users: 28 Max: 29") + (0 ":jaguar.test 266 jilles :Current global users: 848 Max: 879") + (0 ":jaguar.test 375 jilles :jaguar.test message of the day") + (0 ":jaguar.test 372 jilles : ~~ some message of the day ~~") + (0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~") + (0 ":jaguar.test 376 jilles :End of message of the day.")) + +((mode-user 1.2 "MODE jilles +i") + (0 ":jilles!~jilles@127.0.0.1 MODE jilles :+ri") + (0 ":jaguar.test 306 jilles :You have been marked as being away")) diff --git a/test/lisp/erc/resources/sasl/scram-sha-256.eld b/test/lisp/erc/resources/sasl/scram-sha-256.eld new file mode 100644 index 00000000000..74de9a23ecf --- /dev/null +++ b/test/lisp/erc/resources/sasl/scram-sha-256.eld @@ -0,0 +1,47 @@ +;;; -*- mode: lisp-data -*- +((cap-req 5.2 "CAP REQ :sasl")) +((nick 10 "NICK jilles")) +((user 10 "USER user 0 * :jilles") + (0 "NOTICE AUTH :*** Processing connection to jaguar.test") + (0 "NOTICE AUTH :*** Looking up your hostname...") + (0 "NOTICE AUTH :*** Checking Ident") + (0 "NOTICE AUTH :*** No Ident response") + (0 "NOTICE AUTH :*** Found your hostname") + (0 ":jaguar.test CAP jilles ACK :sasl")) + +((auth-init 10 "AUTHENTICATE SCRAM-SHA-256") + (0 "AUTHENTICATE +")) + +((auth-challenge 10 "AUTHENTICATE biwsbj1qaWxsZXMscj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnM=") + (0 "AUTHENTICATE cj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnNkNDA2N2YwYWZkYjU0YzNkYmQ0ZmU2NDViODRjYWUzNyxzPVpUZzFNbUUxWW1GaFpHSTFORGN5TWprM056WXdabVJqWkRNM1kySTFPVE09LGk9NDA5Ng==")) + +((auth-final 10 "AUTHENTICATE Yz1iaXdzLHI9YzVScUxDWnkwTDRmR2tLQVowaHVqRkJzZDQwNjdmMGFmZGI1NGMzZGJkNGZlNjQ1Yjg0Y2FlMzcscD1MUDRzakpyakpLcDVxVHNBUnlaQ3BwWHBLTHU0Rk1NMjg0aE5FU1B2R2hJPQ==") + (0 "AUTHENTICATE dj04NDdXWGZubVJlR3lFMXFscTFBbmQ2UjRiUEJOUk9UWjdFTVMvUXJKdFVNPQ==")) + +((auth-done 10 "AUTHENTICATE +") + (0 ":jaguar.test 900 jilles jilles!jilles@localhost.stack.nl jilles :You are now logged in as jilles") + (0 ":jaguar.test 903 jilles :SASL authentication successful")) + +((cap-end 10.2 "CAP END") + (0 ":jaguar.test 001 jilles :Welcome to the jaguar IRC Network jilles!~jilles@127.0.0.1") + (0 ":jaguar.test 002 jilles :Your host is jaguar.test, running version InspIRCd-3") + (0 ":jaguar.test 003 jilles :This server was created 09:44:05 Dec 24 2020") + (0 ":jaguar.test 004 jilles jaguar.test InspIRCd-3 BILRSWcghiorswz ABEFHIJLMNOQRSTXYabcefghijklmnopqrstuvz :BEFHIJLXYabefghjkloqv") + (0 ":jaguar.test 005 jilles ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=rfc1459 CHANLIMIT=#:120 CHANMODES=IXbeg,k,BEFHJLfjl,AMNOQRSTcimnprstuz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server") + (0 ":jaguar.test 005 jilles EXTBAN=,ANOQRSTUacmnprz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=jaguar :are supported by this server") + (0 ":jaguar.test 005 jilles NICKLEN=31 PREFIX=(Yqaohv)!~&@%+ REMOVE SAFELIST SECURELIST=60 SILENCE=32 STATUSMSG=!~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=11 USERMODES=,,s,BILRSWcghiorwz WATCH=30 :are supported by this server") + (0 ":jaguar.test 005 jilles :are supported by this server") + (0 ":jaguar.test 251 jilles :There are 740 users and 108 invisible on 11 servers") + (0 ":jaguar.test 252 jilles 10 :operator(s) online") + (0 ":jaguar.test 254 jilles 373 :channels formed") + (0 ":jaguar.test 255 jilles :I have 28 clients and 1 servers") + (0 ":jaguar.test 265 jilles :Current local users: 28 Max: 29") + (0 ":jaguar.test 266 jilles :Current global users: 848 Max: 879") + (0 ":jaguar.test 375 jilles :jaguar.test message of the day") + (0 ":jaguar.test 372 jilles : ~~ some message of the day ~~") + (0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~") + (0 ":jaguar.test 376 jilles :End of message of the day.")) + +((mode-user 1.2 "MODE jilles +i") + (0 ":jilles!~jilles@127.0.0.1 MODE jilles :+ri") + (0 ":jaguar.test 306 jilles :You have been marked as being away")) diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 245a8e6a26b..96fde026a54 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -289,7 +289,7 @@ inside double-quotes" (eshell-command-result-equal "echo \"$#eshell-test-value\"" "1") (eshell-command-result-equal "echo \"$#eshell-test-value[foo]\"" - "3")) + "3"))) (ert-deftest esh-var-test/quoted-interp-lisp () "Interpolate Lisp form evaluation inside double-quotes" @@ -316,7 +316,7 @@ inside double-quotes" (let ((temporary-file-directory (file-name-as-directory (make-temp-file "esh-vars-tests" t)))) (unwind-protect - (eshell-command-result-equal "cat \"$<echo hi>\"" "hi")) + (eshell-command-result-equal "cat \"$<echo hi>\"" "hi") (delete-directory temporary-file-directory t)))) (ert-deftest esh-var-test/quoted-interp-concat-cmd () diff --git a/test/lisp/net/eudc-resources/bbdb b/test/lisp/net/eudc-resources/bbdb index b730bb51cc9..782da56e9f1 100644 --- a/test/lisp/net/eudc-resources/bbdb +++ b/test/lisp/net/eudc-resources/bbdb @@ -1,3 +1,4 @@ ;; -*- mode: Emacs-Lisp; coding: utf-8; -*- ;;; file-format: 9 ["Emacs" "ERT3" nil nil nil nil nil ("emacs-ert-test-3@bbdb.gnu.org") ((notes . " ")) "c8bd3a63-3a83-48a7-a95b-be118a923e00" "2022-11-19 16:36:04 +0000" "2022-11-19 16:36:04 +0000" nil] +["Emacs" "ERT4" nil nil nil nil nil ("emacs-ert-test-4@bbdb.gnu.org") ((notes . " ")) "5a93c3c5-9270-4e10-8b28-d28cfa2562cf" "2022-11-19 16:47:49 +0000" "2022-11-19 16:47:49 +0000" nil] diff --git a/test/lisp/net/eudc-tests.el b/test/lisp/net/eudc-tests.el index 212db65cb26..0da51b7c36e 100644 --- a/test/lisp/net/eudc-tests.el +++ b/test/lisp/net/eudc-tests.el @@ -281,7 +281,12 @@ Karl Fogel <kfogel@mail-abbrev.com"))))))))) base "dc=gnu,dc=org" auth simple))) (eudc-server-hotlist '(("ldap://localhost:3899" . ldap))) (eudc-ignore-options-file t)) - (sleep-for 1) ; Wait for slapd to start. + (catch 'sldapd-up + (dotimes (_tries 20) + (when (eudc-query-with-words '("emacs-ert-test-1")) + (throw 'sldapd-up nil))) + (kill-process ldap-process) + (error "Failed to confirm slapd is running")) (should (equal (with-temp-buffer (insert "emacs-ert-test-1") (eudc-expand-try-all) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index a5bae46a583..a79c47be723 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -7630,6 +7630,9 @@ Since it unloads Tramp, it shall be the last test to run." (string-prefix-p "tramp" (symbol-name x)) ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1. (not (eq 'tramp-completion-mode x)) + ;; `tramp-register-archive-file-name-handler' is autoloaded + ;; in Emacs < 29.1. + (not (eq 'tramp-register-archive-file-name-handler x)) (not (string-match-p (rx bol "tramp" (? "-archive") (** 1 2 "-") "test") (symbol-name x))) diff --git a/test/lisp/server-tests.el b/test/lisp/server-tests.el index 351b8ef8d12..f8ecd046f2b 100644 --- a/test/lisp/server-tests.el +++ b/test/lisp/server-tests.el @@ -22,20 +22,198 @@ (require 'ert) (require 'server) +(defconst server-tests/can-create-frames-p + (not (memq system-type '(windows-nt ms-dos))) + "Non-nil if we can create a new frame in the tests. +Some tests below need to create new frames for the emacsclient. +However, this doesn't work on all platforms. In particular, +MS-Windows fails to create frames from a batch Emacs session. In +cases like that, we just skip the test.") + +(defconst server-tests/max-wait-time 5 + "The maximum time to wait in `server-tests/wait-until', in seconds.") + +(defconst server-tests/emacsclient + (if installation-directory + (expand-file-name "lib-src/emacsclient" installation-directory) + "emacsclient") + "The emacsclient binary to test.") + +(defmacro server-tests/wait-until (form) + "Wait until FORM is non-nil, timing out and failing if it takes too long." + `(let ((start (current-time))) + (while (not ,form) + (when (> (float-time (time-since start)) + server-tests/max-wait-time) + (ert-fail (format "timed out waiting for %S to be non-nil" ',form))) + (sit-for 0.1)))) + +(defun server-tests/start-client (args) + "Run emacsclient, passing ARGS as arguments to it." + (let ((server-file (process-get server-process :server-file)) + (buffer (generate-new-buffer "emacsclient"))) + (make-process + :name server-tests/emacsclient + :buffer buffer + :command (append (list server-tests/emacsclient + (if server-use-tcp + "--server-file" + "--socket-name") + server-file) + args)))) + +(defmacro server-tests/with-server (&rest body) + "Start the Emacs server, evaluate BODY, and then stop the server." + (declare (indent 0)) + ;; Override the `server-name' so that these tests don't interfere + ;; with any existing Emacs servers on the system. + `(let* ((temporary-file-directory (file-name-as-directory + (make-temp-file "server-tests" t))) + (server-name (expand-file-name + "test-server" temporary-file-directory)) + (server-log t)) + (server-start) + (ert-info ((lambda () + (with-current-buffer (get-buffer-create server-buffer) + (buffer-string))) + :prefix "Server logs: ") + (unwind-protect + (progn (should (processp server-process)) + ,@body) + (let ((inhibit-message t)) + (server-start t t)) + (delete-directory temporary-file-directory t) + (should (null server-process)) + (should (null server-clients)))))) + +(defmacro server-tests/with-client (client-symbol args exit-status &rest body) + "Start an Emacs client with ARGS and evaluate BODY. +This binds the client process to CLIENT-SYMBOL. If EXIT-STATUS is +non-nil, then after BODY is evaluated, make sure the client +process's status matches it." + (declare (indent 3)) + (let ((exit-status-symbol (make-symbol "exit-status")) + (starting-client-count-symbol (make-symbol "starting-client-count"))) + `(let ((,starting-client-count-symbol (length server-clients)) + (,exit-status-symbol ,exit-status) + (,client-symbol (server-tests/start-client ,args))) + (ert-info ((lambda () + (with-current-buffer (process-buffer ,client-symbol) + (buffer-string))) + :prefix "Client output: ") + (server-tests/wait-until + (or (= (length server-clients) + (1+ ,starting-client-count-symbol)) + (eq (process-status ,client-symbol) ,exit-status-symbol))) + ,@body + (when ,exit-status-symbol + (server-tests/wait-until (eq (process-status ,client-symbol) + ,exit-status-symbol))))))) + +(defvar server-tests/variable nil) + ;;; Tests: -(ert-deftest server-test/server-start-sets-minor-mode () +(ert-deftest server-tests/server-start/sets-minor-mode () "Ensure that calling `server-start' also sets `server-mode' properly." - (server-start) - (unwind-protect - (progn - ;; Make sure starting the server activates the minor mode. - (should (eq server-mode t)) - (should (memq 'server-mode global-minor-modes))) - ;; Always stop the server, even if the above checks fail. - (server-start t)) + (server-tests/with-server + ;; Make sure starting the server activates the minor mode. + (should (eq server-mode t)) + (should (memq 'server-mode global-minor-modes))) ;; Make sure stopping the server deactivates the minor mode. (should (eq server-mode nil)) (should-not (memq 'server-mode global-minor-modes))) +(ert-deftest server-tests/server-start/stop-prompt-with-client () + "Ensure that stopping the server prompts when there are clients." + (skip-unless server-tests/can-create-frames-p) + (server-tests/with-server + (server-tests/with-client emacsclient '("-c") 'exit + (should (length= (frame-list) 2)) + (cl-letf* ((yes-or-no-p-called nil) + ((symbol-function 'yes-or-no-p) + (lambda (_prompt) + (setq yes-or-no-p-called t)))) + (server-start t) + (should yes-or-no-p-called))))) + +(ert-deftest server-tests/server-start/no-stop-prompt-without-client () + "Ensure that stopping the server doesn't prompt when there are no clients." + (server-tests/with-server + (cl-letf* ((inhibit-message t) + (yes-or-no-p-called nil) + ((symbol-function 'yes-or-no-p) + (lambda (_prompt) + (setq yes-or-no-p-called t)))) + (server-start t) + (should-not yes-or-no-p-called)))) + +(ert-deftest server-tests/emacsclient/server-edit () + "Test that calling `server-edit' from a client buffer exits the client." + (server-tests/with-server + (server-tests/with-client emacsclient '("file.txt") 'exit + (server-tests/wait-until (get-buffer "file.txt")) + (should (eq (process-status emacsclient) 'run)) + (with-current-buffer "file.txt" + (server-edit))))) + +(ert-deftest server-tests/emacsclient/create-frame () + "Test that \"emacsclient -c\" creates a frame." + (skip-unless server-tests/can-create-frames-p) + (let ((starting-frame-count (length (frame-list)))) + (server-tests/with-server + (server-tests/with-client emacsclient '("-c") nil + (should (length= (frame-list) (1+ starting-frame-count))) + (should (eq (process-status emacsclient) 'run)) + (should (eq (frame-parameter (car (frame-list)) 'client) + (car server-clients))))) + ;; The client frame should go away after the server stops. + (should (length= (frame-list) starting-frame-count)))) + +(ert-deftest server-tests/emacsclient/eval () + "Test that \"emacsclient --eval\" works correctly." + (server-tests/with-server + (let ((value (random))) + (server-tests/with-client emacsclient + (list "--eval" (format "(setq server-tests/variable %d)" value)) + 'exit + (should (= server-tests/variable value)))))) + +(ert-deftest server-tests/server-force-stop/keeps-frames () + "Ensure that `server-force-stop' doesn't delete frames. See bug#58877. +Note: since that bug is about a behavior when killing Emacs, this +test is somewhat indirect. (Killing the current Emacs instance +would make it hard to check test results!) Instead, it only +tests that `server-force-stop' doesn't delete frames (and even +then, requires a few tricks to run as a regression test). So +long as this works, the problem in bug#58877 shouldn't occur." + (skip-unless server-tests/can-create-frames-p) + (let ((starting-frame-count (length (frame-list))) + terminal) + (unwind-protect + (server-tests/with-server + (server-tests/with-client emacsclient '("-c") 'exit + (should (eq (process-status emacsclient) 'run)) + (should (length= (frame-list) (1+ starting-frame-count))) + + ;; Don't delete the terminal for the client; that would + ;; kill its frame immediately too. (This is only an issue + ;; when running these tests via the command line; + ;; normally, in an interactive session, we don't need to + ;; worry about this. But since we want to check that + ;; `server-force-stop' doesn't delete frames under normal + ;; circumstances, we need to bypass terminal deletion + ;; here.) + (setq terminal (process-get (car server-clients) 'terminal)) + (process-put (car server-clients) 'no-delete-terminal t) + + (server-force-stop)) + ;; Ensure we didn't delete the frame. + (should (length= (frame-list) (1+ starting-frame-count)))) + ;; Clean up after ourselves and delete the terminal. + (when (and terminal + (eq (terminal-live-p terminal) t) + (not (eq system-type 'windows-nt))) + (delete-terminal terminal))))) + ;;; server-tests.el ends here diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el index 13248a36509..c54fe144b7d 100644 --- a/test/lisp/vc/vc-tests.el +++ b/test/lisp/vc/vc-tests.el @@ -122,7 +122,7 @@ Don't set it globally, the functions should be let-bound.") (defun vc-test--revision-granularity-function (backend) - "Run the `vc-revision-granularity' backend function." + "Run the `revision-granularity' backend function." (vc-call-backend backend 'revision-granularity)) (defun vc-test--create-repo-function (backend) diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el index be4f60ab57f..e9ddf9c0bef 100644 --- a/test/src/sqlite-tests.el +++ b/test/src/sqlite-tests.el @@ -243,6 +243,7 @@ (ert-deftest sqlite-returning () (skip-unless (sqlite-available-p)) + (skip-unless (version<= "3.35" (sqlite-version))) (let (db) (progn (setq db (sqlite-open)) diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el new file mode 100644 index 00000000000..80fde408cd3 --- /dev/null +++ b/test/src/treesit-tests.el @@ -0,0 +1,565 @@ +;;; treesit-tests.el --- tests for src/treesit.c -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'treesit) + +(declare-function treesit-language-available-p "treesit.c") + +(declare-function treesit-parser-root-node "treesit.c") +(declare-function treesit-parser-set-included-ranges "treesit.c") +(declare-function treesit-parser-included-ranges "treesit.c") + +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-parser-delete "treesit.c") +(declare-function treesit-parser-list "treesit.c") +(declare-function treesit-parser-buffer "treesit.c") +(declare-function treesit-parser-language "treesit.c") + +(declare-function treesit-query-expand "treesit.c") +(declare-function treesit-query-compile "treesit.c") +(declare-function treesit-query-capture "treesit.c") + +(declare-function treesit-node-type "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-end "treesit.c") +(declare-function treesit-node-string "treesit.c") +(declare-function treesit-node-parent "treesit.c") +(declare-function treesit-node-child "treesit.c") +(declare-function treesit-node-check "treesit.c") +(declare-function treesit-node-field-name-for-child "treesit.c") +(declare-function treesit-node-child-count "treesit.c") +(declare-function treesit-node-child-by-field-name "treesit.c") +(declare-function treesit-node-next-sibling "treesit.c") +(declare-function treesit-node-prev-sibling "treesit.c") +(declare-function treesit-node-first-child-for-pos "treesit.c") +(declare-function treesit-node-descendant-for-range "treesit.c") +(declare-function treesit-node-eq "treesit.c") + + +(ert-deftest treesit-basic-parsing () + "Test basic parsing routines." + (skip-unless (treesit-language-available-p 'json)) + (with-temp-buffer + (let ((parser (treesit-parser-create 'json))) + (should + (eq parser (car (treesit-parser-list)))) + (should + (equal (treesit-node-string + (treesit-parser-root-node parser)) + "(ERROR)")) + + (insert "[1,2,3]") + (should + (equal (treesit-node-string + (treesit-parser-root-node parser)) + "(document (array (number) (number) (number)))")) + + (goto-char (point-min)) + (forward-char 3) + (insert "{\"name\": \"Bob\"},") + (should + (equal + (treesit-node-string + (treesit-parser-root-node parser)) + "(document (array (number) (object (pair key: (string (string_content)) value: (string (string_content)))) (number) (number)))"))))) + +(ert-deftest treesit-node-api () + "Tests for node API." + (skip-unless (treesit-language-available-p 'json)) + (with-temp-buffer + (let (parser root-node doc-node object-node pair-node) + (progn + (insert "[1,2,{\"name\": \"Bob\"},3]") + (setq parser (treesit-parser-create 'json)) + (setq root-node (treesit-parser-root-node + parser))) + ;; `treesit-node-type'. + (should (equal "document" (treesit-node-type root-node))) + ;; `treesit-node-check'. + (should (eq t (treesit-node-check root-node 'named))) + (should (eq nil (treesit-node-check root-node 'missing))) + (should (eq nil (treesit-node-check root-node 'extra))) + (should (eq nil (treesit-node-check root-node 'has-error))) + ;; `treesit-node-child'. + (setq doc-node (treesit-node-child root-node 0)) + (should (equal "array" (treesit-node-type doc-node))) + (should (equal (treesit-node-string doc-node) + "(array (number) (number) (object (pair key: (string (string_content)) value: (string (string_content)))) (number))")) + ;; `treesit-node-child-count'. + (should (eql 9 (treesit-node-child-count doc-node))) + (should (eql 4 (treesit-node-child-count doc-node t))) + ;; `treesit-node-field-name-for-child'. + (setq object-node (treesit-node-child doc-node 2 t)) + (setq pair-node (treesit-node-child object-node 0 t)) + (should (equal "object" (treesit-node-type object-node))) + (should (equal "pair" (treesit-node-type pair-node))) + (should (equal "key" + (treesit-node-field-name-for-child + pair-node 0))) + ;; `treesit-node-child-by-field-name'. + (should (equal "(string (string_content))" + (treesit-node-string + (treesit-node-child-by-field-name + pair-node "key")))) + ;; `treesit-node-next-sibling'. + (should (equal "(number)" + (treesit-node-string + (treesit-node-next-sibling object-node t)))) + (should (equal "(\",\")" + (treesit-node-string + (treesit-node-next-sibling object-node)))) + ;; `treesit-node-prev-sibling'. + (should (equal "(number)" + (treesit-node-string + (treesit-node-prev-sibling object-node t)))) + (should (equal "(\",\")" + (treesit-node-string + (treesit-node-prev-sibling object-node)))) + ;; `treesit-node-first-child-for-pos'. + (should (equal "(number)" + (treesit-node-string + (treesit-node-first-child-for-pos + doc-node 3 t)))) + (should (equal "(\",\")" + (treesit-node-string + (treesit-node-first-child-for-pos + doc-node 3)))) + ;; `treesit-node-descendant-for-range'. + (should (equal "(\"{\")" + (treesit-node-string + (treesit-node-descendant-for-range + root-node 6 7)))) + (should (equal "(object (pair key: (string (string_content)) value: (string (string_content))))" + (treesit-node-string + (treesit-node-descendant-for-range + root-node 6 7 t)))) + ;; `treesit-node-eq'. + (should (treesit-node-eq root-node root-node)) + (should (not (treesit-node-eq root-node doc-node)))))) + +(ert-deftest treesit-query-api () + "Tests for query API." + (skip-unless (treesit-language-available-p 'json)) + (with-temp-buffer + (let (parser root-node) + (progn + (insert "[1,2,{\"name\": \"Bob\"},3]") + (setq parser (treesit-parser-create 'json)) + (setq root-node (treesit-parser-root-node + parser))) + + ;; Test `treesit-query-capture' on string, sexp and compiled + ;; queries. + (dolist (query1 + ;; String query. + '("(string) @string +(pair key: (_) @keyword) +((_) @bob (#match \"^B.b$\" @bob)) +(number) @number +((number) @n3 (#equal \"3\" @n3)) " + ;; Sexp query. + ((string) @string + (pair key: (_) @keyword) + ((_) @bob (:match "^B.b$" @bob)) + (number) @number + ((number) @n3 (:equal "3" @n3))))) + ;; Test `treesit-query-compile'. + (dolist (query (list query1 + (treesit-query-compile 'json query1))) + (should + (equal + '((number . "1") (number . "2") + (keyword . "\"name\"") + (string . "\"name\"") + (string . "\"Bob\"") + (bob . "Bob") + (number . "3") + (n3 . "3")) + (mapcar (lambda (entry) + (cons (car entry) + (treesit-node-text + (cdr entry)))) + (treesit-query-capture root-node query)))))) + ;; Test `treesit-query-expand'. + (should + (equal + "(type field: (_) @capture .) ? * + \"return\"" + (treesit-query-expand + '((type field: (_) @capture :anchor) + :? :* :+ "return"))))))) + +(ert-deftest treesit-narrow () + "Tests if narrowing works." + (skip-unless (treesit-language-available-p 'json)) + (with-temp-buffer + (let (parser) + (progn + (insert "xxx[1,{\"name\": \"Bob\"},2,3]xxx") + (narrow-to-region (+ (point-min) 3) (- (point-max) 3)) + (setq parser (treesit-parser-create 'json)) + (treesit-parser-root-node parser)) + ;; This test is from the basic test. + (should + (equal + (treesit-node-string + (treesit-parser-root-node parser)) + "(document (array (number) (object (pair key: (string (string_content)) value: (string (string_content)))) (number) (number)))")) + + (widen) + (goto-char (point-min)) + (insert "ooo") + (should (equal "oooxxx[1,{\"name\": \"Bob\"},2,3]xxx" + (buffer-string))) + (delete-region 10 26) + (should (equal "oooxxx[1,2,3]xxx" + (buffer-string))) + (narrow-to-region (+ (point-min) 6) (- (point-max) 3)) + ;; This test is also from the basic test. + (should + (equal (treesit-node-string + (treesit-parser-root-node parser)) + "(document (array (number) (number) (number)))")) + (widen) + (goto-char (point-max)) + (insert "[1,2]") + (should (equal "oooxxx[1,2,3]xxx[1,2]" + (buffer-string))) + (narrow-to-region (- (point-max) 5) (point-max)) + (should + (equal (treesit-node-string + (treesit-parser-root-node parser)) + "(document (array (number) (number)))")) + (widen) + (goto-char (point-min)) + (insert "[1]") + (should (equal "[1]oooxxx[1,2,3]xxx[1,2]" + (buffer-string))) + (narrow-to-region (point-min) (+ (point-min) 3)) + (should + (equal (treesit-node-string + (treesit-parser-root-node parser)) + "(document (array (number)))"))))) + +(ert-deftest treesit-cross-boundary () + "Tests for cross-boundary edits. +Cross-boundary means crossing visible_beg and visible_end. We +don't test if parser parses correctly, instead we just check +edits like this don't produce assertion errors. (I inserted a +bunch of assertions that checks e.g. visible_beg <= +visible_end.)" + (skip-unless (treesit-language-available-p 'json)) + (with-temp-buffer + (let (parser) + (progn + (insert "xxx[1,{\"name\": \"Bob\"},2,3]xxx") + (narrow-to-region (+ (point-min) 3) (- (point-max) 3)) + (setq parser (treesit-parser-create 'json)) + ;; Now visible_beg/end = visible boundary. + (treesit-parser-root-node parser)) + ;; Now parser knows the content of the visible region. + (widen) + ;; Now visible_beg/end don't change, but visible region expanded. + (delete-region 1 7) + ;; (1) This change is across visible_beg. I expect + ;; ts_record_change to receive (start=1, old_end=7, new_end=1). + (treesit-parser-root-node parser) + ;; Above form forces a parse which calls + ;; `ts_ensure_position_synced'. Now visible_beg/end matches the + ;; visible region (whole buffer). We want to test that this + ;; doesn't cause assertion error. + + (should (equal "{\"name\": \"Bob\"},2,3]xxx" (buffer-string))) + (narrow-to-region 1 16) + (should (equal "{\"name\": \"Bob\"}" (buffer-string))) + (treesit-parser-root-node parser) + ;; Call `ts_ensure_position_synced' again to update visible_beg/end. + (widen) + (goto-char 14) + (insert "by") + ;; (2) This change is inside [visible_beg, visible_end]. + (should (equal "{\"name\": \"Bobby\"},2,3]xxx" (buffer-string))) + (delete-region 14 23) + ;; This delete is across visible_end. + (should (equal "{\"name\": \"Bobxxx" (buffer-string))) + (treesit-parser-root-node parser) + ;; visible_beg/end synced. + + (narrow-to-region 3 7) + (should (equal "name" (buffer-string))) + (treesit-parser-root-node parser) + ;; visible_beg/end synced. + (widen) + (goto-char (point-min)) + (insert "zzz") + (should (equal "zzz{\"name\": \"Bobxxx" (buffer-string))) + ;; (3) Test inserting before visible_beg. + (treesit-parser-root-node parser) + ;; visible_beg/end synced. + + (narrow-to-region 4 11) + (should (equal "{\"name\"" (buffer-string))) + (treesit-parser-root-node parser) + ;; visible_beg/end synced. + (widen) + (goto-char (point-max)) + (insert "yyy") + ;; (4) This change is after visible_end. + (treesit-parser-root-node parser) + ;; Sync up visible_beg/end. + (should (equal "zzz{\"name\": \"Bobxxxyyy" (buffer-string))) + + (narrow-to-region 1 17) + (should (equal "zzz{\"name\": \"Bob" (buffer-string))) + (treesit-parser-root-node parser) + ;; Sync up visible_beg/end. + (widen) + (delete-region 13 (point-max)) + (treesit-parser-root-node parser) + ;; Sync up visible_beg/end. + (should (equal "zzz{\"name\": " (buffer-string))) + ;; Ideally we want to also test the case where we delete and + ;; insert simultaneously, but the only such use is in + ;; `casify_region', all others either only inserts or only + ;; deletes. I'll leave it to someone to try to write a test + ;; that calls that. + ))) + +(ert-deftest treesit-range () + "Tests if range works." + (skip-unless (treesit-language-available-p 'json)) + (with-temp-buffer + (let (parser) + (progn + (insert "[[1],oooxxx[1,2,3],xxx[1,2]]") + (setq parser (treesit-parser-create 'json)) + (treesit-parser-root-node parser)) + + (should (eq (treesit-parser-included-ranges parser) nil)) + + (should-error + (treesit-parser-set-included-ranges + parser '((1 . 6) (5 . 20))) + :type '(treesit-range-invalid)) + + (treesit-parser-set-included-ranges + parser '((1 . 6) (12 . 20) (23 . 29))) + (should (equal '((1 . 6) (12 . 20) (23 . 29)) + (treesit-parser-included-ranges parser))) + (should (equal "(document (array (array (number)) (array (number) (number) (number)) (array (number) (number))))" + (treesit-node-string + (treesit-parser-root-node parser)))) + + (treesit-parser-set-included-ranges parser nil) + (should (eq (treesit-parser-included-ranges parser) nil)) + + ;; `treesit--merge-ranges'. + (let ((old-ranges '((1 . 10) ; (1) -- before (a) + (20 . 30); (2) -- intersect with (b) + (42 . 46) (47 . 48) ; (3) -- inside (c) + (55 . 65) (70 . 75) ; (4) -- intersect start-end + (80 . 90) ; (4) + )) + (new-ranges '((10 . 15) ; (a) + (18 . 25) (26 . 28) ; (b) + (40 . 50) ; (c) + (90 . 100) ; (d) -- after (4) + )) + (result '((1 . 10) ; (1) + (10 . 15) ; (a) + (18 . 25) (26 . 28) ; (b) + (40 . 50) ; (c) + (80 . 90) ; (4) + (90 . 100) ; (d) + ))) + (should (equal (treesit--merge-ranges + old-ranges new-ranges 60 75) + result))) + ;; TODO: More tests. + ))) + +(ert-deftest treesit-multi-lang () + "Tests if parsing multiple language works." + (skip-unless (and (treesit-language-available-p 'html) + (treesit-language-available-p 'css) + (treesit-language-available-p 'javascript))) + (with-temp-buffer + (let (css js css-range js-range) + (progn + (insert "<html><script>1</script><style>body {}</style></html>") + (treesit-parser-create 'html) + (setq css (treesit-parser-create 'css)) + (setq js (treesit-parser-create 'javascript))) + ;; JavaScript. + (setq js-range + (treesit-query-range + 'html + '((script_element (raw_text) @capture)))) + (should (equal '((15 . 16)) js-range)) + (treesit-parser-set-included-ranges js js-range) + (should (equal "(program (expression_statement (number)))" + (treesit-node-string + (treesit-parser-root-node js)))) + ;; CSS. + (setq css-range + (treesit-query-range + 'html + '((style_element (raw_text) @capture)))) + (should (equal '((32 . 39)) css-range)) + (treesit-parser-set-included-ranges css css-range) + (should + (equal "(stylesheet (rule_set (selectors (tag_name)) (block)))" + (treesit-node-string + (treesit-parser-root-node css)))) + ;; TODO: More tests. + ))) + +(ert-deftest treesit-parser-supplemental () + "Supplemental node functions." + (skip-unless (treesit-language-available-p 'json)) + ;; `treesit-parse-string'. + (should (equal (treesit-node-string + (treesit-parse-string + "[1,2,{\"name\": \"Bob\"},3]" + 'json)) + "(document (array (number) (number) (object (pair key: (string (string_content)) value: (string (string_content)))) (number)))")) + (with-temp-buffer + (let (parser root-node) + (progn + (insert "[1,2,{\"name\": \"Bob\"},3]") + (setq parser (treesit-parser-create 'json)) + (setq root-node (treesit-parser-root-node + parser)) + (treesit-node-child root-node 0)) + ))) + +(ert-deftest treesit-node-supplemental () + "Supplemental node functions." + (skip-unless (treesit-language-available-p 'json)) + (let (parser root-node doc-node) + (progn + (insert "[1,2,{\"name\": \"Bob\"},3]") + (setq parser (treesit-parser-create 'json)) + (setq root-node (treesit-parser-root-node + parser)) + (setq doc-node (treesit-node-child root-node 0))) + ;; `treesit-node-buffer'. + (should (equal (treesit-node-buffer root-node) + (current-buffer))) + ;; `treesit-node-language'. + (should (eq (treesit-node-language root-node) + 'json)) + ;; `treesit-node-at'. + (should (equal (treesit-node-string + (treesit-node-at 1 'json)) + "(\"[\")")) + ;; `treesit-node-on' + (should (equal (treesit-node-string + (treesit-node-on 1 2 'json)) + "(\"[\")")) + ;; `treesit-buffer-root-node'. + (should (treesit-node-eq + (treesit-buffer-root-node 'json) + root-node)) + ;; `treesit-filter-child'. + (should (equal (mapcar + (lambda (node) + (treesit-node-type node)) + (treesit-filter-child + doc-node (lambda (node) + (treesit-node-check node 'named)))) + '("number" "number" "object" "number"))) + ;; `treesit-node-text'. + (should (equal (treesit-node-text doc-node) + "[1,2,{\"name\": \"Bob\"},3]")) + ;; `treesit-node-index'. + (should (eq (treesit-node-index doc-node) + 0)) + ;; TODO: + ;; `treesit-parent-until' + ;; `treesit-parent-while' + ;; `treesit-node-children' + ;; `treesit-node-field-name' + ;; `treesit-search-forward-goto' + )) + +(ert-deftest treesit-node-at () + "Test `treesit-node-at'." + (skip-unless (treesit-language-available-p 'json)) + (let (parser) + (progn + (insert "[1, 2, 3,4] ") + (setq parser (treesit-parser-create 'json)) + (treesit-parser-root-node parser)) + ;; Point at ",", should return ",". + (goto-char (point-min)) + (search-forward "1") + (should (equal (treesit-node-text + (treesit-node-at (point))) + ",")) + ;; Point behind ",", should still return the ",". + (search-forward ",") + (should (equal (treesit-node-text + (treesit-node-at (point))) + ",")) + ;; Point between "," and "2", should return 2. + (forward-char) + (should (equal (treesit-node-text + (treesit-node-at (point))) + "2")) + ;; EOF, should return the last leaf node "]". + (goto-char (point-max)) + (should (equal (treesit-node-text + (treesit-node-at (point))) + "]")))) + +(ert-deftest treesit-node-check () + "Test `treesit-node-check'." + (skip-unless (treesit-language-available-p 'json)) + (let (parser root-node array-node comment-node) + (progn + (insert "/* comment */ [1, 2, 3,4 ") + (setq parser (treesit-parser-create 'json)) + (setq root-node (treesit-parser-root-node + parser)) + (setq comment-node (treesit-node-child root-node 0)) + (setq array-node (treesit-node-child root-node 1))) + + (should (treesit-node-check comment-node 'extra)) + (should (treesit-node-check array-node 'has-error)) + (should-error (treesit-node-check array-node 'xxx)) + (should (treesit-node-check (treesit-node-child array-node -1) + 'missing)) + (goto-char (point-max)) + (insert "]") + (should (treesit-node-check array-node 'outdated)))) + +;; TODO +;; - Functions in treesit.el +;; - treesit-load-name-override-list +;; - treesit-search-subtree +;; - treesit-search-forward +;; - treesit-induce-sparse-tree +;; - treesit-search-forward + + +(provide 'treesit-tests) +;;; treesit-tests.el ends here |