procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from origin/emacs-29

Browse source 
db96b1282f * lisp/help.el: Use 'C-h C-q' to toggle 'help-quick' wind...
489865c21e ; Improve markup of long key sequences
d42c2668cf ; * etc/NEWS: Fix wording of a recently edited entry.
7a0eaee198 * lisp/isearch.el: Small fixes.
b69bffeec0 * lisp/vc/diff-mode.el (diff-minor-mode-prefix): Replace ...
9263847ab7 ; * etc/NEWS: Move the paragraph with 'C-u RET' closer to...
62fb2dc37d * doc/emacs/display.texi (Text Scale): Improve section ab...
70480d3b6b * lisp/repeat.el (repeat-echo-function): Suggest 'add-fun...
fd48201ffe * lisp/tab-line.el (tab-line-cache-key-default): More cac...
b164660260 * etc/package-keyring.gpg: Update with new key
c0be51389e ; Yet another declare-function to avoid treesit-related w...
8676bec51d ; * lisp/treesit.el (treesit--simple-imenu-1): Doc fix; w...
2ddc480f44 Warn of absent networks module in ERC
19d00fab9a Avoid "already compiled" warning in erc-compat
2d8f7b66bc ; Fix one more treesit byte-compilation warning.
2d0a921486 ; Avoid treesit-related byte-compiler warnings
8503b370be (python--treesit-settings): Remove duplicate matcher
b464e6c490 Make last change of w32 GUI dialogs conditional and rever...
eedc9d79ae Fix tree-sitter typos
248c13dcfe Update tree-sitter major modes to use the new Imenu facility
b39dc7ab27 Add tree-sitter helper functions for Imenu
ba1ddea9da Fix treesit--things-around (bug#60355)
7512b9025a ; * lisp/treesit.el (treesit-traverse-parent): Remove alias.
5326b04198 Improve treesit-node-top-level and treesit-parent-until
637f5b164f ; Add "src" to the heuristic sub-directory heuristic
8ab6df0c9f ; * lisp/epa-ks.el (epa-ks-do-key-to-fetch): Fix 'when' u...
2b55a48d3e * src/w32menu.c (simple_dialog_show): Use MB_YESNOCANCEL ...
8b8b791567 ; Improve documentation of TAB/SPC indentation
624e382211 ; Improve doc strings of some new faces
41f12e1019 ; * lisp/elide-head.el (elide-head): Doc fix to silence c...
e3b4cd0ac1 ; * lisp/htmlfontify.el (hfy-text-p): Fix whitespace.
1b4dc4691c Fix htmlfontify.el command injection vulnerability.
1fe4b98b4d Improve support for Scheme R6RS and R7RS libraries (bug#5...
2347f37f67 ; * test/src/treesit-tests.el: remove dead store (bytecom...
a6d961ae2f Add a new tree-sitter query predicate 'pred'
835a80dcc4 ; Fix tree-sitter defun tests
a14821d615 Improve gnutls-min-prime-bits docstring
b14bbd108e Improve handling of tab-bar height.
669160d47b ; * nt/INSTALL.W64: More fixes and updates.
26b2ec7cb8 Simplify last change (bug#60311)
082fc6e308 Fix 'json-available-p' on MS-Windows
6c86faec29 loaddefs-gen: Group results by absolute file name
d90d7d15f2 ; Fix vindexes in parsing.texi
eb26872837 Fix imenu for c-ts-mode (bug#60296)
8f68b6497e Clean up python-ts-mode font-lock features
28f26b11a1 Add comment indent and filling to other tree-sitter major...
c6b0282645 ; Remove unused function in c-ts-mode
6e52a9fcad ; * doc/lispref/modes.texi (Parser-based Font Lock): Mino...
2bcd1e9a99 ; * doc/lispref/parsing.texi (Retrieving Nodes): Add notice.
7c7950fe00 Add maintainer stub for tree-sitter files
cf32776622 ; * doc/lispref/parsing.texi (Using Parser): Remove delet...

# Conflicts:
#	etc/NEWS
#	lisp/progmodes/c-ts-mode.el
#	lisp/progmodes/typescript-ts-mode.el
#	lisp/treesit.el
This commit is contained in:
Stefan Kangas 2022-12-28 21:40:59 +01:00
commit dce6791e99
50 changed files with 945 additions and 813 deletions
Download patch file Download diff file Expand all files Collapse all files

12
doc/emacs/display.texi
View file

@ -920,12 +920,12 @@ decrease the font size of the affected faces, depending on the
direction of the scrolling. direction of the scrolling.
The final key of these commands may be repeated without the leading The final key of these commands may be repeated without the leading
@kbd{C-x}. For instance, @kbd{C-x C-= C-= C-=} increases the face @kbd{C-x} and without the modifiers. For instance, @w{@kbd{C-x C-= C-= C-=}}
height by three steps. Each step scales the text height by a factor and @w{@kbd{C-x C-= = =}} increase the face height by three steps. Each
of 1.2; to change this factor, customize the variable step scales the text height by a factor of 1.2; to change this factor,
@code{text-scale-mode-step}. A numeric argument of 0 customize the variable @code{text-scale-mode-step}. A numeric
to the @code{text-scale-adjust} command restores the default height, argument of 0 to the @code{text-scale-adjust} command restores the
the same as typing @kbd{C-x C-0}. default height, the same as typing @kbd{C-x C-0}.
@cindex adjust global font size @cindex adjust global font size
@findex global-text-scale-adjust @findex global-text-scale-adjust

35
doc/lispref/modes.texi
View file

@ -2841,6 +2841,35 @@ function uses @code{imenu-generic-expression} instead.
Setting this variable makes it buffer-local in the current buffer. Setting this variable makes it buffer-local in the current buffer.
@end defvar @end defvar
If built with tree-sitter, Emacs can automatically generate an Imenu
index if the major mode sets relevant variables.
@defvar treesit-simple-imenu-settings
This variable instructs Emacs how to generate Imenu indexes. It
should be a list of @w{(@var{category} @var{regexp} @var{pred}
@var{name-fn})}.
@var{category} should be the name of a category, like "Function",
"Class", etc. @var{regexp} should be a regexp matching the type of
nodes that belong to @var{category}. @var{pred} should be either
@code{nil} or a function that takes a node as the argument. It should
return non-@code{nil} if the node is a valid node for @var{category},
or @code{nil} if not.
@var{category} could also be @code{nil}. In which case the entries
matched by @var{regexp} and @var{pred} are not grouped under
@var{category}.
@var{name-fn} should be either @var{nil} or a function that takes a
defun node and returns the name of that defun, e.g., the function name
for a function definition. If @var{name-fn} is @var{nil},
@code{treesit-defun-name} (@pxref{Tree-sitter major modes}) is used
instead.
@code{treesit-major-mode-setup} (@pxref{Tree-sitter major modes})
automatically sets up Imenu if this variable is non-@code{nil}.
@end defvar
@node Font Lock Mode @node Font Lock Mode
@section Font Lock Mode @section Font Lock Mode
@cindex Font Lock mode @cindex Font Lock mode
@ -4023,11 +4052,12 @@ This function takes a series of @var{query-spec}s, where each
@var{:keyword}/@var{value} pairs. Each @var{query} is a @var{:keyword}/@var{value} pairs. Each @var{query} is a
tree-sitter query in either the string, s-expression or compiled form. tree-sitter query in either the string, s-expression or compiled form.
@c FIXME: Cross-ref treesit-font-lock-level to user manual.
For each @var{query}, the @var{:keyword}/@var{value} pairs that For each @var{query}, the @var{:keyword}/@var{value} pairs that
precede it add meta information to it. The @code{:lang} keyword precede it add meta information to it. The @code{:lang} keyword
declares @var{query}'s language. The @code{:feature} keyword sets the declares @var{query}'s language. The @code{:feature} keyword sets the
feature name of @var{query}. Users can control which features are feature name of @var{query}. Users can control which features are
enabled with @code{font-lock-maximum-decoration} and enabled with @code{treesit-font-lock-level} and
@code{treesit-font-lock-feature-list} (described below). These two @code{treesit-font-lock-feature-list} (described below). These two
keywords are mandatory. keywords are mandatory.
@ -4067,10 +4097,11 @@ priority. If a capture name is neither a face nor a function, it is
ignored. ignored.
@end defun @end defun
@c FIXME: Cross-ref treesit-font-lock-level to user manual.
@defvar treesit-font-lock-feature-list @defvar treesit-font-lock-feature-list
This is a list of lists of feature symbols. Each element of the list This is a list of lists of feature symbols. Each element of the list
is a list that represents a decoration level. is a list that represents a decoration level.
@code{font-lock-maximum-decoration} controls which levels are @code{treesit-font-lock-level} controls which levels are
activated. activated.
Each element of the list is a list of the form @w{@code{(@var{feature} Each element of the list is a list of the form @w{@code{(@var{feature}

50
doc/lispref/parsing.texi
View file

@ -393,12 +393,6 @@ tree-sitter can be activated. Major modes should check this value
when deciding whether to enable tree-sitter features. when deciding whether to enable tree-sitter features.
@end defvar @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 creating tree-sitter parsers
@cindex tree-sitter parser, creating @cindex tree-sitter parser, creating
@defun treesit-parser-create language &optional buffer no-reuse @defun treesit-parser-create language &optional buffer no-reuse
@ -649,6 +643,10 @@ it, or query for information about this node.
@defun treesit-node-parent node @defun treesit-node-parent node
This function returns the immediate parent of @var{node}. This function returns the immediate parent of @var{node}.
If @var{node} is more than 1000 levels deep in a parse tree, the
return value is undefined. Currently it returns @var{nil}, but that
could change in the future.
@end defun @end defun
@defun treesit-node-child node n &optional named @defun treesit-node-child node n &optional named
@ -1268,10 +1266,11 @@ example, with the following pattern:
@end example @end example
@noindent @noindent
tree-sitter only matches arrays where the first element equals to tree-sitter only matches arrays where the first element equals to the
the last element. To attach a predicate to a pattern, we need to last element. To attach a predicate to a pattern, we need to group
group them together. A predicate always starts with a @samp{#}. them together. A predicate always starts with a @samp{#}. Currently
Currently there are two predicates, @code{#equal} and @code{#match}. there are three predicates, @code{#equal}, @code{#match}, and
@code{#pred}.
@deffn Predicate equal arg1 arg2 @deffn Predicate equal arg1 arg2
Matches if @var{arg1} equals to @var{arg2}. Arguments can be either Matches if @var{arg1} equals to @var{arg2}. Arguments can be either
@ -1284,6 +1283,11 @@ Matches if the text that @var{capture-name}'s node spans in the buffer
matches regular expression @var{regexp}. Matching is case-sensitive. matches regular expression @var{regexp}. Matching is case-sensitive.
@end deffn @end deffn
@deffn Predicate pred fn &rest nodes
Matches if function @var{fn} returns non-@code{nil} when passed each
node in @var{nodes} as arguments.
@end deffn
Note that a predicate can only refer to capture names that appear in 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 the same pattern. Indeed, it makes little sense to refer to capture
names in other patterns. names in other patterns.
@ -1717,17 +1721,14 @@ This function activates some tree-sitter features for a major mode.
Currently, it sets up the following features: Currently, it sets up the following features:
@itemize @itemize
@vindex treesit-font-lock-settings
@item @item
If @code{treesit-font-lock-settings} is non-@code{nil}, it sets up If @code{treesit-font-lock-settings} (@pxref{Parser-based Font Lock})
fontification. is non-@code{nil}, it sets up fontification.
@vindex treesit-simple-indent-rules
@item @item
If @code{treesit-simple-indent-rules} is non-@code{nil}, it sets up If @code{treesit-simple-indent-rules} (@pxref{Parser-based Font Lock})
indentation. is non-@code{nil}, it sets up indentation.
@vindex treesit-defun-type-regexp
@item @item
If @code{treesit-defun-type-regexp} is non-@code{nil}, it sets up If @code{treesit-defun-type-regexp} is non-@code{nil}, it sets up
navigation functions for @code{beginning-of-defun} and navigation functions for @code{beginning-of-defun} and
@ -1736,6 +1737,10 @@ navigation functions for @code{beginning-of-defun} and
@item @item
If @code{treesit-defun-name-function} is non-@code{nil}, it sets up If @code{treesit-defun-name-function} is non-@code{nil}, it sets up
add-log functions used by @code{add-log-current-defun}. add-log functions used by @code{add-log-current-defun}.
@item
If @code{treesit-simple-imenu-settings} (@pxref{Imenu}) is
non-@code{nil}, it sets up Imenu.
@end itemize @end itemize
@end defun @end defun
@ -1784,6 +1789,17 @@ node is a defun node but doesn't have a name, or the node is
@code{nil}, it should return @code{nil}. @code{nil}, it should return @code{nil}.
@end defvar @end defvar
@defvar treesit-defun-type-regexp
This variable determines which nodes are considered defuns by Emacs.
It can be a regexp that matches the type of defun nodes.
Sometimes not all nodes matched by the regexp are valid defuns.
Therefore, this variable can also be a cons cell of the form
@w{(@var{regexp} . @var{pred})}, where @var{pred} should be a function
that takes a node as its argument, and returns @code{t} if the node is
valid defun, or @code{nil} if it is not valid.
@end defvar
@node Tree-sitter C API @node Tree-sitter C API
@section Tree-sitter C API Correspondence @section Tree-sitter C API Correspondence

12
doc/misc/erc.texi
View file

@ -529,6 +529,16 @@ Translate morse code in messages
@end table @end table
@anchor{Required Modules}
@subheading Required Modules
@cindex required modules
Note that some modules are essential to core IRC operations and thus
not listed above. You can nevertheless still remove these, but doing
so demands special precautions to avoid degrading the user experience.
At present, the only such module is @code{networks}, whose library ERC
always loads anyway.
@subheading Local Modules @subheading Local Modules
@cindex local modules @cindex local modules
@ -1290,7 +1300,7 @@ When preparing entries for your backend, it may help to get a feel for
how ERC and its modules conduct searches, especially when exploring a how ERC and its modules conduct searches, especially when exploring a
new context, such as channel keys. (Hint: in such situations, try new context, such as channel keys. (Hint: in such situations, try
temporarily setting the variable @code{auth-source-debug} to @code{t} temporarily setting the variable @code{auth-source-debug} to @code{t}
and checking @samp{*Messages*} periodically for insights into how and checking @file{*Messages*} periodically for insights into how
auth-source is operating.) Overall, though, ERC tries to be auth-source is operating.) Overall, though, ERC tries to be
consistent in performing queries across various authentication consistent in performing queries across various authentication
contexts. Here's what to expect with respect to the @samp{host} contexts. Here's what to expect with respect to the @samp{host}

11
etc/ERC-NEWS
View file

@ -39,6 +39,14 @@ anew. The pre-5.4 "disabled" behavior has been restored and will
remain accessible for the foreseeable future, warts and all (e.g., remain accessible for the foreseeable future, warts and all (e.g.,
with its often superfluous "/DIALED-HOST" suffixing always present). with its often superfluous "/DIALED-HOST" suffixing always present).
** The 'networks' module is now quasi-required.
The 'networks' module is now all but required for everyday interactive
use. A default member of 'erc-modules' since ERC 5.3, 'networks' has
grown increasingly integral to core client operations over the years.
From now on, only the most essential operations will be officially
supported in its absence, and users will see a warning upon
entry-point invocation when it's not present.
** Tighter auth-source integration with bigger changes on the horizon. ** Tighter auth-source integration with bigger changes on the horizon.
The days of hit-and-miss auth-source queries are hopefully behind us. The days of hit-and-miss auth-source queries are hopefully behind us.
With the overhaul of the services module temporarily shelved and the With the overhaul of the services module temporarily shelved and the
@ -111,7 +119,8 @@ and 'erc-backend'.
The function 'erc-network' always returns non-nil in server and target The function 'erc-network' always returns non-nil in server and target
buffers belonging to a successfully established IRC connection, even buffers belonging to a successfully established IRC connection, even
after that connection has been closed. after that connection has been closed. (Also see the note in the
section above about the 'networks' module basically being mandatory.)
In 5.4, support for network symbols as keys was added for In 5.4, support for network symbols as keys was added for
'erc-autojoin-channels-alist'. This has been extended to include 'erc-autojoin-channels-alist'. This has been extended to include

38
etc/NEWS.29
View file

@ -1077,7 +1077,7 @@ the default candidate.
*** New command 'help-quick' displays an overview of common commands. *** New command 'help-quick' displays an overview of common commands.
The command pops up a buffer at the bottom of the screen with a few The command pops up a buffer at the bottom of the screen with a few
helpful commands for various tasks. You can toggle the display using helpful commands for various tasks. You can toggle the display using
'C-h q'. 'C-h C-q'.
** Emacs now comes with Org v9.6. ** Emacs now comes with Org v9.6.
See the file ORG-NEWS for user-visible changes in Org. See the file ORG-NEWS for user-visible changes in Org.
@ -1103,7 +1103,7 @@ in addition to the ellipsis. The default is nil, but in 'help-mode'
it has the value 'insert' that inserts the buttons directly into the it has the value 'insert' that inserts the buttons directly into the
buffer, and you can use 'RET' to cycle outline visibility. When buffer, and you can use 'RET' to cycle outline visibility. When
the value is 'in-margins', Outline Minor Mode uses the window margins the value is 'in-margins', Outline Minor Mode uses the window margins
to hide/show buttons. for buttons that hide/show outlines.
** Windows ** Windows
@ -1874,6 +1874,12 @@ exit the minibuffer. These keys are also available for in-buffer
completion, but they don't insert candidates automatically, you need completion, but they don't insert candidates automatically, you need
to type 'M-RET' to insert the selected candidate to the buffer. to type 'M-RET' to insert the selected candidate to the buffer.
+++
*** Choosing a completion with a prefix argument doesn't exit the minibuffer.
This means that typing 'C-u RET' on a completion candidate in the
"*Completions*" buffer inserts the completion into the minibuffer,
but doesn't exit the minibuffer.
+++ +++
*** The "*Completions*" buffer can now be automatically selected. *** The "*Completions*" buffer can now be automatically selected.
To enable this behavior, customize the user option To enable this behavior, customize the user option
@ -1932,12 +1938,6 @@ candidate in the "*Completions*" buffer is highlighted with that face.
The nil value disables this highlighting. The default is to highlight The nil value disables this highlighting. The default is to highlight
using the 'completions-highlight' face. using the 'completions-highlight' face.
+++
*** Choosing a completion with a prefix argument doesn't exit the minibuffer.
This means that typing 'C-u RET' on a completion candidate in the
"*Completions*" buffer inserts the completion to the minibuffer,
but doesn't exit the minibuffer.
+++ +++
*** You can now define abbrevs for the minibuffer modes. *** You can now define abbrevs for the minibuffer modes.
'minibuffer-mode-abbrev-table' and 'minibuffer-mode-abbrev-table' and
@ -3055,6 +3055,19 @@ name.
This key is now bound to 'Buffer-menu-view-other-window', which will This key is now bound to 'Buffer-menu-view-other-window', which will
view this line's buffer in View mode in another window. view this line's buffer in View mode in another window.
** Scheme mode
---
*** Auto-detection of Scheme library files.
Emacs now automatically enables the Scheme mode when opening R6RS
Scheme Library Source ('.sls') files and R7RS Scheme Library
Definition ('.sld') files.
---
*** Imenu members for R6RS and R7RS library members.
Imenu now lists the members directly nested in R6RS Scheme libraries
('library') and R7RS libraries ('define-library').
* New Modes and Packages in Emacs 29.1 * New Modes and Packages in Emacs 29.1
@ -4688,6 +4701,15 @@ where those APIs are available.
When 'w32-use-native-image-API' is non-nil, Emacs on MS-Windows now When 'w32-use-native-image-API' is non-nil, Emacs on MS-Windows now
has built-in support for displaying BMP images. has built-in support for displaying BMP images.
---
*** GUI Yes/No dialogs now include a "Cancel" button.
The "Cancel" button is in addition to "Yes" and "No", and is intended
to allow users to quit the dialog, as an equivalent of C-g when Emacs
asks a yes/no question via the echo area. This is controlled by the
new variable 'w32-yes-no-dialog-show-cancel', by default t. Set it to
nil to get back the old behavior of showing a modal dialog with only
two buttons: "Yes" and "No".
** Cygwin ** Cygwin
--- ---

BIN
etc/package-keyring.gpg
View file

Binary file not shown.

7
lisp/elide-head.el
View file

@ -164,10 +164,11 @@ mode hooks."
(defun elide-head (&optional arg) (defun elide-head (&optional arg)
"Hide header material in buffer according to `elide-head-headers-to-hide'. "Hide header material in buffer according to `elide-head-headers-to-hide'.
The header is made invisible with an overlay. With a prefix arg, show The header is made invisible with an overlay. With a prefix
an elided material again. argument ARG, show an elided material again.
This is suitable as an entry on `find-file-hook' or appropriate mode hooks." This is suitable as an entry on `find-file-hook' or appropriate
mode hooks."
(declare (obsolete elide-head-mode "29.1")) (declare (obsolete elide-head-mode "29.1"))
(interactive "P") (interactive "P")
(if arg (if arg

3
lisp/emacs-lisp/loaddefs-gen.el
View file

@ -608,7 +608,8 @@ instead of just updating them with the new/changed autoloads."
(write-region (point-min) (point-max) output-file nil 'silent)) (write-region (point-min) (point-max) output-file nil 'silent))
;; We have some data, so generate the loaddef files. First ;; We have some data, so generate the loaddef files. First
;; group per output file. ;; group per output file.
(dolist (fdefs (seq-group-by #'car defs)) (dolist (fdefs (seq-group-by (lambda (x) (expand-file-name (car x)))
defs))
(let ((loaddefs-file (car fdefs)) (let ((loaddefs-file (car fdefs))
hash) hash)
(with-temp-buffer (with-temp-buffer

27
lisp/emacs-lisp/package-vc.el
View file

@ -613,18 +613,21 @@ checkout. This overrides the `:branch' attribute in PKG-SPEC."
;; When nothing is specified about a `lisp-dir', then should ;; When nothing is specified about a `lisp-dir', then should
;; heuristically check if there is a sub-directory with lisp ;; heuristically check if there is a sub-directory with lisp
;; files. These are conventionally just called "lisp". If this ;; files. These are conventionally just called "lisp" or "src".
;; directory exists and contains non-zero number of lisp files, we ;; If this directory exists and contains non-zero number of lisp
;; will use that instead of `pkg-dir'. ;; files, we will use that instead of `pkg-dir'.
(when-let* (((null lisp-dir)) (catch 'done
(dir (expand-file-name "lisp" pkg-dir)) (dolist (name '("lisp" "src"))
((file-directory-p dir)) (when-let* (((null lisp-dir))
((directory-files dir nil "\\`[^.].+\\.el\\'" t 1))) (dir (expand-file-name name pkg-dir))
;; We won't use `dir', since dir is an absolute path and we ((file-directory-p dir))
;; don't want `lisp-dir' to depend on the current location of ((directory-files dir nil "\\`[^.].+\\.el\\'" t 1)))
;; the package installation, ie. to break if moved around the ;; We won't use `dir', since dir is an absolute path and we
;; file system or between installations. ;; don't want `lisp-dir' to depend on the current location of
(setq lisp-dir "lisp")) ;; the package installation, ie. to break if moved around the
;; file system or between installations.
(throw 'done (setq lisp-dir name)))))
(when lisp-dir (when lisp-dir
(push (cons :lisp-dir lisp-dir) (push (cons :lisp-dir lisp-dir)
(package-desc-extras pkg-desc))) (package-desc-extras pkg-desc)))

6
lisp/epa-ks.el
View file

@ -135,9 +135,9 @@ Keys are marked using `epa-ks-mark-key-to-fetch'."
keys)) keys))
(forward-line)) (forward-line))
(when (yes-or-no-p (format "Proceed with fetching all %d key(s)? " (when (yes-or-no-p (format "Proceed with fetching all %d key(s)? "
(length keys)))) (length keys)))
(dolist (id keys) (dolist (id keys)
(epa-ks--fetch-key id)))) (epa-ks--fetch-key id)))))
(tabulated-list-clear-all-tags)) (tabulated-list-clear-all-tags))
(defun epa-ks--query-url (query exact) (defun epa-ks--query-url (query exact)

10
lisp/erc/erc-backend.el
View file

@ -320,6 +320,15 @@ session when reconnecting. Once `erc-reuse-buffers' is retired
and fully removed, modules can switch to leveraging the and fully removed, modules can switch to leveraging the
`permanent-local' property instead.") `permanent-local' property instead.")
(defvar erc--server-post-connect-hook '(erc-networks--warn-on-connect)
"Functions to run when a network connection is successfully opened.
Though internal, this complements `erc-connect-pre-hook' in that
it bookends the process rather than the logical connection, which
is the domain of `erc-before-connect' and `erc-after-connect'.
Note that unlike `erc-connect-pre-hook', this only runs in server
buffers, and it does so immediately before the first protocol
exchange.")
(defvar-local erc-server-timed-out nil (defvar-local erc-server-timed-out nil
"Non-nil if the IRC server failed to respond to a ping.") "Non-nil if the IRC server failed to respond to a ping.")
@ -646,6 +655,7 @@ The current buffer is given by BUFFER."
(cl-defmethod erc--register-connection () (cl-defmethod erc--register-connection ()
"Perform opening IRC protocol exchange with server." "Perform opening IRC protocol exchange with server."
(run-hooks 'erc--server-post-connect-hook)
(erc-login)) (erc-login))
(defvar erc--server-connect-dumb-ipv6-regexp (defvar erc--server-connect-dumb-ipv6-regexp

2
lisp/erc/erc-compat.el
View file

@ -261,7 +261,7 @@ If START or END is negative, it counts from the end."
(when-let* ((s (plist-get e :secret)) (when-let* ((s (plist-get e :secret))
(v (auth-source--obfuscate s))) (v (auth-source--obfuscate s)))
(setf (plist-get e :secret) (setf (plist-get e :secret)
(byte-compile (lambda () (auth-source--deobfuscate v))))) (apply-partially #'auth-source--deobfuscate v)))
(push e out))) (push e out)))
rv))) rv)))

26
lisp/erc/erc-networks.el
View file

@ -1472,14 +1472,16 @@ to be a false alarm. If `erc-reuse-buffers' is nil, let
(t (rename-buffer (generate-new-buffer-name name))))) (t (rename-buffer (generate-new-buffer-name name)))))
nil) nil)
;; Soju v0.4.0 only sends ISUPPORT on upstream reconnect, so this ;; Soju v0.4.0 sends ISUPPORT and nothing else on upstream reconnect,
;; doesn't apply. ZNC 1.8.2, however, still sends the entire burst. ;; so this actually doesn't apply. ZNC 1.8.2, however, still sends
(defconst erc-networks--bouncer-targets '(*status bouncerserv) ;; the entire burst.
"Case-mapped symbols matching known bouncer service-bot targets.") (defvar erc-networks--bouncer-targets '(*status bouncerserv)
"Symbols matching proxy-bot targets.")
(defun erc-networks-on-MOTD-end (proc parsed) (defun erc-networks-on-MOTD-end (proc parsed)
"Call on-connect functions with server PROC and PARSED message. "Call on-connect functions with server PROC and PARSED message."
This must run before `erc-server-connected' is set." ;; This should normally run before `erc-server-connected' is set.
;; However, bouncers and other proxies may interfere with that.
(when erc-server-connected (when erc-server-connected
(unless (erc-buffer-filter (lambda () (unless (erc-buffer-filter (lambda ()
(and erc--target (and erc--target
@ -1502,6 +1504,18 @@ This must run before `erc-server-connected' is set."
((remove-hook 'erc-server-376-functions #'erc-networks-on-MOTD-end) ((remove-hook 'erc-server-376-functions #'erc-networks-on-MOTD-end)
(remove-hook 'erc-server-422-functions #'erc-networks-on-MOTD-end))) (remove-hook 'erc-server-422-functions #'erc-networks-on-MOTD-end)))
(defun erc-networks--warn-on-connect ()
"Emit warning when the `networks' module hasn't been loaded.
Ideally, do so upon opening the network process."
(unless (or erc--target erc-networks-mode)
(require 'info nil t)
(let ((m (concat "Required module `networks' not loaded. If this "
" was unexpected, please add it to `erc-modules'.")))
;; Assume the server buffer has been marked as active.
(erc-display-error-notice
nil (concat m " See Info:\"(erc) Required Modules\" for more."))
(lwarn 'erc :warning m))))
(defun erc-ports-list (ports) (defun erc-ports-list (ports)
"Return a list of PORTS. "Return a list of PORTS.

2
lisp/erc/erc-sasl.el
View file

@ -435,7 +435,7 @@ Otherwise, expect it to disappear in subsequent versions.")
(if (eq :user (alist-get 'user erc-sasl--options)) (if (eq :user (alist-get 'user erc-sasl--options))
(erc-current-nick) (erc-current-nick)
erc-session-username))) erc-session-username)))
(erc-login)) (cl-call-next-method))
(when erc-sasl--send-cap-ls (when erc-sasl--send-cap-ls
(erc-server-send "CAP REQ :sasl")) (erc-server-send "CAP REQ :sasl"))
(erc-server-send (format "AUTHENTICATE %s" m))) (erc-server-send (format "AUTHENTICATE %s" m)))

6
lisp/erc/erc.el
View file

@ -1607,7 +1607,8 @@ same manner."
(when target ; compat (when target ; compat
(setq tgt-info (erc--target-from-string target))) (setq tgt-info (erc--target-from-string target)))
(if tgt-info (if tgt-info
(let* ((esid (erc-networks--id-symbol erc-networks--id)) (let* ((esid (and erc-networks--id
(erc-networks--id-symbol erc-networks--id)))
(name (if esid (name (if esid
(erc-networks--reconcile-buffer-names tgt-info (erc-networks--reconcile-buffer-names tgt-info
erc-networks--id) erc-networks--id)
@ -6760,7 +6761,8 @@ This should be a string with substitution variables recognized by
If the name of the network is not available, then use the If the name of the network is not available, then use the
shortened server name instead." shortened server name instead."
(if-let ((erc--target) (if-let ((erc--target)
(name (if-let ((esid (erc-networks--id-symbol erc-networks--id))) (name (if-let ((erc-networks--id)
(esid (erc-networks--id-symbol erc-networks--id)))
(symbol-name esid) (symbol-name esid)
(erc-shorten-server-name (or erc-server-announced-name (erc-shorten-server-name (or erc-server-announced-name
erc-session-server))))) erc-session-server)))))

2
lisp/files.el
View file

@ -2850,7 +2850,7 @@ since only a single case-insensitive search through the alist is made."
("\\.emacs-places\\'" . lisp-data-mode) ("\\.emacs-places\\'" . lisp-data-mode)
("\\.el\\'" . emacs-lisp-mode) ("\\.el\\'" . emacs-lisp-mode)
("Project\\.ede\\'" . emacs-lisp-mode) ("Project\\.ede\\'" . emacs-lisp-mode)
("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode) ("\\.\\(scm\\|sls\\|sld\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
("\\.l\\'" . lisp-mode) ("\\.l\\'" . lisp-mode)
("\\.li?sp\\'" . lisp-mode) ("\\.li?sp\\'" . lisp-mode)
("\\.[fF]\\'" . fortran-mode) ("\\.[fF]\\'" . fortran-mode)

6
lisp/font-lock.el
View file

@ -2110,7 +2110,7 @@ For example, the declaration and use of fields in a struct."
(defface font-lock-punctuation-face (defface font-lock-punctuation-face
'((t nil)) '((t nil))
"Font Lock mode face used to highlight punctuation." "Font Lock mode face used to highlight punctuation characters."
:group 'font-lock-faces :group 'font-lock-faces
:version "29.1") :version "29.1")
@ -2122,7 +2122,9 @@ For example, the declaration and use of fields in a struct."
(defface font-lock-delimiter-face (defface font-lock-delimiter-face
'((t :inherit font-lock-punctuation-face)) '((t :inherit font-lock-punctuation-face))
"Font Lock mode face used to highlight delimiters." "Font Lock mode face used to highlight delimiters.
What exactly is a delimiter depends on the major mode, but usually
these are characters like comma, colon, and semi-colon."
:group 'font-lock-faces :group 'font-lock-faces
:version "29.1") :version "29.1")

32
lisp/help.el
View file

@ -76,6 +76,7 @@ buffer.")
"C-n" #'view-emacs-news "C-n" #'view-emacs-news
"C-o" #'describe-distribution "C-o" #'describe-distribution
"C-p" #'view-emacs-problems "C-p" #'view-emacs-problems
"C-q" #'help-quick-toggle
"C-s" #'search-forward-help-for-help "C-s" #'search-forward-help-for-help
"C-t" #'view-emacs-todo "C-t" #'view-emacs-todo
"C-w" #'describe-no-warranty "C-w" #'describe-no-warranty
@ -116,7 +117,7 @@ buffer.")
"v" #'describe-variable "v" #'describe-variable
"w" #'where-is "w" #'where-is
"x" #'describe-command "x" #'describe-command
"q" #'help-quit-or-quick) "q" #'help-quit)
(define-key global-map (char-to-string help-char) 'help-command) (define-key global-map (char-to-string help-char) 'help-command)
(define-key global-map [help] 'help-command) (define-key global-map [help] 'help-command)
@ -243,7 +244,17 @@ buffer.")
;; ... and shrink it immediately. ;; ... and shrink it immediately.
(fit-window-to-buffer)) (fit-window-to-buffer))
(message (message
(substitute-command-keys "Toggle the quick help buffer using \\[help-quit-or-quick].")))) (substitute-command-keys "Toggle the quick help buffer using \\[help-quick-toggle]."))))
(defun help-quick-toggle ()
"Toggle the quick-help window."
(interactive)
(if (and-let* ((window (get-buffer-window "*Quick Help*")))
(quit-window t window))
;; Clear the message we may have gotten from `C-h' and then
;; waiting before hitting `q'.
(message "")
(help-quick)))
(defalias 'cheat-sheet #'help-quick) (defalias 'cheat-sheet #'help-quick)
@ -252,21 +263,6 @@ buffer.")
(interactive) (interactive)
nil) nil)
(defun help-quit-or-quick ()
"Call `help-quit' or `help-quick' depending on the context."
(interactive)
(cond
(help-buffer-under-preparation
;; FIXME: There should be a better way to detect if we are in the
;; help command loop.
(help-quit))
((and-let* ((window (get-buffer-window "*Quick Help*")))
(quit-window t window)
;; Clear the message we may have gotten from `C-h' and then
;; waiting before hitting `q'.
(message "")))
((help-quick))))
(defvar help-return-method nil (defvar help-return-method nil
"What to do to \"exit\" the help buffer. "What to do to \"exit\" the help buffer.
This is a list This is a list
@ -416,7 +412,7 @@ Do not call this in the scope of `with-help-window'."
("describe-package" "Describe a specific Emacs package") ("describe-package" "Describe a specific Emacs package")
"" ""
("help-with-tutorial" "Start the Emacs tutorial") ("help-with-tutorial" "Start the Emacs tutorial")
("help-quick-or-quit" "Display the quick help buffer.") ("help-quick-toggle" "Display the quick help buffer.")
("view-echo-area-messages" ("view-echo-area-messages"
"Show recent messages (from echo area)") "Show recent messages (from echo area)")
("view-lossage" ,(format "Show last %d input keystrokes (lossage)" ("view-lossage" ,(format "Show last %d input keystrokes (lossage)"

5
lisp/htmlfontify.el
View file

@ -1850,8 +1850,9 @@ Hardly bombproof, but good enough in the context in which it is being used."
(defun hfy-text-p (srcdir file) (defun hfy-text-p (srcdir file)
"Is SRCDIR/FILE text? Use `hfy-istext-command' to determine this." "Is SRCDIR/FILE text? Use `hfy-istext-command' to determine this."
(let* ((cmd (format hfy-istext-command (expand-file-name file srcdir))) (let* ((cmd (format hfy-istext-command
(rsp (shell-command-to-string cmd))) (shell-quote-argument (expand-file-name file srcdir))))
(rsp (shell-command-to-string cmd)))
(string-match "text" rsp))) (string-match "text" rsp)))
;; open a file, check fontification, if fontified, write a fontified copy ;; open a file, check fontification, if fontified, write a fontified copy

3
lisp/indent.el
View file

@ -784,7 +784,8 @@ If PREV is non-nil, return the previous one instead."
(defun tab-to-tab-stop () (defun tab-to-tab-stop ()
"Insert spaces or tabs to next defined tab-stop column. "Insert spaces or tabs to next defined tab-stop column.
The variable `tab-stop-list' is a list of columns at which there are tab stops. The variable `tab-stop-list' is a list of columns at which there are tab stops.
Use \\[edit-tab-stops] to edit them interactively." Use \\[edit-tab-stops] to edit them interactively.
Whether this inserts tabs or spaces depends on `indent-tabs-mode'."
(interactive) (interactive)
(and abbrev-mode (= (char-syntax (preceding-char)) ?w) (and abbrev-mode (= (char-syntax (preceding-char)) ?w)
(expand-abbrev)) (expand-abbrev))

13
lisp/isearch.el
View file

@ -181,7 +181,9 @@ When t (by default), signal an error when no more matches are found.
Then after repeating the search, wrap with `isearch-wrap-function'. Then after repeating the search, wrap with `isearch-wrap-function'.
When `no', wrap immediately after reaching the last match. When `no', wrap immediately after reaching the last match.
When `no-ding', wrap immediately without flashing the screen. When `no-ding', wrap immediately without flashing the screen.
When nil, never wrap, just stop at the last match." When nil, never wrap, just stop at the last match.
With the values `no' and `no-ding' the search will try
to wrap around also on typing a character."
:type '(choice (const :tag "Pause before wrapping" t) :type '(choice (const :tag "Pause before wrapping" t)
(const :tag "No pause before wrapping" no) (const :tag "No pause before wrapping" no)
(const :tag "No pause and no flashing" no-ding) (const :tag "No pause and no flashing" no-ding)
@ -880,6 +882,7 @@ matches literally, against one space. You can toggle the value of this
variable by the command `isearch-toggle-lax-whitespace', usually bound to variable by the command `isearch-toggle-lax-whitespace', usually bound to
`M-s SPC' during isearch." `M-s SPC' during isearch."
:type 'boolean :type 'boolean
:group 'isearch
:version "25.1") :version "25.1")
(defvar isearch-regexp-lax-whitespace nil (defvar isearch-regexp-lax-whitespace nil
@ -1179,6 +1182,7 @@ Each element of the list should be one of the symbols supported by
`isearch-forward-thing-at-point' to yank the initial \"thing\" `isearch-forward-thing-at-point' to yank the initial \"thing\"
as text to the search string." as text to the search string."
:type '(repeat (symbol :tag "Thing symbol")) :type '(repeat (symbol :tag "Thing symbol"))
:group 'isearch
:version "28.1") :version "28.1")
(defun isearch-forward-thing-at-point () (defun isearch-forward-thing-at-point ()
@ -2525,10 +2529,11 @@ If no input items have been entered yet, just beep."
(ding) (ding)
(isearch-pop-state)) (isearch-pop-state))
;; When going back to the hidden match, reopen it and close other overlays. ;; When going back to the hidden match, reopen it and close other overlays.
(when (and (eq search-invisible 'open) isearch-hide-immediately) (when (and (eq isearch-invisible 'open) isearch-hide-immediately)
(if isearch-other-end (if isearch-other-end
(isearch-range-invisible (min (point) isearch-other-end) (let ((search-invisible isearch-invisible))
(max (point) isearch-other-end)) (isearch-range-invisible (min (point) isearch-other-end)
(max (point) isearch-other-end)))
(isearch-close-unnecessary-overlays (point) (point)))) (isearch-close-unnecessary-overlays (point) (point))))
(isearch-update)) (isearch-update))

5
lisp/net/gnutls.el
View file

@ -128,10 +128,7 @@ key exchange is against man-in-the-middle attacks.)
A value of nil says to use the default GnuTLS value. A value of nil says to use the default GnuTLS value.
The default value of this variable is such that virtually any Emacs network security is handled at a higher level via
connection can be established, whether this connection can be
considered cryptographically \"safe\" or not. However, Emacs
network security is handled at a higher level via
`open-network-stream' and the Network Security Manager. See Info `open-network-stream' and the Network Security Manager. See Info
node `(emacs) Network Security'." node `(emacs) Network Security'."
:type '(choice (const :tag "Use default value" nil) :type '(choice (const :tag "Use default value" nil)

230
lisp/progmodes/c-ts-mode.el
View file

@ -487,92 +487,44 @@ For NODE, OVERRIDE, START, and END, see
(defun c-ts-mode--defun-name (node) (defun c-ts-mode--defun-name (node)
"Return the name of the defun NODE. "Return the name of the defun NODE.
Return nil if NODE is not a defun node, return an empty string if Return nil if NODE is not a defun node or doesn't have a name."
NODE doesn't have a name."
(treesit-node-text (treesit-node-text
(pcase (treesit-node-type node) (pcase (treesit-node-type node)
((or "function_definition" "declaration") ((or "function_definition" "declaration")
(c-ts-mode--declarator-identifier (c-ts-mode--declarator-identifier
(treesit-node-child-by-field-name node "declarator"))) (treesit-node-child-by-field-name node "declarator")))
("struct_specifier" ((or "struct_specifier" "enum_specifier"
"union_specifier" "class_specifier")
(treesit-node-child-by-field-name node "name"))) (treesit-node-child-by-field-name node "name")))
t)) t))
(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-defun-name ts-node)))
(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))))))
;;; Defun navigation ;;; Defun navigation
(defun c-ts-mode--end-of-defun ()
"`end-of-defun-function' of `c-ts-mode'."
;; A struct/enum/union_specifier node doesn't include the ; at the
;; end, so we manually skip it.
(treesit-end-of-defun)
(when (looking-at (rx (* " ") ";"))
(goto-char (match-end 0))
;; This part is copied from `end-of-defun'.
(unless (bolp)
(skip-chars-forward " \t")
(if (looking-at "\\s<\\|\n")
(forward-line 1)))))
(defun c-ts-mode--defun-valid-p (node) (defun c-ts-mode--defun-valid-p (node)
(if (string-match-p "Return non-nil if NODE is a valid defun node.
(rx (or "struct_specifier" Ie, NODE is not nested."
"enum_specifier" (not (or (and (member (treesit-node-type node)
"union_specifier")) '("struct_specifier"
(treesit-node-type node)) "enum_specifier"
(null "union_specifier"
(treesit-node-top-level "declaration"))
node (rx (or "function_definition" ;; If NODE's type is one of the above, make sure it is
"type_definition")))) ;; top-level.
t)) (treesit-node-top-level
node (rx (or "function_definition"
"type_definition"
"struct_specifier"
"enum_specifier"
"union_specifier"
"declaration"))))
(and (equal (treesit-node-type node) "declaration")
;; If NODE is a declaration, make sure it is not a
;; function declaration.
(equal (treesit-node-type
(treesit-node-child-by-field-name
node "declarator"))
"function_declarator")))))
(defun c-ts-mode--defun-skipper () (defun c-ts-mode--defun-skipper ()
"Custom defun skipper for `c-ts-mode' and friends. "Custom defun skipper for `c-ts-mode' and friends.
@ -660,6 +612,59 @@ ARG is passed to `fill-paragraph'."
;; itself. ;; itself.
t))) t)))
(defun c-ts-mode-comment-setup ()
"Set up local variables for C-like comment.
Set up:
- `comment-start'
- `comment-end'
- `comment-start-skip'
- `comment-end-skip'
- `adaptive-fill-mode'
- `adaptive-fill-first-line-regexp'
- `paragraph-start'
- `paragraph-separate'
- `fill-paragraph-function'"
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(setq-local adaptive-fill-mode t)
;; This matches (1) empty spaces (the default), (2) "//", (3) "*",
;; but do not match "/*", because we don't want to use "/*" as
;; prefix when filling. (Actually, it doesn't matter, because
;; `comment-start-skip' matches "/*" which will cause
;; `fill-context-prefix' to use "/*" as a prefix for filling, that's
;; why we mask the "/*" in `c-ts-mode--fill-paragraph'.)
(setq-local adaptive-fill-regexp
(concat (rx (* (syntax whitespace))
(group (or (seq "/" (+ "/")) (* "*"))))
adaptive-fill-regexp))
;; Same as `adaptive-fill-regexp'.
(setq-local adaptive-fill-first-line-regexp
(rx bos
(seq (* (syntax whitespace))
(group (or (seq "/" (+ "/")) (* "*")))
(* (syntax whitespace)))
eos))
;; Same as `adaptive-fill-regexp'.
(setq-local paragraph-start
(rx (or (seq (* (syntax whitespace))
(group (or (seq "/" (+ "/")) (* "*")))
(* (syntax whitespace))
;; Add this eol so that in
;; `fill-context-prefix', `paragraph-start'
;; doesn't match the prefix.
eol)
"\f")))
(setq-local paragraph-separate paragraph-start)
(setq-local fill-paragraph-function #'c-ts-mode--fill-paragraph))
;;; Modes ;;; Modes
(defvar-keymap c-ts-mode-map (defvar-keymap c-ts-mode-map
@ -694,44 +699,25 @@ ARG is passed to `fill-paragraph'."
(when (eq c-ts-mode-indent-style 'linux) (when (eq c-ts-mode-indent-style 'linux)
(setq-local indent-tabs-mode t)) (setq-local indent-tabs-mode t))
(setq-local adaptive-fill-mode t) ;; Comment
;; This matches (1) empty spaces (the default), (2) "//", (3) "*", (c-ts-mode-comment-setup)
;; but do not match "/*", because we don't want to use "/*" as
;; prefix when filling. (Actually, it doesn't matter, because
;; `comment-start-skip' matches "/*" which will cause
;; `fill-context-prefix' to use "/*" as a prefix for filling, that's
;; why we mask the "/*" in `c-ts-mode--fill-paragraph'.)
(setq-local adaptive-fill-regexp
(concat (rx (* (syntax whitespace))
(group (or (seq "/" (+ "/")) (* "*"))))
adaptive-fill-regexp))
;; Same as `adaptive-fill-regexp'.
(setq-local adaptive-fill-first-line-regexp
(rx bos
(seq (* (syntax whitespace))
(group (or (seq "/" (+ "/")) (* "*")))
(* (syntax whitespace)))
eos))
;; Same as `adaptive-fill-regexp'.
(setq-local paragraph-start
(rx (or (seq (* (syntax whitespace))
(group (or (seq "/" (+ "/")) (* "*")))
(* (syntax whitespace))
;; Add this eol so that in
;; `fill-context-prefix', `paragraph-start'
;; doesn't match the prefix.
eol)
"\f")))
(setq-local paragraph-separate paragraph-start)
(setq-local fill-paragraph-function #'c-ts-mode--fill-paragraph)
;; Electric ;; Electric
(setq-local electric-indent-chars (setq-local electric-indent-chars
(append "{}():;," electric-indent-chars)) (append "{}():;," electric-indent-chars))
;; Imenu. ;; Imenu.
(setq-local imenu-create-index-function #'c-ts-mode--imenu) (setq-local treesit-simple-imenu-settings
(setq-local which-func-functions nil) (let ((pred #'c-ts-mode--defun-valid-p))
`(("Struct" ,(rx bos (or "struct" "enum" "union")
"_specifier" eos)
,pred nil)
("Variable" ,(rx bos "declaration" eos) ,pred nil)
("Function" "\\`function_definition\\'" ,pred nil)
("Class" ,(rx bos (or "class_specifier"
"function_definition")
eos)
,pred nil))))
(setq-local treesit-font-lock-feature-list (setq-local treesit-font-lock-feature-list
'(( comment definition) '(( comment definition)
@ -752,13 +738,6 @@ ARG is passed to `fill-paragraph'."
;; Comments. ;; Comments.
(setq-local comment-start "/* ") (setq-local comment-start "/* ")
(setq-local comment-end " */") (setq-local comment-end " */")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(setq-local treesit-simple-indent-rules (setq-local treesit-simple-indent-rules
(c-ts-mode--set-indent-style 'c)) (c-ts-mode--set-indent-style 'c))
@ -766,11 +745,7 @@ ARG is passed to `fill-paragraph'."
;; Font-lock. ;; Font-lock.
(setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c)) (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c))
(treesit-major-mode-setup) (treesit-major-mode-setup))
;; Override default value of end-of-defun-function set by
;; `treesit-major-mode-setup'.
(setq-local end-of-defun-function #'c-ts-mode--end-of-defun))
;;;###autoload ;;;###autoload
(define-derived-mode c++-ts-mode c-ts-base-mode "C++" (define-derived-mode c++-ts-mode c-ts-base-mode "C++"
@ -781,17 +756,6 @@ ARG is passed to `fill-paragraph'."
(unless (treesit-ready-p 'cpp) (unless (treesit-ready-p 'cpp)
(error "Tree-sitter for C++ isn't available")) (error "Tree-sitter for C++ isn't available"))
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(setq-local treesit-text-type-regexp (setq-local treesit-text-type-regexp
(regexp-opt '("comment" (regexp-opt '("comment"
"raw_string_literal"))) "raw_string_literal")))
@ -804,11 +768,7 @@ ARG is passed to `fill-paragraph'."
;; Font-lock. ;; Font-lock.
(setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'cpp)) (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'cpp))
(treesit-major-mode-setup) (treesit-major-mode-setup))
;; Override default value of end-of-defun-function set by
;; `treesit-major-mode-setup'.
(setq-local end-of-defun-function #'c-ts-mode--end-of-defun))
(provide 'c-ts-mode) (provide 'c-ts-mode)

73
lisp/progmodes/csharp-mode.el
View file

@ -34,6 +34,7 @@
(require 'cc-mode) (require 'cc-mode)
(require 'cc-langs) (require 'cc-langs)
(require 'treesit) (require 'treesit)
(require 'c-ts-mode) ; For comment indenting and filling.
(eval-when-compile (eval-when-compile
(require 'cc-fonts) (require 'cc-fonts)
@ -42,6 +43,7 @@
(declare-function treesit-parser-create "treesit.c") (declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-start "treesit.c") (declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c")
(defgroup csharp nil (defgroup csharp nil
@ -632,6 +634,9 @@ compilation and evaluation time conflicts."
((node-is "}") parent-bol 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 0)
((and (parent-is "comment") c-ts-mode--looking-at-star)
c-ts-mode--comment-start-after-first-star -1)
((parent-is "comment") prev-adaptive-prefix 0)
((parent-is "namespace_declaration") parent-bol 0) ((parent-is "namespace_declaration") parent-bol 0)
((parent-is "class_declaration") parent-bol 0) ((parent-is "class_declaration") parent-bol 0)
((parent-is "constructor_declaration") parent-bol 0) ((parent-is "constructor_declaration") parent-bol 0)
@ -853,54 +858,6 @@ Return nil if there is no name or if NODE is not a defun node."
node "name") node "name")
t)))) t))))
(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-defun-name ts-node)
"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 ;;;###autoload
(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode))
@ -929,15 +886,7 @@ Key bindings:
(treesit-parser-create 'c-sharp) (treesit-parser-create 'c-sharp)
;; Comments. ;; Comments.
(setq-local comment-start "// ") (c-ts-mode-comment-setup)
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(setq-local treesit-text-type-regexp (setq-local treesit-text-type-regexp
(regexp-opt '("comment" (regexp-opt '("comment"
@ -964,8 +913,14 @@ Key bindings:
( bracket delimiter))) ( bracket delimiter)))
;; Imenu. ;; Imenu.
(setq-local imenu-create-index-function #'csharp-ts-mode--imenu) (setq-local treesit-simple-imenu-settings
(setq-local which-func-functions nil) ;; Piggyback on imenu '(("Class" "\\`class_declaration\\'" nil nil)
("Interface" "\\`interface_declaration\\'" nil nil)
("Enum" "\\`enum_declaration\\'" nil nil)
("Record" "\\`record_declaration\\'" nil nil)
("Struct" "\\`struct_declaration\\'" nil nil)
("Method" "\\`method_declaration\\'" nil nil)))
(treesit-major-mode-setup)) (treesit-major-mode-setup))
(provide 'csharp-mode) (provide 'csharp-mode)

68
lisp/progmodes/java-ts-mode.el
View file

@ -29,10 +29,12 @@
(require 'treesit) (require 'treesit)
(eval-when-compile (require 'rx)) (eval-when-compile (require 'rx))
(require 'c-ts-mode) ; For comment indent and filling.
(declare-function treesit-parser-create "treesit.c") (declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-start "treesit.c") (declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c")
(defcustom java-ts-mode-indent-offset 4 (defcustom java-ts-mode-indent-offset 4
@ -71,8 +73,9 @@
((node-is "}") (and parent parent-bol) 0) ((node-is "}") (and parent 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) ((and (parent-is "comment") c-ts-mode--looking-at-star)
((parent-is "comment") comment-start-skip 0) c-ts-mode--comment-start-after-first-star -1)
((parent-is "comment") prev-adaptive-prefix 0)
((parent-is "text_block") no-indent) ((parent-is "text_block") no-indent)
((parent-is "class_body") parent-bol java-ts-mode-indent-offset) ((parent-is "class_body") parent-bol java-ts-mode-indent-offset)
((parent-is "interface_body") parent-bol java-ts-mode-indent-offset) ((parent-is "interface_body") parent-bol java-ts-mode-indent-offset)
@ -264,50 +267,6 @@ Return nil if there is no name or if NODE is not a defun node."
(treesit-node-child-by-field-name node "name") (treesit-node-child-by-field-name node "name")
t)))) t))))
(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-defun-name ts-node)
"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 ;;;###autoload
(define-derived-mode java-ts-mode prog-mode "Java" (define-derived-mode java-ts-mode prog-mode "Java"
"Major mode for editing Java, powered by tree-sitter." "Major mode for editing Java, powered by tree-sitter."
@ -320,15 +279,7 @@ the subtrees."
(treesit-parser-create 'java) (treesit-parser-create 'java)
;; Comments. ;; Comments.
(setq-local comment-start "// ") (c-ts-mode-comment-setup)
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(setq-local treesit-text-type-regexp (setq-local treesit-text-type-regexp
(regexp-opt '("line_comment" (regexp-opt '("line_comment"
@ -363,8 +314,11 @@ the subtrees."
( bracket delimiter operator))) ( bracket delimiter operator)))
;; Imenu. ;; Imenu.
(setq-local imenu-create-index-function #'java-ts-mode--imenu) (setq-local treesit-simple-imenu-settings
(setq-local which-func-functions nil) ;; Piggyback on imenu '(("Class" "\\`class_declaration\\'" nil nil)
("Interface" "\\`interface_declaration\\'" nil nil)
("Enum" "\\`record_declaration\\'" nil nil)
("Method" "\\`method_declaration\\'" nil nil)))
(treesit-major-mode-setup)) (treesit-major-mode-setup))
(provide 'java-ts-mode) (provide 'java-ts-mode)

98
lisp/progmodes/js.el
View file

@ -54,6 +54,7 @@
(require 'json) (require 'json)
(require 'prog-mode) (require 'prog-mode)
(require 'treesit) (require 'treesit)
(require 'c-ts-mode) ; For comment indent and filling.
(eval-when-compile (eval-when-compile
(require 'cl-lib) (require 'cl-lib)
@ -3425,9 +3426,9 @@ This function is intended for use in `after-change-functions'."
((node-is ")") parent-bol 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 0)
((parent-is "comment") comment-start 0) ((and (parent-is "comment") c-ts-mode--looking-at-star)
((and (parent-is "comment") comment-end) comment-start -1) c-ts-mode--comment-start-after-first-star -1)
((parent-is "comment") comment-start-skip 0) ((parent-is "comment") prev-adaptive-prefix 0)
((parent-is "ternary_expression") parent-bol js-indent-level) ((parent-is "ternary_expression") parent-bol js-indent-level)
((parent-is "member_expression") parent-bol js-indent-level) ((parent-is "member_expression") parent-bol js-indent-level)
((node-is ,switch-case) parent-bol 0) ((node-is ,switch-case) parent-bol 0)
@ -3669,70 +3670,11 @@ Return nil if there is no name or if NODE is not a defun node."
"name") "name")
t)) t))
(defun js--treesit-imenu-1 (node) (defun js--treesit-valid-imenu-entry (node)
"Given a sparse tree, create an imenu alist. "Return nil if NODE is a non-top-level \"lexical_declaration\"."
(pcase (treesit-node-type node)
NODE is the root node of the tree returned by ("lexical_declaration" (treesit-node-top-level node))
`treesit-induce-sparse-tree' (not a tree-sitter node, its car is (_ t)))
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
(or (treesit-defun-name ts-node)
"Anonymous")))
(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)))
;; When a sub-tree is empty, we should not return that pair at all.
(append
(and func-tree
`(("Function" . ,(js--treesit-imenu-1 func-tree))))
(and var-tree
`(("Variable" . ,(js--treesit-imenu-1 var-tree))))
(and class-tree
`(("Class" . ,(js--treesit-imenu-1 class-tree)))))))
;;; Main Function ;;; Main Function
@ -3845,15 +3787,7 @@ Currently there are `js-mode' and `js-ts-mode'."
;; Which-func. ;; Which-func.
(setq-local which-func-imenu-joiner-function #'js--which-func-joiner) (setq-local which-func-imenu-joiner-function #'js--which-func-joiner)
;; Comment. ;; Comment.
(setq-local comment-start "// ") (c-ts-mode-comment-setup)
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(setq-local comment-multi-line t) (setq-local comment-multi-line t)
(setq-local treesit-text-type-regexp (setq-local treesit-text-type-regexp
@ -3887,10 +3821,14 @@ Currently there are `js-mode' and `js-ts-mode'."
identifier jsx number pattern property) identifier jsx number pattern property)
( bracket delimiter operator))) ( bracket delimiter operator)))
;; Imenu ;; Imenu
(setq-local imenu-create-index-function (setq-local treesit-simple-imenu-settings
#'js--treesit-imenu) `(("Function" "\\`function_declaration\\'" nil nil)
;; Which-func (use imenu). ("Variable" "\\`lexical_declaration\\'"
(setq-local which-func-functions nil) js--treesit-valid-imenu-entry nil)
("Class" ,(rx bos (or "class_declaration"
"method_definition")
eos)
nil nil)))
(treesit-major-mode-setup))) (treesit-major-mode-setup)))
;;;###autoload ;;;###autoload

40
lisp/progmodes/json-ts-mode.el
View file

@ -33,6 +33,7 @@
(declare-function treesit-parser-create "treesit.c") (declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-start "treesit.c") (declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c")
@ -112,36 +113,11 @@
Return nil if there is no name or if NODE is not a defun node." Return nil if there is no name or if NODE is not a defun node."
(pcase (treesit-node-type node) (pcase (treesit-node-type node)
((or "pair" "object") ((or "pair" "object")
(treesit-node-text (string-trim (treesit-node-text
(treesit-node-child-by-field-name (treesit-node-child-by-field-name
node "key") node "key")
t)))) t)
"\"" "\""))))
(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
(or (treesit-defun-name ts-node)
"Anonymous")))
(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 ;;;###autoload
(define-derived-mode json-ts-mode prog-mode "JSON" (define-derived-mode json-ts-mode prog-mode "JSON"
@ -179,8 +155,8 @@ the subtrees."
(bracket delimiter error))) (bracket delimiter error)))
;; Imenu. ;; Imenu.
(setq-local imenu-create-index-function #'json-ts-mode--imenu) (setq-local treesit-simple-imenu-settings
(setq-local which-func-functions nil) ;; Piggyback on imenu '((nil "\\`pair\\'" nil nil)))
(treesit-major-mode-setup)) (treesit-major-mode-setup))

43
lisp/progmodes/python.el
View file

@ -1080,7 +1080,6 @@ fontified."
:feature 'string :feature 'string
:language 'python :language 'python
:override t
'((string) @python--treesit-fontify-string) '((string) @python--treesit-fontify-string)
:feature 'string-interpolation :feature 'string-interpolation
@ -1097,9 +1096,7 @@ fontified."
:feature 'function :feature 'function
:language 'python :language 'python
'((function_definition '((call function: (identifier) @font-lock-function-name-face)
name: (identifier) @font-lock-function-name-face)
(call function: (identifier) @font-lock-function-name-face)
(call function: (attribute (call function: (attribute
attribute: (identifier) @font-lock-function-name-face))) attribute: (identifier) @font-lock-function-name-face)))
@ -1130,7 +1127,7 @@ fontified."
@font-lock-variable-name-face) @font-lock-variable-name-face)
(assignment left: (attribute (assignment left: (attribute
attribute: (identifier) attribute: (identifier)
@font-lock-variable-name-face)) @font-lock-property-face))
(pattern_list (identifier) (pattern_list (identifier)
@font-lock-variable-name-face) @font-lock-variable-name-face)
(tuple_pattern (identifier) (tuple_pattern (identifier)
@ -1162,12 +1159,10 @@ fontified."
:feature 'number :feature 'number
:language 'python :language 'python
:override t
'([(integer) (float)] @font-lock-number-face) '([(integer) (float)] @font-lock-number-face)
:feature 'property :feature 'property
:language 'python :language 'python
:override t
'((attribute '((attribute
attribute: (identifier) @font-lock-property-face) attribute: (identifier) @font-lock-property-face)
(class_definition (class_definition
@ -1178,20 +1173,44 @@ fontified."
:feature 'operator :feature 'operator
:language 'python :language 'python
:override t
`([,@python--treesit-operators] @font-lock-operator-face) `([,@python--treesit-operators] @font-lock-operator-face)
:feature 'bracket :feature 'bracket
:language 'python :language 'python
:override t
'(["(" ")" "[" "]" "{" "}"] @font-lock-bracket-face) '(["(" ")" "[" "]" "{" "}"] @font-lock-bracket-face)
:feature 'delimiter :feature 'delimiter
:language 'python :language 'python
:override t '(["," "." ":" ";" (ellipsis)] @font-lock-delimiter-face)
'(["," "." ":" ";" (ellipsis)] @font-lock-delimiter-face))
:feature 'variable
:language 'python
'((identifier) @python--treesit-fontify-variable))
"Tree-sitter font-lock settings.") "Tree-sitter font-lock settings.")
(defun python--treesit-variable-p (node)
"Check whether NODE is a variable.
NODE's type should be \"identifier\"."
;; An identifier can be a function/class name, a property, or a
;; variables. This funtion filters out function/class names and
;; properties.
(pcase (treesit-node-type (treesit-node-parent node))
((or "function_definition" "class_definition") nil)
("attribute"
(pcase (treesit-node-field-name node)
("object" t)
(_ nil)))
(_ t)))
(defun python--treesit-fontify-variable (node override start end &rest _)
"Fontify an identifier node if it is a variable.
For NODE, OVERRIDE, START, END, and ARGS, see
`treesit-font-lock-rules'."
(when (python--treesit-variable-p node)
(treesit-fontify-with-override
(treesit-node-start node) (treesit-node-end node)
'font-lock-variable-name-face override start end)))
;;; Indentation ;;; Indentation
@ -6646,7 +6665,7 @@ implementations: `python-mode' and `python-ts-mode'."
( keyword string type) ( keyword string type)
( assignment builtin constant decorator ( assignment builtin constant decorator
escape-sequence number property string-interpolation ) escape-sequence number property string-interpolation )
( function bracket delimiter operator))) ( bracket delimiter function operator variable)))
(setq-local treesit-font-lock-settings python--treesit-settings) (setq-local treesit-font-lock-settings python--treesit-settings)
(setq-local imenu-create-index-function (setq-local imenu-create-index-function
#'python-imenu-treesit-create-index) #'python-imenu-treesit-create-index)

73
lisp/progmodes/rust-ts-mode.el
View file

@ -29,6 +29,7 @@
(require 'treesit) (require 'treesit)
(eval-when-compile (require 'rx)) (eval-when-compile (require 'rx))
(require 'c-ts-mode) ; For comment indent and filling.
(declare-function treesit-parser-create "treesit.c") (declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c")
@ -70,6 +71,9 @@
((node-is ")") parent-bol 0) ((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0) ((node-is "]") parent-bol 0)
((node-is "}") (and parent parent-bol) 0) ((node-is "}") (and parent parent-bol) 0)
((and (parent-is "comment") c-ts-mode--looking-at-star)
c-ts-mode--comment-start-after-first-star -1)
((parent-is "comment") prev-adaptive-prefix 0)
((parent-is "arguments") parent-bol rust-ts-mode-indent-offset) ((parent-is "arguments") parent-bol rust-ts-mode-indent-offset)
((parent-is "await_expression") parent-bol rust-ts-mode-indent-offset) ((parent-is "await_expression") parent-bol rust-ts-mode-indent-offset)
((parent-is "array_expression") parent-bol rust-ts-mode-indent-offset) ((parent-is "array_expression") parent-bol rust-ts-mode-indent-offset)
@ -244,35 +248,6 @@
'((ERROR) @font-lock-warning-face)) '((ERROR) @font-lock-warning-face))
"Tree-sitter font-lock settings for `rust-ts-mode'.") "Tree-sitter font-lock settings for `rust-ts-mode'.")
(defun rust-ts-mode--imenu ()
"Return Imenu alist for the current buffer."
(let* ((node (treesit-buffer-root-node))
(enum-tree (treesit-induce-sparse-tree
node "enum_item" nil))
(enum-index (rust-ts-mode--imenu-1 enum-tree))
(func-tree (treesit-induce-sparse-tree
node "function_item" nil))
(func-index (rust-ts-mode--imenu-1 func-tree))
(impl-tree (treesit-induce-sparse-tree
node "impl_item" nil))
(impl-index (rust-ts-mode--imenu-1 impl-tree))
(mod-tree (treesit-induce-sparse-tree
node "mod_item" nil))
(mod-index (rust-ts-mode--imenu-1 mod-tree))
(struct-tree (treesit-induce-sparse-tree
node "struct_item" nil))
(struct-index (rust-ts-mode--imenu-1 struct-tree))
(type-tree (treesit-induce-sparse-tree
node "type_item" nil))
(type-index (rust-ts-mode--imenu-1 type-tree)))
(append
(when mod-index `(("Module" . ,mod-index)))
(when enum-index `(("Enum" . ,enum-index)))
(when impl-index `(("Impl" . ,impl-index)))
(when type-index `(("Type" . ,type-index)))
(when struct-index `(("Struct" . ,struct-index)))
(when func-index `(("Fn" . ,func-index))))))
(defun rust-ts-mode--defun-name (node) (defun rust-ts-mode--defun-name (node)
"Return the defun name of NODE. "Return the defun name of NODE.
Return nil if there is no name or if NODE is not a defun node." Return nil if there is no name or if NODE is not a defun node."
@ -300,27 +275,6 @@ Return nil if there is no name or if NODE is not a defun node."
(treesit-node-text (treesit-node-text
(treesit-node-child-by-field-name node "name") t)))) (treesit-node-child-by-field-name node "name") t))))
(defun rust-ts-mode--imenu-1 (node)
"Helper for `rust-ts-mode--imenu'.
Find string representation for NODE and set marker, then recurse
the subtrees."
(let* ((ts-node (car node))
(children (cdr node))
(subtrees (mapcan #'rust-ts-mode--imenu-1
children))
(name (when ts-node
(or (treesit-defun-name ts-node)
"Anonymous")))
(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))))))
;;;###autoload ;;;###autoload
(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode)) (add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode))
@ -334,15 +288,7 @@ the subtrees."
(treesit-parser-create 'rust) (treesit-parser-create 'rust)
;; Comments. ;; Comments.
(setq-local comment-start "// ") (c-ts-mode-comment-setup)
(setq-local comment-end "")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
;; Font-lock. ;; Font-lock.
(setq-local treesit-font-lock-settings rust-ts-mode--font-lock-settings) (setq-local treesit-font-lock-settings rust-ts-mode--font-lock-settings)
@ -354,8 +300,13 @@ the subtrees."
( bracket delimiter error operator))) ( bracket delimiter error operator)))
;; Imenu. ;; Imenu.
(setq-local imenu-create-index-function #'rust-ts-mode--imenu) (setq-local treesit-simple-imenu-settings
(setq-local which-func-functions nil) `(("Module" "\\`mod_item\\'" nil nil)
("Enum" "\\`enum_item\\'" nil nil)
("Impl" "\\`impl_item\\'" nil nil)
("Type" "\\`type_item\\'" nil nil)
("Struct" "\\`struct_item\\'" nil nil)
("Fn" "\\`function_item\\'" nil nil)))
;; Indent. ;; Indent.
(setq-local indent-tabs-mode nil (setq-local indent-tabs-mode nil

20
lisp/progmodes/scheme.el
View file

@ -115,7 +115,8 @@
(defvar scheme-imenu-generic-expression (defvar scheme-imenu-generic-expression
`((nil `((nil
,(rx bol "(define" ,(rx bol (zero-or-more space)
"(define"
(zero-or-one "*") (zero-or-one "*")
(zero-or-one "-public") (zero-or-one "-public")
(one-or-more space) (one-or-more space)
@ -123,36 +124,41 @@
(group (one-or-more (or word (syntax symbol))))) (group (one-or-more (or word (syntax symbol)))))
1) 1)
("Methods" ("Methods"
,(rx bol "(define-" ,(rx bol (zero-or-more space)
"(define-"
(or "generic" "method" "accessor") (or "generic" "method" "accessor")
(one-or-more space) (one-or-more space)
(zero-or-one "(") (zero-or-one "(")
(group (one-or-more (or word (syntax symbol))))) (group (one-or-more (or word (syntax symbol)))))
1) 1)
("Classes" ("Classes"
,(rx bol "(define-class" ,(rx bol (zero-or-more space)
"(define-class"
(one-or-more space) (one-or-more space)
(zero-or-one "(") (zero-or-one "(")
(group (one-or-more (or word (syntax symbol))))) (group (one-or-more (or word (syntax symbol)))))
1) 1)
("Records" ("Records"
,(rx bol "(define-record-type" ,(rx bol (zero-or-more space)
"(define-record-type"
(zero-or-one "*") (zero-or-one "*")
(one-or-more space) (one-or-more space)
(group (one-or-more (or word (syntax symbol))))) (group (one-or-more (or word (syntax symbol)))))
1) 1)
("Conditions" ("Conditions"
,(rx bol "(define-condition-type" ,(rx bol (zero-or-more space)
"(define-condition-type"
(one-or-more space) (one-or-more space)
(group (one-or-more (or word (syntax symbol))))) (group (one-or-more (or word (syntax symbol)))))
1) 1)
("Modules" ("Modules"
,(rx bol "(define-module" ,(rx bol (zero-or-more space)
"(define-module"
(one-or-more space) (one-or-more space)
(group "(" (one-or-more any) ")")) (group "(" (one-or-more any) ")"))
1) 1)
("Macros" ("Macros"
,(rx bol "(" ,(rx bol (zero-or-more space) "("
(or (and "defmacro" (or (and "defmacro"
(zero-or-one "*") (zero-or-one "*")
(zero-or-one "-public")) (zero-or-one "-public"))

2
lisp/progmodes/sh-script.el
View file

@ -150,6 +150,8 @@
(require 'executable) (require 'executable)
(require 'treesit) (require 'treesit)
(declare-function treesit-parser-create "treesit.c")
(autoload 'comint-completion-at-point "comint") (autoload 'comint-completion-at-point "comint")
(autoload 'comint-filename-completion "comint") (autoload 'comint-filename-completion "comint")
(autoload 'comint-send-string "comint") (autoload 'comint-send-string "comint")

30
lisp/progmodes/typescript-ts-mode.el
View file

@ -30,6 +30,7 @@
(require 'treesit) (require 'treesit)
(require 'js) (require 'js)
(eval-when-compile (require 'rx)) (eval-when-compile (require 'rx))
(require 'c-ts-mode) ; For comment indent and filling.
(declare-function treesit-parser-create "treesit.c") (declare-function treesit-parser-create "treesit.c")
@ -73,8 +74,9 @@ Argument LANGUAGE is either `typescript' or `tsx'."
((node-is ")") parent-bol 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 0)
((and (parent-is "comment") comment-end) comment-start -1) ((and (parent-is "comment") c-ts-mode--looking-at-star)
((parent-is "comment") comment-start-skip 0) c-ts-mode--comment-start-after-first-star -1)
((parent-is "comment") prev-adaptive-prefix 0)
((parent-is "ternary_expression") parent-bol typescript-ts-mode-indent-offset) ((parent-is "ternary_expression") parent-bol typescript-ts-mode-indent-offset)
((parent-is "member_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 "named_imports") parent-bol typescript-ts-mode-indent-offset)
@ -331,18 +333,12 @@ Argument LANGUAGE is either `typescript' or `tsx'."
:syntax-table typescript-ts-mode--syntax-table :syntax-table typescript-ts-mode--syntax-table
;; Comments. ;; Comments.
(setq-local comment-start "// ") (c-ts-mode-comment-setup)
(setq-local comment-end "") (setq-local treesit-defun-prefer-top-level t)
(setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *")
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)
(seq (+ "*") "/")))))
(setq-local treesit-text-type-regexp (setq-local treesit-text-type-regexp
(regexp-opt '("comment" (regexp-opt '("comment"
"template_string"))) "template_string")))
(setq-local treesit-defun-prefer-top-level t)
;; Electric ;; Electric
(setq-local electric-indent-chars (setq-local electric-indent-chars
@ -354,11 +350,17 @@ Argument LANGUAGE is either `typescript' or `tsx'."
"method_definition" "method_definition"
"function_declaration" "function_declaration"
"lexical_declaration"))) "lexical_declaration")))
;; Imenu. (setq-local treesit-defun-name-function #'js--treesit-defun-name)
(setq-local imenu-create-index-function #'js--treesit-imenu)
;; Which-func (use imenu). ;; Imenu (same as in `js-ts-mode').
(setq-local which-func-functions nil)) (setq-local treesit-simple-imenu-settings
`(("Function" "\\`function_declaration\\'" nil nil)
("Variable" "\\`lexical_declaration\\'"
js--treesit-valid-imenu-entry nil)
("Class" ,(rx bos (or "class_declaration"
"method_definition")
eos)
nil nil))))
;;;###autoload ;;;###autoload
(define-derived-mode typescript-ts-mode typescript-ts-base-mode "TypeScript" (define-derived-mode typescript-ts-mode typescript-ts-base-mode "TypeScript"

3
lisp/repeat.el
View file

@ -399,7 +399,8 @@ but the property value is `t', then check the last key."
(defcustom repeat-echo-function #'repeat-echo-message (defcustom repeat-echo-function #'repeat-echo-message
"Function to display a hint about available keys. "Function to display a hint about available keys.
Function is called after every repeatable command with one argument: Function is called after every repeatable command with one argument:
a repeating map, or nil after deactivating the transient repeating mode." a repeating map, or nil after deactivating the transient repeating mode.
You can use `add-function' for multiple functions simultaneously."
:type '(choice (const :tag "Show hints in the echo area" :type '(choice (const :tag "Show hints in the echo area"
repeat-echo-message) repeat-echo-message)
(const :tag "Show indicator in the mode line" (const :tag "Show indicator in the mode line"

7
lisp/subr.el
View file

@ -6905,11 +6905,8 @@ sentence (see Info node `(elisp) Documentation Tips')."
(defun json-available-p () (defun json-available-p ()
"Return non-nil if Emacs has libjansson support." "Return non-nil if Emacs has libjansson support."
(and (fboundp 'json-serialize) (and (fboundp 'json--available-p)
(condition-case nil (json--available-p)))
(json-serialize t)
(:success t)
(json-unavailable nil))))
(defun ensure-list (object) (defun ensure-list (object)
"Return OBJECT as a list. "Return OBJECT as a list.

14
lisp/tab-line.el
View file

@ -572,9 +572,14 @@ For use in `tab-line-tab-face-functions'."
(defvar tab-line-auto-hscroll) (defvar tab-line-auto-hscroll)
(defun tab-line-cache-key-default (_tabs) (defun tab-line-cache-key-default (tabs)
"Return default list of cache keys." "Return default list of cache keys."
(list (list
tabs
;; handle buffer renames
(buffer-name (window-buffer))
;; handle tab-line scrolling
(window-parameter nil 'tab-line-hscroll)
;; for setting face 'tab-line-tab-current' ;; for setting face 'tab-line-tab-current'
(mode-line-window-selected-p) (mode-line-window-selected-p)
;; for `tab-line-tab-face-modified' ;; for `tab-line-tab-face-modified'
@ -591,12 +596,7 @@ of cache keys. You can use `add-function' to add more cache keys.")
(defun tab-line-format () (defun tab-line-format ()
"Format for displaying the tab line of the selected window." "Format for displaying the tab line of the selected window."
(let* ((tabs (funcall tab-line-tabs-function)) (let* ((tabs (funcall tab-line-tabs-function))
(cache-key (append (list tabs (cache-key (funcall tab-line-cache-key-function tabs))
;; handle buffer renames
(buffer-name (window-buffer))
;; handle tab-line scrolling
(window-parameter nil 'tab-line-hscroll))
(funcall tab-line-cache-key-function tabs)))
(cache (window-parameter nil 'tab-line-cache))) (cache (window-parameter nil 'tab-line-cache)))
;; Enable auto-hscroll again after it was disabled on manual scrolling. ;; Enable auto-hscroll again after it was disabled on manual scrolling.
;; The moment to enable it is when the window-buffer was updated. ;; The moment to enable it is when the window-buffer was updated.

32
lisp/textmodes/css-mode.el
View file

@ -1425,33 +1425,6 @@ Return nil if there is no name or if NODE is not a defun node."
(treesit-node-start node) (treesit-node-start node)
(treesit-node-start block))))))) (treesit-node-start block)))))))
(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
(or (treesit-defun-name ts-node)
"Anonymous")))
(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 ;;; Completion
(defun css--complete-property () (defun css--complete-property ()
@ -1847,8 +1820,9 @@ can also be used to fill comments.
'((selector comment query keyword) '((selector comment query keyword)
(property constant string) (property constant string)
(error variable function operator bracket))) (error variable function operator bracket)))
(setq-local imenu-create-index-function #'css--treesit-imenu) (setq-local treesit-simple-imenu-settings
(setq-local which-func-functions nil) `( nil ,(rx bos (or "rule_set" "media_statement") eos)
nil nil))
(treesit-major-mode-setup))) (treesit-major-mode-setup)))
;;;###autoload ;;;###autoload

42
lisp/textmodes/toml-ts-mode.el
View file

@ -32,6 +32,8 @@
(declare-function treesit-parser-create "treesit.c") (declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-start "treesit.c") (declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-child "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c")
(defcustom toml-ts-mode-indent-offset 2 (defcustom toml-ts-mode-indent-offset 2
@ -112,39 +114,8 @@
Return nil if there is no name or if NODE is not a defun node." Return nil if there is no name or if NODE is not a defun node."
(pcase (treesit-node-type node) (pcase (treesit-node-type node)
((or "table" "table_array_element") ((or "table" "table_array_element")
(car (cdr (treesit-node-children node)))))) (or (treesit-node-text (treesit-node-child node 1) t)
"Root table"))))
(defun toml-ts-mode--imenu-1 (node)
"Helper for `toml-ts-mode--imenu'.
Find string representation for NODE and set marker, then recurse
the subtrees."
(let* ((ts-node (car node))
(subtrees (mapcan #'toml-ts-mode--imenu-1 (cdr node)))
(name (or (treesit-defun-name ts-node)
"Root table"))
(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 toml-ts-mode--imenu ()
"Return Imenu alist for the current buffer."
(let* ((node (treesit-buffer-root-node))
(table-tree (treesit-induce-sparse-tree
node "^table$" nil 1000))
(table-array-tree (treesit-induce-sparse-tree
node "^table_array_element$" nil 1000))
(table-index (toml-ts-mode--imenu-1 table-tree))
(table-array-index (toml-ts-mode--imenu-1 table-array-tree)))
(append
(when table-index `(("Headers" . ,table-index)))
(when table-array-index `(("Arrays" . ,table-array-index))))))
;;;###autoload ;;;###autoload
(add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode)) (add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode))
@ -179,8 +150,9 @@ the subtrees."
(delimiter error))) (delimiter error)))
;; Imenu. ;; Imenu.
(setq-local imenu-create-index-function #'toml-ts-mode--imenu) (setq-local treesit-simple-imenu-settings
(setq-local which-func-functions nil) ;; Piggyback on imenu '(("Header" "\\`table\\'" nil nil)
("Array" "\\`table_array_element\\'" nil nil)))
(treesit-major-mode-setup))) (treesit-major-mode-setup)))

246
lisp/treesit.el
View file

@ -2,6 +2,10 @@
;; Copyright (C) 2021-2022 Free Software Foundation, Inc. ;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
;; Maintainer: 付禹安 (Yuan Fu) <casouri@gmail.com>
;; Keywords: treesit, tree-sitter, languages
;; Package: emacs
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify ;; GNU Emacs is free software: you can redistribute it and/or modify
@ -230,19 +234,27 @@ is nil, try to guess the language at BEG using `treesit-language-at'."
(or parser-or-lang (treesit-language-at beg)))))) (or parser-or-lang (treesit-language-at beg))))))
(treesit-node-descendant-for-range root beg (or end beg) named))) (treesit-node-descendant-for-range root beg (or end beg) named)))
(defun treesit-node-top-level (node &optional type) (defun treesit-node-top-level (node &optional pred include-node)
"Return the top-level equivalent of NODE. "Return the top-level equivalent of NODE.
Specifically, return the highest parent of NODE that has the same Specifically, return the highest parent of NODE that has the same
type as it. If no such parent exists, return nil. type as it. If no such parent exists, return nil.
If TYPE is non-nil, match each parent's type with TYPE as a If PRED is non-nil, match each parent's type with PRED as a
regexp, rather than using NODE's type." regexp, rather than using NODE's type. PRED can also be a
(let ((type (or type (treesit-node-type node))) function that takes the node as an argument, and return
non-nil/nil for match/no match.
If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED."
(let ((pred (or pred (treesit-node-type node)))
(result nil)) (result nil))
(cl-loop for cursor = (treesit-node-parent node) (cl-loop for cursor = (if include-node node
(treesit-node-parent node))
then (treesit-node-parent cursor) then (treesit-node-parent cursor)
while cursor while cursor
if (string-match-p type (treesit-node-type cursor)) if (if (stringp pred)
(string-match-p pred (treesit-node-type cursor))
(funcall pred cursor))
do (setq result cursor)) do (setq result cursor))
result)) result))
@ -286,11 +298,16 @@ properties."
(treesit-node-start node) (treesit-node-start node)
(treesit-node-end node)))))) (treesit-node-end node))))))
(defun treesit-parent-until (node pred) (defun treesit-parent-until (node pred &optional include-node)
"Return the closest parent of NODE that satisfies PRED. "Return the closest parent of NODE that satisfies PRED.
Return nil if none was found. PRED should be a function that Return nil if none was found. PRED should be a function that
takes one argument, the parent node." takes one argument, the parent node, and return non-nil/nil for
(let ((node (treesit-node-parent node))) match/no match.
If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED."
(let ((node (if include-node node
(treesit-node-parent node))))
(while (and node (not (funcall pred node))) (while (and node (not (funcall pred node)))
(setq node (treesit-node-parent node))) (setq node (treesit-node-parent node)))
node)) node))
@ -305,8 +322,6 @@ takes one argument, the parent node."
node (treesit-node-parent node))) node (treesit-node-parent node)))
last)) last))
(defalias 'treesit-traverse-parent #'treesit-parent-until)
(defun treesit-node-children (node &optional named) (defun treesit-node-children (node &optional named)
"Return a list of NODE's children. "Return a list of NODE's children.
If NAMED is non-nil, collect named child only." If NAMED is non-nil, collect named child only."
@ -1644,7 +1659,7 @@ For example, \"(function|class)_definition\".
Sometimes not all nodes matched by the regexp are valid defuns. Sometimes not all nodes matched by the regexp are valid defuns.
In that case, set this variable to a cons cell of the In that case, set this variable to a cons cell of the
form (REGEXP . FILTER), where FILTER is a function that takes a form (REGEXP . PRED), where PRED is a function that takes a
node (the matched node) and returns t if node is valid, or nil node (the matched node) and returns t if node is valid, or nil
for invalid node. for invalid node.
@ -1793,78 +1808,67 @@ sound things exists.
REGEXP and PRED are the same as in `treesit-thing-at-point'." REGEXP and PRED are the same as in `treesit-thing-at-point'."
(let* ((node (treesit-node-at pos)) (let* ((node (treesit-node-at pos))
;; NODE-BEFORE/AFTER = NODE when POS is completely in NODE, (result (list nil nil nil)))
;; but if not, that means point could be in between two
;; defun, in that case we want to use a node that's actually
;; before/after point.
(node-before (if (>= (treesit-node-start node) pos)
(save-excursion
(treesit-search-forward-goto node "" t t t))
node))
(node-after (if (<= (treesit-node-end node) pos)
(save-excursion
(treesit-search-forward-goto
node "" nil nil t))
node))
(result (list nil nil nil))
(pred (or pred (lambda (_) t))))
;; 1. Find previous and next sibling defuns. ;; 1. Find previous and next sibling defuns.
(cl-loop (cl-loop
for idx from 0 to 1 for idx from 0 to 1
for node in (list node-before node-after)
for backward in '(t nil) for backward in '(t nil)
;; Make sure we go in the right direction, and the defun we find
;; doesn't cover POS.
for pos-pred in (list (lambda (n) (<= (treesit-node-end n) pos)) for pos-pred in (list (lambda (n) (<= (treesit-node-end n) pos))
(lambda (n) (>= (treesit-node-start n) pos))) (lambda (n) (>= (treesit-node-start n) pos)))
;; If point is inside a defun, our process below will never ;; We repeatedly find next defun candidate with
;; return a next/prev sibling outside of that defun, effectively ;; `treesit-search-forward', and check if it is a valid defun,
;; any prev/next sibling is locked inside the smallest defun ;; until the node we find covers POS, meaning we've gone through
;; covering point, which is the correct behavior. That's because ;; every possible sibling defuns. But there is a catch:
;; when there exists a defun that covers point, ;; `treesit-search-forward' searches bottom-up, so for each
;; `treesit-search-forward' will first reach that defun, after ;; candidate we need to go up the tree and find the top-most
;; that we only go upwards in the tree, so other defuns outside ;; valid sibling, this defun will be at the same level as POS.
;; of the covering defun is never reached. (Don't use ;; Don't use `treesit-search-forward-goto', it skips nodes in
;; `treesit-search-forward-goto' as it breaks when NODE-AFTER is ;; order to enforce progress.
;; the last token of a parent defun: it will skip the parent when node
;; defun because it wants to ensure progress.) do (let ((cursor node)
do (cl-loop for cursor = (when node (iter-pred (lambda (node)
(save-excursion (and (string-match-p
(treesit-search-forward regexp (treesit-node-type node))
node regexp backward backward))) (or (null pred) (funcall pred node))
then (treesit-node-parent cursor) (funcall pos-pred node)))))
while cursor ;; Find the node just before/after POS to start searching.
if (and (string-match-p (save-excursion
regexp (treesit-node-type cursor)) (while (and cursor (not (funcall pos-pred cursor)))
(funcall pred cursor) (setq cursor (treesit-search-forward-goto
(funcall pos-pred cursor)) cursor "" backward backward t))))
do (setf (nth idx result) cursor))) ;; Keep searching until we run out of candidates.
(while (and cursor
(funcall pos-pred cursor)
(null (nth idx result)))
(setf (nth idx result)
(treesit-node-top-level cursor iter-pred t))
(setq cursor (treesit-search-forward
cursor regexp backward backward)))))
;; 2. Find the parent defun. ;; 2. Find the parent defun.
(setf (nth 2 result) (let ((cursor (or (nth 0 result) (nth 1 result) node))
(cl-loop for cursor = (or (nth 0 result) (iter-pred (lambda (node)
(nth 1 result) (and (string-match-p
node) regexp (treesit-node-type node))
then (treesit-node-parent cursor) (or (null pred) (funcall pred node))
while cursor (not (treesit-node-eq node (nth 0 result)))
if (and (string-match-p (not (treesit-node-eq node (nth 1 result)))
regexp (treesit-node-type cursor)) (< (treesit-node-start node)
(funcall pred cursor) pos
(not (member cursor result))) (treesit-node-end node))))))
return cursor)) (setf (nth 2 result)
(treesit-parent-until cursor iter-pred)))
result)) result))
(defun treesit--top-level-thing (node regexp &optional pred) (defun treesit--top-level-thing (node regexp &optional pred)
"Return the top-level parent thing of NODE. "Return the top-level parent thing of NODE.
REGEXP and PRED are the same as in `treesit-thing-at-point'." REGEXP and PRED are the same as in `treesit-thing-at-point'."
(let* ((pred (or pred (lambda (_) t)))) (treesit-node-top-level
;; `treesit-search-forward-goto' will make sure the matched node node (lambda (node)
;; is before POS. (and (string-match-p regexp (treesit-node-type node))
(cl-loop for cursor = node (or (null pred) (funcall pred node))))
then (treesit-node-parent cursor) t))
while cursor
if (and (string-match-p
regexp (treesit-node-type cursor))
(funcall pred cursor))
do (setq node cursor))
node))
;; The basic idea for nested defun navigation is that we first try to ;; The basic idea for nested defun navigation is that we first try to
;; move across sibling defuns in the same level, if no more siblings ;; move across sibling defuns in the same level, if no more siblings
@ -2040,6 +2044,91 @@ The delimiter between nested defun names is controlled by
(setq node (treesit-node-parent node))) (setq node (treesit-node-parent node)))
name)) name))
;;; Imenu
(defvar treesit-simple-imenu-settings nil
"Settings that configure `treesit-simple-imenu'.
It should be a list of (CATEGORY REGEXP PRED NAME-FN).
CATEGORY is the name of a category, like \"Function\", \"Class\",
etc. REGEXP should be a regexp matching the type of nodes that
belong to CATEGORY. PRED should be either nil or a function
that takes a node an the argument. It should return non-nil if
the node is a valid node for CATEGORY, or nil if not.
CATEGORY could also be nil. In that case the entries matched by
REGEXP and PRED are not grouped under CATEGORY.
NAME-FN should be either nil or a function that takes a defun
node and returns the name of that defun node. If NAME-FN is nil,
`treesit-defun-name' is used.
`treesit-major-mode-setup' automatically sets up Imenu if this
variable is non-nil.")
(defun treesit--simple-imenu-1 (node pred name-fn)
"Given a sparse tree, create an Imenu index.
NODE is a node in 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 index.
Return a list of entries where each ENTRY has the form:
ENTRY := (NAME . MARKER)
| (NAME . ((\" \" . MARKER)
ENTRY
...)
PRED and NAME-FN are the same as described in
`treesit-simple-imenu-settings'. NAME-FN computes NAME in an
ENTRY. MARKER marks the start of each tree-sitter node."
(let* ((ts-node (car node))
(children (cdr node))
(subtrees (mapcan (lambda (node)
(treesit--simple-imenu-1 node pred name-fn))
children))
;; The root of the tree could have a nil ts-node.
(name (when ts-node
(or (if name-fn
(funcall name-fn ts-node)
(treesit-defun-name ts-node))
"Anonymous")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
(cond
;; The tree-sitter node in the root node of the tree returned by
;; `treesit-induce-sparse-tree' is often nil.
((null ts-node)
subtrees)
;; This tree-sitter node is not a valid entry, skip it.
((and pred (not (funcall pred ts-node)))
subtrees)
;; Non-leaf node, return a (list of) subgroup.
(subtrees
`((,name
,(cons " " marker)
,@subtrees)))
;; Leaf node, return a (list of) plain index entry.
(t (list (cons name marker))))))
(defun treesit-simple-imenu ()
"Return an Imenu index for the current buffer."
(let ((root (treesit-buffer-root-node)))
(mapcan (lambda (setting)
(pcase-let ((`(,category ,regexp ,pred ,name-fn)
setting))
(when-let* ((tree (treesit-induce-sparse-tree
root regexp))
(index (treesit--simple-imenu-1
tree pred name-fn)))
(if category
(list (cons category index))
index))))
treesit-simple-imenu-settings)))
;;; Activating tree-sitter ;;; Activating tree-sitter
(defun treesit-ready-p (language &optional quiet) (defun treesit-ready-p (language &optional quiet)
@ -2097,6 +2186,11 @@ If `treesit-simple-indent-rules' is non-nil, setup indentation.
If `treesit-defun-type-regexp' is non-nil, setup If `treesit-defun-type-regexp' is non-nil, setup
`beginning/end-of-defun' functions. `beginning/end-of-defun' functions.
If `treesit-defun-name-function' is non-nil, setup
`add-log-current-defun'.
If `treesit-simple-imenu-settings' is non-nil, setup Imenu.
Make sure necessary parsers are created for the current buffer Make sure necessary parsers are created for the current buffer
before calling this function." before calling this function."
;; Font-lock. ;; Font-lock.
@ -2138,7 +2232,13 @@ before calling this function."
(when treesit-defun-name-function (when treesit-defun-name-function
(setq-local add-log-current-defun-function (setq-local add-log-current-defun-function
#'treesit-add-log-current-defun)) #'treesit-add-log-current-defun))
(setq-local transpose-sexps-function #'treesit-transpose-sexps))
(setq-local transpose-sexps-function #'treesit-transpose-sexps)
;; Imenu.
(when treesit-simple-imenu-settings
(setq-local imenu-create-index-function
#'treesit-simple-imenu)))
;;; Debugging ;;; Debugging

3
lisp/vc/diff-mode.el
View file

@ -272,8 +272,7 @@ and hunk-based syntax highlighting otherwise as a fallback."
(defcustom diff-minor-mode-prefix "\C-c=" (defcustom diff-minor-mode-prefix "\C-c="
"Prefix key for `diff-minor-mode' commands." "Prefix key for `diff-minor-mode' commands."
:type '(choice (string "ESC") :type '(choice (string "\e") (string "\C-c=") string))
(string "\C-c=") string))
(defvar-keymap diff-minor-mode-map (defvar-keymap diff-minor-mode-map
:doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'." :doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'."

30
nt/INSTALL.W64
View file

@ -31,13 +31,14 @@ build tools for MinGW-w64 -- see https://msys2.org/.
** Download and install MinGW-w64 and MSYS2 ** Download and install MinGW-w64 and MSYS2
Go to https://msys2.org and follow the instructions. It is not Go to https://msys2.org and follow the Installation instructions, up
necessary to install the packages suggested on those instructions. to where they say to use 'pacman -S' to install packages. Instead,
install the necessary packages as instructed in the next section.
** Download and install the necessary packages ** Download and install the necessary packages
Run mingw64.exe in your MSYS2 directory and you will see a BASH window Run mingw64.exe in your MSYS2 directory and you will see a BASH window
opened. open.
In the BASH prompt, use the following command to install the necessary In the BASH prompt, use the following command to install the necessary
packages (you can copy and paste it into the shell with Shift + Insert): packages (you can copy and paste it into the shell with Shift + Insert):
@ -45,6 +46,8 @@ packages (you can copy and paste it into the shell with Shift + Insert):
pacman -S --needed base-devel \ pacman -S --needed base-devel \
mingw-w64-x86_64-toolchain \ mingw-w64-x86_64-toolchain \
mingw-w64-x86_64-xpm-nox \ mingw-w64-x86_64-xpm-nox \
mingw-w64-x86_64-gmp \
mingw-w64-x86_64-gnutls \
mingw-w64-x86_64-libtiff \ mingw-w64-x86_64-libtiff \
mingw-w64-x86_64-giflib \ mingw-w64-x86_64-giflib \
mingw-w64-x86_64-libpng \ mingw-w64-x86_64-libpng \
@ -54,16 +57,21 @@ packages (you can copy and paste it into the shell with Shift + Insert):
mingw-w64-x86_64-lcms2 \ mingw-w64-x86_64-lcms2 \
mingw-w64-x86_64-jansson \ mingw-w64-x86_64-jansson \
mingw-w64-x86_64-libxml2 \ mingw-w64-x86_64-libxml2 \
mingw-w64-x86_64-gnutls \
mingw-w64-x86_64-zlib \ mingw-w64-x86_64-zlib \
mingw-w64-x86_64-harfbuzz mingw-w64-x86_64-harfbuzz \
mingw-w64-x86_64-libgccjit \
mingw-w64-x86_64-sqlite3 \
mingw-w64-x86_64-tree-sitter
The packages include the base developer tools (autoconf, grep, make, etc.), The packages include the base developer tools (autoconf, grep, make,
the compiler toolchain (gcc, gdb, etc.), several image libraries, an XML etc.), the compiler toolchain (gcc, gdb, etc.), several image
library, the GnuTLS (transport layer security) library, zlib for libraries, an XML library, the GnuTLS (transport layer security)
decompressing text, and HarfBuzz for use as the shaping engine. Only the library, zlib for decompressing text, HarfBuzz for use as the shaping
first three packages are required (base-devel, toolchain, xpm-nox); the engine, libgccjit for native-compilation support, SQLite3 for
rest are optional. You can select only part of the libraries if you don't accessing SQL databases, and the tree-sitter library used by some
major modes. Only the first four packages are required (base-devel,
toolchain, xpm-nox, GMP), and GnuTLS is highly recommended; the rest
are optional. You can select only part of the libraries if you don't
need them all. need them all.
You now have a complete build environment for Emacs. You now have a complete build environment for Emacs.

2
src/indent.c
View file

@ -887,6 +887,8 @@ DEFUN ("indent-to", Findent_to, Sindent_to, 1, 2, "NIndent to column: ",
Optional second argument MINIMUM says always do at least MINIMUM spaces Optional second argument MINIMUM says always do at least MINIMUM spaces
even if that goes past COLUMN; by default, MINIMUM is zero. even if that goes past COLUMN; by default, MINIMUM is zero.
Whether this uses tabs or spaces depends on `indent-tabs-mode'.
The return value is the column where the insertion ends. */) The return value is the column where the insertion ends. */)
(Lisp_Object column, Lisp_Object minimum) (Lisp_Object column, Lisp_Object minimum)
{ {

79
src/json.c
View file

@ -555,6 +555,40 @@ json_parse_args (ptrdiff_t nargs,
} }
} }
static bool
json_available_p (void)
{
#ifdef WINDOWSNT
if (!json_initialized)
{
Lisp_Object status;
json_initialized = init_json_functions ();
status = json_initialized ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
return json_initialized;
#else /* !WINDOWSNT */
return true;
#endif
}
#ifdef WINDOWSNT
static void
ensure_json_available (void)
{
if (!json_available_p ())
Fsignal (Qjson_unavailable,
list1 (build_unibyte_string ("jansson library not found")));
}
#endif
DEFUN ("json--available-p", Fjson__available_p, Sjson__available_p, 0, 0, NULL,
doc: /* Return non-nil if libjansson is available (internal use only). */)
(void)
{
return json_available_p () ? Qt : Qnil;
}
DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY, DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY,
NULL, NULL,
doc: /* Return the JSON representation of OBJECT as a string. doc: /* Return the JSON representation of OBJECT as a string.
@ -587,16 +621,7 @@ usage: (json-serialize OBJECT &rest ARGS) */)
specpdl_ref count = SPECPDL_INDEX (); specpdl_ref count = SPECPDL_INDEX ();
#ifdef WINDOWSNT #ifdef WINDOWSNT
if (!json_initialized) ensure_json_available ();
{
Lisp_Object status;
json_initialized = init_json_functions ();
status = json_initialized ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
Fsignal (Qjson_unavailable,
list1 (build_unibyte_string ("jansson library not found")));
#endif #endif
struct json_configuration conf = struct json_configuration conf =
@ -696,16 +721,7 @@ usage: (json-insert OBJECT &rest ARGS) */)
specpdl_ref count = SPECPDL_INDEX (); specpdl_ref count = SPECPDL_INDEX ();
#ifdef WINDOWSNT #ifdef WINDOWSNT
if (!json_initialized) ensure_json_available ();
{
Lisp_Object status;
json_initialized = init_json_functions ();
status = json_initialized ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
Fsignal (Qjson_unavailable,
list1 (build_unibyte_string ("jansson library not found")));
#endif #endif
struct json_configuration conf = struct json_configuration conf =
@ -953,16 +969,7 @@ usage: (json-parse-string STRING &rest ARGS) */)
specpdl_ref count = SPECPDL_INDEX (); specpdl_ref count = SPECPDL_INDEX ();
#ifdef WINDOWSNT #ifdef WINDOWSNT
if (!json_initialized) ensure_json_available ();
{
Lisp_Object status;
json_initialized = init_json_functions ();
status = json_initialized ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
Fsignal (Qjson_unavailable,
list1 (build_unibyte_string ("jansson library not found")));
#endif #endif
Lisp_Object string = args[0]; Lisp_Object string = args[0];
@ -1050,16 +1057,7 @@ usage: (json-parse-buffer &rest args) */)
specpdl_ref count = SPECPDL_INDEX (); specpdl_ref count = SPECPDL_INDEX ();
#ifdef WINDOWSNT #ifdef WINDOWSNT
if (!json_initialized) ensure_json_available ();
{
Lisp_Object status;
json_initialized = init_json_functions ();
status = json_initialized ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
Fsignal (Qjson_unavailable,
list1 (build_unibyte_string ("jansson library not found")));
#endif #endif
struct json_configuration conf = struct json_configuration conf =
@ -1137,6 +1135,7 @@ syms_of_json (void)
DEFSYM (Qplist, "plist"); DEFSYM (Qplist, "plist");
DEFSYM (Qarray, "array"); DEFSYM (Qarray, "array");
defsubr (&Sjson__available_p);
defsubr (&Sjson_serialize); defsubr (&Sjson_serialize);
defsubr (&Sjson_insert); defsubr (&Sjson_insert);
defsubr (&Sjson_parse_string); defsubr (&Sjson_parse_string);

59
src/treesit.c
View file

@ -2,6 +2,8 @@
Copyright (C) 2021-2022 Free Software Foundation, Inc. Copyright (C) 2021-2022 Free Software Foundation, Inc.
Maintainer: Yuan Fu <casouri@gmail.com>
This file is part of GNU Emacs. This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify GNU Emacs is free software: you can redistribute it and/or modify
@ -2168,6 +2170,8 @@ See Info node `(elisp)Pattern Matching' for detailed explanation. */)
return build_pure_c_string ("#equal"); return build_pure_c_string ("#equal");
if (EQ (pattern, QCmatch)) if (EQ (pattern, QCmatch))
return build_pure_c_string ("#match"); return build_pure_c_string ("#match");
if (EQ (pattern, QCpred))
return build_pure_c_string ("#pred");
Lisp_Object opening_delimeter Lisp_Object opening_delimeter
= build_pure_c_string (VECTORP (pattern) ? "[" : "("); = build_pure_c_string (VECTORP (pattern) ? "[" : "(");
Lisp_Object closing_delimiter Lisp_Object closing_delimiter
@ -2267,10 +2271,10 @@ treesit_predicates_for_pattern (TSQuery *query, uint32_t pattern_index)
return Fnreverse (result); return Fnreverse (result);
} }
/* Translate a capture NAME (symbol) to the text of the captured node. /* Translate a capture NAME (symbol) to a node.
Signals treesit-query-error if such node is not captured. */ Signals treesit-query-error if such node is not captured. */
static Lisp_Object static Lisp_Object
treesit_predicate_capture_name_to_text (Lisp_Object name, treesit_predicate_capture_name_to_node (Lisp_Object name,
struct capture_range captures) struct capture_range captures)
{ {
Lisp_Object node = Qnil; Lisp_Object node = Qnil;
@ -2290,6 +2294,16 @@ treesit_predicate_capture_name_to_text (Lisp_Object name,
name, build_pure_c_string ("A predicate can only refer" name, build_pure_c_string ("A predicate can only refer"
" to captured nodes in the " " to captured nodes in the "
"same pattern")); "same pattern"));
return node;
}
/* 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 = treesit_predicate_capture_name_to_node (name, captures);
struct buffer *old_buffer = current_buffer; struct buffer *old_buffer = current_buffer;
set_buffer_internal (XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer)); set_buffer_internal (XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer));
@ -2363,13 +2377,30 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures)
return false; return false;
} }
/* About predicates: I decide to hard-code predicates in C instead of /* Handles predicate (#pred FN ARG...). Return true if FN returns
implementing an extensible system where predicates are translated non-nil; return false otherwise. The arity of FN must match the
to Lisp functions, and new predicates can be added by extending a number of ARGs */
list of functions, because I really couldn't imagine any useful static bool
predicates besides equal and match. If we later found out that treesit_predicate_pred (Lisp_Object args, struct capture_range captures)
such system is indeed useful and necessary, it can be easily {
added. */ if (XFIXNUM (Flength (args)) < 2)
xsignal2 (Qtreesit_query_error,
build_pure_c_string ("Predicate `pred' requires "
"at least two arguments, "
"but was only given"),
Flength (args));
Lisp_Object fn = Fintern (XCAR (args), Qnil);
Lisp_Object nodes = Qnil;
Lisp_Object tail = XCDR (args);
FOR_EACH_TAIL (tail)
nodes = Fcons (treesit_predicate_capture_name_to_node (XCAR (tail),
captures),
nodes);
nodes = Fnreverse (nodes);
return !NILP (CALLN (Fapply, fn, nodes));
}
/* If all predicates in PREDICATES passes, return true; otherwise /* If all predicates in PREDICATES passes, return true; otherwise
return false. */ return false. */
@ -2385,14 +2416,17 @@ treesit_eval_predicates (struct capture_range captures, Lisp_Object predicates)
Lisp_Object fn = XCAR (predicate); Lisp_Object fn = XCAR (predicate);
Lisp_Object args = XCDR (predicate); Lisp_Object args = XCDR (predicate);
if (!NILP (Fstring_equal (fn, build_pure_c_string ("equal")))) if (!NILP (Fstring_equal (fn, build_pure_c_string ("equal"))))
pass = treesit_predicate_equal (args, captures); pass &= treesit_predicate_equal (args, captures);
else if (!NILP (Fstring_equal (fn, build_pure_c_string ("match")))) else if (!NILP (Fstring_equal (fn, build_pure_c_string ("match"))))
pass = treesit_predicate_match (args, captures); pass &= treesit_predicate_match (args, captures);
else if (!NILP (Fstring_equal (fn, build_pure_c_string ("pred"))))
pass &= treesit_predicate_pred (args, captures);
else else
xsignal3 (Qtreesit_query_error, xsignal3 (Qtreesit_query_error,
build_pure_c_string ("Invalid predicate"), build_pure_c_string ("Invalid predicate"),
fn, build_pure_c_string ("Currently Emacs only supports" fn, build_pure_c_string ("Currently Emacs only supports"
" equal and match predicate")); " equal, match, and pred"
" predicate"));
} }
/* If all predicates passed, add captures to result list. */ /* If all predicates passed, add captures to result list. */
return pass; return pass;
@ -3215,6 +3249,7 @@ syms_of_treesit (void)
DEFSYM (QCanchor, ":anchor"); DEFSYM (QCanchor, ":anchor");
DEFSYM (QCequal, ":equal"); DEFSYM (QCequal, ":equal");
DEFSYM (QCmatch, ":match"); DEFSYM (QCmatch, ":match");
DEFSYM (QCpred, ":pred");
DEFSYM (Qnot_found, "not-found"); DEFSYM (Qnot_found, "not-found");
DEFSYM (Qsymbol_error, "symbol-error"); DEFSYM (Qsymbol_error, "symbol-error");

13
src/w32menu.c
View file

@ -1073,7 +1073,10 @@ is_simple_dialog (Lisp_Object contents)
if (NILP (Fstring_equal (name, other))) if (NILP (Fstring_equal (name, other)))
return false; return false;
/* Check there are no more options. */ /* Check there are no more options.
(FIXME: Since we use MB_YESNOCANCEL, we could also consider
dialogs with 3 options: Yes/No/Cancel as "simple". */
options = XCDR (options); options = XCDR (options);
return !(CONSP (options)); return !(CONSP (options));
} }
@ -1085,7 +1088,13 @@ simple_dialog_show (struct frame *f, Lisp_Object contents, Lisp_Object header)
UINT type; UINT type;
Lisp_Object lispy_answer = Qnil, temp = XCAR (contents); Lisp_Object lispy_answer = Qnil, temp = XCAR (contents);
type = MB_YESNO; /* We use MB_YESNOCANCEL to allow the user the equivalent of C-g
when the Yes/No question is asked vya y-or-n-p or
yes-or-no-p. */
if (w32_yes_no_dialog_show_cancel)
type = MB_YESNOCANCEL;
else
type = MB_YESNO;
/* Since we only handle Yes/No dialogs, and we already checked /* Since we only handle Yes/No dialogs, and we already checked
is_simple_dialog, we don't need to worry about checking contents is_simple_dialog, we don't need to worry about checking contents

11
src/w32term.c
View file

@ -7696,6 +7696,7 @@ static void
w32_initialize (void) w32_initialize (void)
{ {
HANDLE shell; HANDLE shell;
BOOL caret;
HRESULT (WINAPI * set_user_model) (const wchar_t * id); HRESULT (WINAPI * set_user_model) (const wchar_t * id);
baud_rate = 19200; baud_rate = 19200;
@ -7732,8 +7733,9 @@ w32_initialize (void)
/* Initialize w32_use_visible_system_caret based on whether a screen /* Initialize w32_use_visible_system_caret based on whether a screen
reader is in use. */ reader is in use. */
if (!SystemParametersInfo (SPI_GETSCREENREADER, 0, if (SystemParametersInfo (SPI_GETSCREENREADER, 0, &caret, 0))
&w32_use_visible_system_caret, 0)) w32_use_visible_system_caret = caret == TRUE;
else
w32_use_visible_system_caret = 0; w32_use_visible_system_caret = 0;
any_help_event_p = 0; any_help_event_p = 0;
@ -7923,6 +7925,11 @@ unconditionally set to nil on older systems. */);
w32_use_native_image_api = 0; w32_use_native_image_api = 0;
#endif #endif
DEFVAR_BOOL ("w32-yes-no-dialog-show-cancel",
w32_yes_no_dialog_show_cancel,
doc: /* If non-nil, show Cancel button in MS-Windows GUI Yes/No dialogs. */);
w32_yes_no_dialog_show_cancel = 1;
/* FIXME: The following variable will be (hopefully) removed /* FIXME: The following variable will be (hopefully) removed
before Emacs 25.1 gets released. */ before Emacs 25.1 gets released. */

8
src/xdisp.c
View file

@ -14271,12 +14271,14 @@ redisplay_tab_bar (struct frame *f)
frame_default_tab_bar_height = new_height; frame_default_tab_bar_height = new_height;
} }
/* If new_height or new_nrows indicate that we need to enlarge the /* If new_height or new_nrows indicate that we need to enlarge or
tab-bar window, we can return right away. */ shrink the tab-bar window, we can return right away. */
if (new_nrows > f->n_tab_bar_rows if (new_nrows > f->n_tab_bar_rows
|| (EQ (Vauto_resize_tab_bars, Qgrow_only) || (EQ (Vauto_resize_tab_bars, Qgrow_only)
&& !f->minimize_tab_bar_window_p && !f->minimize_tab_bar_window_p
&& new_height > WINDOW_PIXEL_HEIGHT (w))) && new_height > WINDOW_PIXEL_HEIGHT (w))
|| (! EQ (Vauto_resize_tab_bars, Qgrow_only)
&& new_height < WINDOW_PIXEL_HEIGHT (w)))
{ {
if (FRAME_TERMINAL (f)->change_tab_bar_height_hook) if (FRAME_TERMINAL (f)->change_tab_bar_height_hook)
FRAME_TERMINAL (f)->change_tab_bar_height_hook (f, new_height); FRAME_TERMINAL (f)->change_tab_bar_height_hook (f, new_height);

54
test/lisp/erc/erc-scenarios-base-unstable.el
View file

@ -24,7 +24,7 @@
(let ((load-path (cons (ert-resource-directory) load-path))) (let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-scenarios-common))) (require 'erc-scenarios-common)))
(eval-when-compile (require 'erc-join)) (eval-when-compile (require 'erc-join) (require 'warnings))
;; Not unstable, but stashed here for now ;; Not unstable, but stashed here for now
@ -132,4 +132,56 @@
(not (setq failed (zerop (cl-decf tries))))))) (not (setq failed (zerop (cl-decf tries)))))))
(should-not failed))) (should-not failed)))
;; The `erc-networks' library has slowly become a hard dependency of
;; the interactive client since its incorporation in 2006. But its
;; module, which was added in ERC 5.3 (2008) and thereafter loaded by
;; default, only became quasi-required in ERC 5.5 (2022). Despite
;; this, a basic connection should still always succeed, at least long
;; enough to warn users that their setup is abnormal. Of course,
;; third-party code intentionally omitting the module will have to
;; override various erc-server-*-functions to avoid operating in a
;; degraded state, which has likely been the case for a while.
(ert-deftest erc-scenarios-networks-no-module ()
:tags '(:expensive-test)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "networks/no-module")
(erc-server-flood-penalty 0.1)
(erc-networks-mode-orig erc-networks-mode)
(dumb-server (erc-d-run "localhost" t 'basic))
(port (process-contact dumb-server :service))
(erc-modules (remq 'networks erc-modules))
(warning-suppress-log-types '((erc)))
(expect (erc-d-t-make-expecter)))
(erc-networks-mode -1)
(ert-info ("Connect and retain dialed name")
(with-current-buffer (erc :server "127.0.0.1"
:port port
:nick "tester"
:user "tester"
:full-name "tester")
(funcall expect 10 "Required module `networks' not loaded")
(funcall expect 10 "This server is in debug mode")
;; Buffer not named after network
(should (string= (buffer-name) (format "127.0.0.1:%d" port)))
(erc-cmd-JOIN "#chan")))
(ert-info ("Join #chan, change nick, query op")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(funcall expect 20 "Even at thy teat thou")
(erc-cmd-NICK "dummy")
(funcall expect 10 "Your new nickname is dummy")
(erc-scenarios-common-say "/msg alice hi")))
(ert-info ("Switch to query and quit")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "alice"))
(funcall expect 20 "bye"))
(with-current-buffer (format "127.0.0.1:%d" port)
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))
(when erc-networks-mode-orig
(erc-networks-mode +1))))
;;; erc-scenarios-base-unstable.el ends here ;;; erc-scenarios-base-unstable.el ends here

44
test/lisp/erc/resources/networks/no-module/basic.eld Normal file
View file

@ -0,0 +1,44 @@
;; -*- mode: lisp-data; -*-
((nick 10 "NICK tester"))
((user 1 "USER tester 0 * :tester")
(0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
(0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0")
(0.00 ":irc.foonet.org 003 tester :This server was created Mon, 12 Dec 2022 01:25:38 UTC")
(0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
(0.00 ":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.00 ":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 4 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 4 clients and 0 servers")
(0.00 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
(0.01 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
(0.00 ":irc.foonet.org 422 tester :MOTD File is missing"))
((mode 10 "MODE tester +i")
(0.00 ":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."))
((join 10 "JOIN #chan")
(0.03 ":tester!~u@z5d6jyn8pwxge.irc JOIN #chan"))
((~nick 10 "NICK dummy")
(0.01 ":tester!~u@z5d6jyn8pwxge.irc NICK dummy"))
((mode-1 10 "MODE #chan")
(0.01 ":irc.foonet.org 353 tester = #chan :@alice bob foonet tester")
(0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list")
(0.03 ":irc.foonet.org 324 tester #chan +nt")
(0.00 ":irc.foonet.org 329 tester #chan 1670808354")
(0.00 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!")
(0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!")
(0.03 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :alice: Forbear it therefore; give your cause to heaven.")
(0.01 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :bob: Even at thy teat thou hadst thy tyranny."))
((privmsg 10 "PRIVMSG alice :hi")
(0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG dummy :bye"))
((quit 10 "QUIT :\2ERC\2")
(0.03 ":dummy!~u@z5d6jyn8pwxge.irc QUIT :Quit: \2ERC\2"))

121
test/src/treesit-tests.el
View file

@ -252,9 +252,7 @@ BODY is the test body."
(setq parser (treesit-parser-create 'json)) (setq parser (treesit-parser-create 'json))
(setq root (treesit-parser-root-node (setq root (treesit-parser-root-node
parser)) parser))
(setq array (treesit-node-child root 0)) (setq array (treesit-node-child root 0)))
;; First bracket.
(setq cursor (treesit-node-child array 0)))
,@body))) ,@body)))
(ert-deftest treesit-search-forward () (ert-deftest treesit-search-forward ()
@ -335,6 +333,9 @@ BODY is the test body."
;;; Query ;;; Query
(defun treesit--ert-pred-last-sibling (node)
(null (treesit-node-next-sibling node t)))
(ert-deftest treesit-query-api () (ert-deftest treesit-query-api ()
"Tests for query API." "Tests for query API."
(skip-unless (treesit-language-available-p 'json)) (skip-unless (treesit-language-available-p 'json))
@ -357,13 +358,16 @@ BODY is the test body."
(pair key: (_) @keyword) (pair key: (_) @keyword)
((_) @bob (#match \"^B.b$\" @bob)) ((_) @bob (#match \"^B.b$\" @bob))
(number) @number (number) @number
((number) @n3 (#equal \"3\" @n3)) " ((number) @n3 (#equal \"3\" @n3))
((number) @n3p (#pred treesit--ert-pred-last-sibling @n3p))"
;; Sexp query. ;; Sexp query.
((string) @string ((string) @string
(pair key: (_) @keyword) (pair key: (_) @keyword)
((_) @bob (:match "^B.b$" @bob)) ((_) @bob (:match "^B.b$" @bob))
(number) @number (number) @number
((number) @n3 (:equal "3" @n3))))) ((number) @n3 (:equal "3" @n3))
((number) @n3p (:pred treesit--ert-pred-last-sibling
@n3p)))))
;; Test `treesit-query-compile'. ;; Test `treesit-query-compile'.
(dolist (query (list query1 (dolist (query (list query1
(treesit-query-compile 'json query1))) (treesit-query-compile 'json query1)))
@ -375,7 +379,8 @@ BODY is the test body."
(string . "\"Bob\"") (string . "\"Bob\"")
(bob . "Bob") (bob . "Bob")
(number . "3") (number . "3")
(n3 . "3")) (n3 . "3")
(n3p . "3"))
(mapcar (lambda (entry) (mapcar (lambda (entry)
(cons (car entry) (cons (car entry)
(treesit-node-text (treesit-node-text
@ -831,36 +836,40 @@ OPENING and CLOSING are the same as in
and \"]\"." and \"]\"."
(with-temp-buffer (with-temp-buffer
(funcall init) (funcall init)
(let* ((opening (or opening "[")) (pcase-let*
(closing (or closing "]")) ((opening (or opening "["))
;; Insert program and parse marker positions. (closing (or closing "]"))
(marker-alist (treesit--ert-insert-and-parse-marker ;; Insert program and parse marker positions.
opening closing program)) (marker-alist (treesit--ert-insert-and-parse-marker
;; Translate marker positions into buffer positions. opening closing program))
(decoded-master ;; Translate marker positions into buffer positions.
(cl-loop for record in master (decoded-master
collect (cl-loop for record in master
(cl-loop for pos in record collect
collect (alist-get pos marker-alist)))) (cl-loop for pos in record
;; Collect positions each function returns. collect (alist-get pos marker-alist))))
(positions (`(,regexp . ,pred) (treesit--thing-unpack-pattern
(treesit--ert-collect-positions treesit-defun-type-regexp))
;; The first column of DECODED-MASTER. ;; Collect positions each function returns.
(mapcar #'car decoded-master) (positions
;; Four functions: next-end, prev-beg, next-beg, prev-end. (treesit--ert-collect-positions
(mapcar (lambda (conf) ;; The first column of DECODED-MASTER.
(lambda () (mapcar #'car decoded-master)
(if-let ((pos (funcall ;; Four functions: next-end, prev-beg, next-beg, prev-end.
#'treesit--navigate-defun (mapcar (lambda (conf)
(point) (car conf) (cdr conf)))) (lambda ()
(save-excursion (if-let ((pos (funcall
(goto-char pos) #'treesit--navigate-thing
(funcall treesit-defun-skipper) (point) (car conf) (cdr conf)
(point))))) regexp pred)))
'((-1 . beg) (save-excursion
(1 . end) (goto-char pos)
(-1 . end) (funcall treesit-defun-skipper)
(1 . beg)))))) (point)))))
'((-1 . beg)
(1 . end)
(-1 . end)
(1 . beg))))))
;; Verify each position. ;; Verify each position.
(cl-loop for record in decoded-master (cl-loop for record in decoded-master
for orig-record in master for orig-record in master
@ -931,7 +940,28 @@ and \"]\"."
[999]} [999]}
[110] [110]
" "
"Javascript source for navigation test.") "Bash source for navigation test.")
(defvar treesit--ert-defun-navigation-elixir-program
"[100]
[101]def bar() do
[999]end
[102]
[103]defmodule Example do[0]
[999] @impl true
[104] [1]def bar() do[2]
[999] end[3]
[105] [4]
[106] [5]def baz() do[6]
[999] end[7]
[107] [8]
[999]end[9]
[108]
[109]def bar() do
[999]end
[110]
"
"Elixir source for navigation test.")
(defvar treesit--ert-defun-navigation-nested-master (defvar treesit--ert-defun-navigation-nested-master
;; START PREV-BEG NEXT-END PREV-END NEXT-BEG ;; START PREV-BEG NEXT-END PREV-END NEXT-BEG
@ -1013,6 +1043,23 @@ the prev-beg, now point should be at marker 103\", etc.")
treesit--ert-defun-navigation-bash-program treesit--ert-defun-navigation-bash-program
treesit--ert-defun-navigation-nested-master))) treesit--ert-defun-navigation-nested-master)))
(ert-deftest treesit-defun-navigation-nested-4 ()
"Test defun navigation using Elixir.
This tests bug#60355."
(skip-unless (treesit-language-available-p 'elixir))
;; Nested defun navigation
(let ((treesit-defun-tactic 'nested)
(pred (lambda (node)
(member (treesit-node-text
(treesit-node-child-by-field-name node "target"))
'("def" "defmodule")))))
(treesit--ert-test-defun-navigation
(lambda ()
(treesit-parser-create 'elixir)
(setq-local treesit-defun-type-regexp `("call" . ,pred)))
treesit--ert-defun-navigation-elixir-program
treesit--ert-defun-navigation-nested-master)))
(ert-deftest treesit-defun-navigation-top-level () (ert-deftest treesit-defun-navigation-top-level ()
"Test top-level only defun navigation." "Test top-level only defun navigation."
(skip-unless (treesit-language-available-p 'python)) (skip-unless (treesit-language-available-p 'python))