mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-11 00:30:17 -08:00
Code Issues Projects Releases Wiki Activity

Merge from origin/emacs-29

Browse source 
db72787380 ruby-ts-mode: Use font-lock-constant-face for true/false/nil
819719330a (ruby-ts--indent-rules): Add a rule for continuation of a...
94b9cbf96f (ruby-ts--parent-call-or-bol): Handle more cases with nes...
ba33b83ce4 (ruby-ts--statement-container-regexp): Remove "parenthesi...
f2bedf695c ruby-ts-mode: Handle indent in parenless calls much close...
758ac5eabb Fix split-window-below for the case when split-window-kee...
8e9783b4ce Rebind in read-regexp-map ‘M-c’ to ‘M-s c’ compatible wit...
78f93d92b2 * lisp/vc/vc-dir.el: Make keys ‘% m’ and ‘* %’ compatible...
dc3f85fd4b Use proper types for Eshell warnings
6a8338a8bc ; Avoid byte-compiler warning in cc-fonts.el.
9186be20ae ; Clarify doc strings of some functions in files.el
bd5ef3ef95 Improve the documentation of 'auto-mode-alist' search
1798ff5a66 ; Fix minor mistakes in documentation
faee7e1f1b ; * lisp/treesit.el (treesit-font-lock-fontify-region): M...
24f0dfd373 Revert "Revert "Add c-or-c++-ts-mode (bug#59613)""
ac3bc775b6 Make it harder to misactivate tree-sitter font-lock fast ...
bdd82fa797 ; * src/treesit.c: Remove unused boilerplate.
343b9b3dfe ruby-ts-mode: Obey the option ruby-method-call-indent
045404d1aa ruby-ts-mode: Obey the option ruby-after-operator-indent
300ca6ac37 ruby-ts-mode: Fix indent after operator or conditional
ac5516bd7d ruby-ts-mode: Fix/change indentation of a continuation me...
5e2e68a0c2 ruby-ts-mode: Fix indent inside parenthesized_expr and el...
9ed9ff4690 ruby-ts-mode: Fix the rules for hanging arrays and hashes
c4f0b6ccea Add more detail about how to invoke Eshell commands
dbac923b9d CC Mode: On removal of "typedef", remove pertinent types ...
56d69c2fc4 ; Relax timeouts for failing ERC test
183e749270 Don't preserve non-module minor modes in erc-open
7b8322f628 Use correct buffer for local-module vars in erc-open
7b13422298 ; Avoid plist-get as generalized var in erc-compat
09e9d7c749 Fix display of warnings on w32 console
bd094207c7 Fix buffer-list-update-hook for indirect buffers
9e7a5d58ee ; Fix tree-sitter indent anchor preset
7c61a30410 Fix treesit-node-first-child-for-pos (bug#60127)
b36cc7e7bb ; * src/treesit.c (Ftreesit_induce_sparse_tree): Minor ch...

# Conflicts:
#	etc/NEWS
This commit is contained in:
Stefan Kangas 2023-01-19 06:30:25 +01:00
commit 9161a302c9
33 changed files with 804 additions and 261 deletions
Download patch file Download diff file Expand all files Collapse all files

9
doc/emacs/maintaining.texi
View file

@ -1331,11 +1331,18 @@ point is on a directory entry, mark all files in that directory tree
listed files and directories. listed files and directories.
@findex vc-dir-mark-by-regexp @findex vc-dir-mark-by-regexp
@item % @item % m
@itemx * %
You can use this command to mark files by regexp You can use this command to mark files by regexp
(@code{vc-dir-mark-by-regexp}). If given a prefix, unmark files (@code{vc-dir-mark-by-regexp}). If given a prefix, unmark files
instead. instead.
@findex vc-dir-mark-registered-files
@item * r
You can use this command to mark files that are in one of registered
states, including edited, added or removed.
(@code{vc-dir-mark-registered-files}).
@item G @item G
Add the file under point to the list of files that the VC should Add the file under point to the list of files that the VC should
ignore (@code{vc-dir-ignore}). For instance, if the VC is Git, it ignore (@code{vc-dir-ignore}). For instance, if the VC is Git, it

13
doc/emacs/modes.texi
View file

@ -430,10 +430,15 @@ For example, one element normally found in the list has the form
mode for files whose names end in @file{.c}. (Note that @samp{\\} is mode for files whose names end in @file{.c}. (Note that @samp{\\} is
needed in Lisp syntax to include a @samp{\} in the string, which must needed in Lisp syntax to include a @samp{\} in the string, which must
be used to suppress the special meaning of @samp{.} in regexps.) If be used to suppress the special meaning of @samp{.} in regexps.) If
the element has the form @code{(@var{regexp} @var{mode-function} the element has the form @w{@code{(@var{regexp} @var{mode-function}
@var{flag})} and @var{flag} is non-@code{nil}, then after calling @var{flag})}} and @var{flag} is non-@code{nil}, then after calling
@var{mode-function}, Emacs discards the suffix that matched @var{mode-function} (if it is non-@code{nil}), Emacs discards the
@var{regexp} and searches the list again for another match. suffix that matched @var{regexp} and searches the list again for
another match. This ``recursive extension stripping'' is used for
files which have multiple extensions, and the ``outer'' extension
hides the ``inner'' one that actually specifies the right mode. For
example, backup files and GPG-encrypted files with @file{.gpg}
extension use this feature.
@vindex auto-mode-case-fold @vindex auto-mode-case-fold
On GNU/Linux and other systems with case-sensitive file names, Emacs On GNU/Linux and other systems with case-sensitive file names, Emacs

2
doc/lispref/minibuf.texi
View file

@ -312,7 +312,7 @@ to @code{regexp-history}.
@cindex @code{case-fold}, text property @cindex @code{case-fold}, text property
@findex read-regexp-case-fold-search @findex read-regexp-case-fold-search
The user can use the @kbd{M-c} command to indicate whether case The user can use the @kbd{M-s c} command to indicate whether case
folding should be on or off. If the user has used this command, the folding should be on or off. If the user has used this command, the
returned string will have the text property @code{case-fold} set to returned string will have the text property @code{case-fold} set to
either @code{fold} or @code{inhibit-fold}. It is up to the caller of either @code{fold} or @code{inhibit-fold}. It is up to the caller of

4
doc/lispref/strings.texi
View file

@ -911,8 +911,8 @@ This function returns a new string containing one character,
@end defun @end defun
@defun string-to-char string @defun string-to-char string
This function returns the first character in @var{string}. This This function returns the first character in @var{string}. This is
mostly identical to @code{(aref string 0)}, except that it returns 0 mostly identical to @w{@code{(aref string 0)}}, except that it returns 0
if the string is empty. (The value is also 0 when the first character if the string is empty. (The value is also 0 when the first character
of @var{string} is the null character, @acronym{ASCII} code 0.) This of @var{string} is the null character, @acronym{ASCII} code 0.) This
function may be eliminated in the future if it does not seem useful function may be eliminated in the future if it does not seem useful

136
doc/misc/eshell.texi
View file

@ -64,10 +64,11 @@ modify this GNU manual.''
Eshell is a shell-like command interpreter implemented in Emacs Lisp. Eshell is a shell-like command interpreter implemented in Emacs Lisp.
It invokes no external processes except for those requested by the It invokes no external processes except for those requested by the
user. It is intended to be an alternative to the IELM (@pxref{Lisp Interaction, Emacs Lisp Interaction, , emacs, The Emacs Editor}) user. It is intended to be an alternative to the IELM (@pxref{Lisp
REPL for Emacs @emph{and} with an interface similar to command shells Interaction, Emacs Lisp Interaction, , emacs, The Emacs Editor})
such as @command{bash}, @command{zsh}, @command{rc}, or REPL@footnote{Short for ``Read-Eval-Print Loop''.} for Emacs
@command{4dos}. @emph{and} with an interface similar to command shells such as
@command{bash}, @command{zsh}, @command{rc}, or @command{4dos}.
@c This manual is updated to release 2.4 of Eshell. @c This manual is updated to release 2.4 of Eshell.
@insertcopying @insertcopying
@ -193,6 +194,13 @@ In a command shell, everything is done by invoking commands. This
chapter covers command invocations in Eshell, including the command chapter covers command invocations in Eshell, including the command
history and invoking commands in a script file. history and invoking commands in a script file.
Unlike regular system shells, Eshell never invokes kernel functions
directly, such as @code{exec(3)}. Instead, it uses the Lisp functions
available in the Emacs Lisp library. It does this by transforming the
input line into a callable Lisp form.@footnote{To see the Lisp form
that will be invoked, type this as the Eshell prompt:
@kbd{eshell-parse-command 'echo hello'}}
@menu @menu
* Invocation:: * Invocation::
* Arguments:: * Arguments::
@ -207,23 +215,16 @@ history and invoking commands in a script file.
@node Invocation @node Invocation
@section Invocation @section Invocation
Unlike regular system shells, Eshell never invokes kernel functions Eshell is both a command shell and an Emacs Lisp @acronym{REPL}. As a
directly, such as @code{exec(3)}. Instead, it uses the Lisp functions result, you can invoke commands in two different ways: in @dfn{command
available in the Emacs Lisp library. It does this by transforming the form} or in @dfn{lisp form}.
input line into a callable Lisp form.@footnote{To see the Lisp form that will be invoked, type: @samp{eshell-parse-command "echo hello"}}
The command can be either an Elisp function or an external command. You can use the semicolon (@code{;}) to separate multiple command
Eshell looks first for an alias (@pxref{Aliases}) with the same name as the invocations on a single line, executing each in turn. You can also
command, then a built-in (@pxref{Built-ins}) or a function with the separate commands with @code{&&} or @code{||}. When using @code{&&},
same name; if there is no match, it then tries to execute it as an Eshell will execute the second command only if the first succeeds
external command. (i.e.@: has an exit status of 0); with @code{||}, Eshell will execute
the second command only if the first fails.
The semicolon (@code{;}) can be used to separate multiple command
invocations on a single line. You can also separate commands with
@code{&&} or @code{||}. When using @code{&&}, Eshell will execute the
second command only if the first succeeds (i.e.@: has an exit
status of 0); with @code{||}, Eshell will execute the second command
only if the first fails.
A command invocation followed by an ampersand (@code{&}) will be run A command invocation followed by an ampersand (@code{&}) will be run
in the background. Eshell has no job control, so you can not suspend in the background. Eshell has no job control, so you can not suspend
@ -232,12 +233,80 @@ the foreground. That said, background processes invoked from Eshell
can be controlled the same way as any other background process in can be controlled the same way as any other background process in
Emacs. Emacs.
@subsection Command form
Command form looks much the same as in other shells. A command
consists of arguments separated by spaces; the first argument is the
command to run, with any subsequent arguments being passed to that
command.
@example
~ $ echo hello
hello
@end example
@cindex order of looking for commands
@cindex command lookup order
The command can be either an Elisp function or an external command.
Eshell looks for the command in the following order:
@enumerate
@item
As a command alias (@pxref{Aliases})
@item
As a built-in command (@pxref{Built-ins})
@item
As an external program
@item
As an ordinary Lisp function
@end enumerate
@vindex eshell-prefer-lisp-functions
If you would prefer to use ordinary Lisp functions over external
programs, set the option @code{eshell-prefer-lisp-functions} to
@code{t}. This will swap the lookup order of the last two items.
You can also group command forms together into a subcommand with curly
braces (@code{@{@}}). This lets you use the output of a subcommand as
an argument to another command, or within control flow statements
(@pxref{Control Flow}).
@example
~ $ echo @{echo hello; echo there@}
hellothere
@end example
@subsection Lisp form
Lisp form looks like ordinary Emacs Lisp code, because that's what it
is. As a result, you can use any syntax normally available to an
Emacs Lisp program (@pxref{Top, , , elisp, The Emacs Lisp Reference
Manual}).
@example
~ $ (format "hello, %s" user-login-name)
hello, user
@end example
In addition, you can @emph{combine} command forms and Lisp forms
together into single statements, letting you use whatever form is the
most convenient for expressing your intentions.
@example
~ $ ls *.patch > (format-time-string "%F.log")
@end example
This command writes a list of all files matching the glob pattern
@code{*.patch} (@pxref{Globbing}) to a file named
@code{@var{current-date}.log} (@pxref{Redirection}).
@node Arguments @node Arguments
@section Arguments @section Arguments
Ordinarily, command arguments are parsed by Eshell as either strings Ordinarily, Eshell parses arguments in command form as either strings
or numbers, depending on what the parser thinks they look like. To or numbers, depending on what the parser thinks they look like. To
specify an argument of some other data type, you can use an specify an argument of some other data type, you can use a Lisp form
@ref{Dollars Expansion, Elisp expression}: (@pxref{Invocation}):
@example @example
~ $ echo (list 1 2 3) ~ $ echo (list 1 2 3)
@ -354,10 +423,6 @@ eshell/sudo is a compiled Lisp function in `em-tramp.el'.
sudo is an alias, defined as "*sudo $@@*" sudo is an alias, defined as "*sudo $@@*"
@end example @end example
@vindex eshell-prefer-lisp-functions
If you would prefer to use the built-in commands instead of the external
commands, set @code{eshell-prefer-lisp-functions} to @code{t}.
Some of the built-in commands have different behavior from their Some of the built-in commands have different behavior from their
external counterparts, and some have no external counterpart. Most of external counterparts, and some have no external counterpart. Most of
these will print a usage message when given the @code{--help} option. these will print a usage message when given the @code{--help} option.
@ -923,15 +988,14 @@ For example, you could handle a subset of the options for the
@node Variables @node Variables
@section Variables @section Variables
@vindex eshell-prefer-lisp-variables @vindex eshell-prefer-lisp-variables
Since Eshell is a combination of an Emacs @acronym{REPL}@footnote{ Since Eshell is a combination of an Emacs @acronym{REPL} and a command
Short for ``Read-Eval-Print Loop''. shell, it can refer to variables from two different sources: ordinary
} and a command shell, it can refer to variables from two different Emacs Lisp variables, as well as environment variables. By default,
sources: ordinary Emacs Lisp variables, as well as environment when using a variable in Eshell, it will first look in the list of
variables. By default, when using a variable in Eshell, it will first built-in variables, then in the list of environment variables, and
look in the list of built-in variables, then in the list of finally in the list of Lisp variables. If you would prefer to use
environment variables, and finally in the list of Lisp variables. If Lisp variables over environment variables, you can set
you would prefer to use Lisp variables over environment variables, you @code{eshell-prefer-lisp-variables} to @code{t}.
can set @code{eshell-prefer-lisp-variables} to @code{t}.
You can set variables in a few different ways. To set a Lisp You can set variables in a few different ways. To set a Lisp
variable, you can use the command @samp{setq @var{name} @var{value}}, variable, you can use the command @samp{setq @var{name} @var{value}},

9
etc/NEWS.29
View file

@ -2079,7 +2079,7 @@ The VC Directory buffer now uses the prefix 'b' for these branch-related
commands. commands.
+++ +++
*** New command '%' ('vc-dir-mark-by-regexp'). *** New command 'vc-dir-mark-by-regexp' bound to '% m' and '* %'.
This command marks files based on a regexp. If given a prefix This command marks files based on a regexp. If given a prefix
argument, unmark instead. argument, unmark instead.
@ -3235,6 +3235,11 @@ programs in the C language.
An optional major mode based on the tree-sitter library for editing An optional major mode based on the tree-sitter library for editing
programs in the C++ language. programs in the C++ language.
+++
*** New command 'c-or-c++-ts-mode'.
A command that automatically guesses the language of a header file,
and enables either 'c-ts-mode' or 'c++-ts-mode' accordingly.
+++ +++
*** New major mode 'java-ts-mode'. *** New major mode 'java-ts-mode'.
An optional major mode based on the tree-sitter library for editing An optional major mode based on the tree-sitter library for editing
@ -3802,7 +3807,7 @@ These function now take an optional comparison PREDICATE argument.
** 'read-multiple-choice' can now use long-form answers. ** 'read-multiple-choice' can now use long-form answers.
+++ +++
** 'M-c' in 'read-regexp' now toggles case folding. ** 'M-s c' in 'read-regexp' now toggles case folding.
+++ +++
** 'completing-read' now allows a function as its REQUIRE-MATCH argument. ** 'completing-read' now allows a function as its REQUIRE-MATCH argument.

2
lisp/emacs-lisp/cl-macs.el
View file

@ -2811,7 +2811,7 @@ values. Note that this macro is *not* available in Common Lisp.
As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
the PLACE is not modified before executing BODY. the PLACE is not modified before executing BODY.
See info node `(cl) Function Bindings' for details. See info node `(cl) Modify Macros' for details.
\(fn ((PLACE VALUE) ...) BODY...)" \(fn ((PLACE VALUE) ...) BODY...)"
(declare (indent 1) (debug ((&rest [&or (symbolp form) (declare (indent 1) (debug ((&rest [&or (symbolp form)

8
lisp/emacs-lisp/warnings.el
View file

@ -204,8 +204,12 @@ SUPPRESS-LIST is the list of kinds of warnings to suppress."
some-match)) some-match))
(define-icon warnings-suppress button (define-icon warnings-suppress button
'((emoji "⛔") `((emoji "⛔")
(symbol " ■ ") ;; Many MS-Windows console fonts don't have good glyphs for U+25A0.
(symbol ,(if (and (eq system-type 'windows-nt)
(null window-system))
" » "
" ■ "))
(text " stop ")) (text " stop "))
"Suppress warnings." "Suppress warnings."
:version "29.1" :version "29.1"

13
lisp/erc/erc-common.el
View file

@ -202,12 +202,13 @@ if ARG is omitted or nil.
(,disable))) (,disable)))
,(erc--assemble-toggle local-p name enable mode t enable-body) ,(erc--assemble-toggle local-p name enable mode t enable-body)
,(erc--assemble-toggle local-p name disable mode nil disable-body) ,(erc--assemble-toggle local-p name disable mode nil disable-body)
,(when (and alias (not (eq name alias))) ,@(and-let* ((alias)
`(defalias ((not (eq name alias)))
',(intern (aname (intern (format "erc-%s-mode"
(format "erc-%s-mode" (downcase (symbol-name alias))))))
(downcase (symbol-name alias)))) `((defalias ',aname #',mode)
#',mode)) (put ',aname 'erc-module ',(erc--normalize-module-symbol name))))
(put ',mode 'erc-module ',(erc--normalize-module-symbol name))
;; For find-function and find-variable. ;; For find-function and find-variable.
(put ',mode 'definition-name ',name) (put ',mode 'definition-name ',name)
(put ',enable 'definition-name ',name) (put ',enable 'definition-name ',name)

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

@ -260,8 +260,8 @@ If START or END is negative, it counts from the end."
(dolist (e rv out) (dolist (e rv out)
(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) (setq e (plist-put e :secret (apply-partially
(apply-partially #'auth-source--deobfuscate v))) #'auth-source--deobfuscate v))))
(push e out))) (push e out)))
rv))) rv)))

26
lisp/erc/erc.el
View file

@ -1305,6 +1305,14 @@ See also `erc-show-my-nick'."
(defvar-local erc-dbuf nil) (defvar-local erc-dbuf nil)
;; See comments in `erc-scenarios-base-local-modules' explaining why
;; this is insufficient as a public interface.
(defvar erc--target-priors nil
"Analogous to `erc--server-reconnecting' but for target buffers.
Bound to local variables from an existing (logical) session's
buffer during local-module setup and `erc-mode-hook' activation.")
(defun erc--target-from-string (string) (defun erc--target-from-string (string)
"Construct an `erc--target' variant from STRING." "Construct an `erc--target' variant from STRING."
(funcall (if (erc-channel-p string) (funcall (if (erc-channel-p string)
@ -1950,7 +1958,8 @@ nil."
(let ((out (list (reverse new-modes)))) (let ((out (list (reverse new-modes))))
(pcase-dolist (`(,k . ,v) old-vars) (pcase-dolist (`(,k . ,v) old-vars)
(when (and (string-prefix-p "erc-" (symbol-name k)) (when (and (string-prefix-p "erc-" (symbol-name k))
(string-suffix-p "-mode" (symbol-name k))) (string-suffix-p "-mode" (symbol-name k))
(get k 'erc-module))
(if v (if v
(cl-pushnew k (car out)) (cl-pushnew k (car out))
(setf (car out) (delq k (car out))) (setf (car out) (delq k (car out)))
@ -1985,7 +1994,9 @@ Returns the buffer for the given server or channel."
(let* ((target (and channel (erc--target-from-string channel))) (let* ((target (and channel (erc--target-from-string channel)))
(buffer (erc-get-buffer-create server port nil target id)) (buffer (erc-get-buffer-create server port nil target id))
(old-buffer (current-buffer)) (old-buffer (current-buffer))
(old-vars (and target (buffer-local-variables))) (erc--target-priors (and target ; buf from prior session
(buffer-local-value 'erc--target buffer)
(buffer-local-variables buffer)))
(old-recon-count erc-server-reconnect-count) (old-recon-count erc-server-reconnect-count)
(old-point nil) (old-point nil)
(delayed-modules nil) (delayed-modules nil)
@ -1998,7 +2009,8 @@ Returns the buffer for the given server or channel."
(setq old-point (point)) (setq old-point (point))
(setq delayed-modules (setq delayed-modules
(erc--merge-local-modes (erc--update-modules) (erc--merge-local-modes (erc--update-modules)
(or erc--server-reconnecting old-vars))) (or erc--server-reconnecting
erc--target-priors)))
(delay-mode-hooks (erc-mode)) (delay-mode-hooks (erc-mode))
@ -2071,9 +2083,7 @@ Returns the buffer for the given server or channel."
(erc-determine-parameters server port nick full-name user passwd) (erc-determine-parameters server port nick full-name user passwd)
(save-excursion (run-mode-hooks)) ;; FIXME consolidate this prompt-setup logic with the pass above.
(dolist (mod (car delayed-modules)) (funcall mod +1))
(dolist (var (cdr delayed-modules)) (set var nil))
;; set up prompt ;; set up prompt
(unless continued-session (unless continued-session
@ -2086,6 +2096,10 @@ Returns the buffer for the given server or channel."
(erc-display-prompt) (erc-display-prompt)
(goto-char (point-max))) (goto-char (point-max)))
(save-excursion (run-mode-hooks)
(dolist (mod (car delayed-modules)) (funcall mod +1))
(dolist (var (cdr delayed-modules)) (set var nil)))
;; Saving log file on exit ;; Saving log file on exit
(run-hook-with-args 'erc-connect-pre-hook buffer) (run-hook-with-args 'erc-connect-pre-hook buffer)

3
lisp/eshell/em-basic.el
View file

@ -132,7 +132,8 @@ or `eshell-printn' for display."
;; bug#27361. ;; bug#27361.
(when (equal output-newline '(nil)) (when (equal output-newline '(nil))
(display-warning (display-warning
:warning "To terminate with a newline, you should use -N instead.")) '(eshell echo)
"To terminate with a newline, you should use -N instead."))
(eshell-echo args output-newline)))) (eshell-echo args output-newline))))
(defun eshell/printnl (&rest args) (defun eshell/printnl (&rest args)

3
lisp/eshell/esh-var.el
View file

@ -628,7 +628,8 @@ If QUOTED is non-nil, this was invoked inside double-quotes."
(if (or (eq max-arity 'many) (>= max-arity 2)) (if (or (eq max-arity 'many) (>= max-arity 2))
(funcall target indices quoted) (funcall target indices quoted)
(display-warning (display-warning
:warning (concat "Function for `eshell-variable-aliases-list' " '(eshell variable-alias)
(concat "Function for `eshell-variable-aliases-list' "
"entry should accept two arguments: INDICES " "entry should accept two arguments: INDICES "
"and QUOTED.'")) "and QUOTED.'"))
(funcall target indices))))) (funcall target indices)))))

20
lisp/files.el
View file

@ -5059,7 +5059,8 @@ This is a separate procedure so your site-init or startup file can
redefine it. redefine it.
If the optional argument KEEP-BACKUP-VERSION is non-nil, If the optional argument KEEP-BACKUP-VERSION is non-nil,
we do not remove backup version numbers, only true file version numbers. we do not remove backup version numbers, only true file version numbers.
See also `file-name-version-regexp'." See `file-name-version-regexp' for what constitutes backup versions
and version strings."
(let ((handler (find-file-name-handler name 'file-name-sans-versions))) (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
(if handler (if handler
(funcall handler 'file-name-sans-versions name keep-backup-version) (funcall handler 'file-name-sans-versions name keep-backup-version)
@ -5111,9 +5112,12 @@ the group would be preserved too."
(file-attribute-group-id attributes))))))))))) (file-attribute-group-id attributes)))))))))))
(defun file-name-sans-extension (filename) (defun file-name-sans-extension (filename)
"Return FILENAME sans final \"extension\". "Return FILENAME sans final \"extension\" and any backup version strings.
The extension, in a file name, is the part that begins with the last `.', The extension, in a file name, is the part that begins with the last `.',
except that a leading `.' of the file name, if there is one, doesn't count." except that a leading `.' of the file name, if there is one, doesn't count.
Any extensions that indicate backup versions and version strings are
removed by calling `file-name-sans-versions', which see, before looking
for the \"real\" file extension."
(save-match-data (save-match-data
(let ((file (file-name-sans-versions (file-name-nondirectory filename))) (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
directory) directory)
@ -5127,12 +5131,14 @@ except that a leading `.' of the file name, if there is one, doesn't count."
filename)))) filename))))
(defun file-name-extension (filename &optional period) (defun file-name-extension (filename &optional period)
"Return FILENAME's final \"extension\". "Return FILENAME's final \"extension\" sans any backup version strings.
The extension, in a file name, is the part that begins with the last `.', The extension, in a file name, is the part that begins with the last `.',
excluding version numbers and backup suffixes, except that a leading `.' except that a leading `.' of the file name, if there is one, doesn't count.
of the file name, if there is one, doesn't count. This function calls `file-name-sans-versions', which see, to remove from
the extension it returns any parts that indicate backup versions and
version strings.
Return nil for extensionless file names such as `foo'. Return nil for extensionless file names such as `foo'.
Return the empty string for file names such as `foo.'. Return the empty string for file names such as `foo.' that end in a period.
By default, the returned value excludes the period that starts the By default, the returned value excludes the period that starts the
extension, but if the optional argument PERIOD is non-nil, the period extension, but if the optional argument PERIOD is non-nil, the period

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

@ -976,6 +976,50 @@ This mode is independent from the classic cc-mode.el based
(treesit-major-mode-setup))) (treesit-major-mode-setup)))
;; We could alternatively use parsers, but if this works well, I don't
;; see the need to change. This is copied verbatim from cc-guess.el.
(defconst c-ts-mode--c-or-c++-regexp
(eval-when-compile
(let ((id "[a-zA-Z_][a-zA-Z0-9_]*") (ws "[ \t]+") (ws-maybe "[ \t]*")
(headers '("string" "string_view" "iostream" "map" "unordered_map"
"set" "unordered_set" "vector" "tuple")))
(concat "^" ws-maybe "\\(?:"
"using" ws "\\(?:namespace" ws
"\\|" id "::"
"\\|" id ws-maybe "=\\)"
"\\|" "\\(?:inline" ws "\\)?namespace"
"\\(:?" ws "\\(?:" id "::\\)*" id "\\)?" ws-maybe "{"
"\\|" "class" ws id
"\\(?:" ws "final" "\\)?" ws-maybe "[:{;\n]"
"\\|" "struct" ws id "\\(?:" ws "final" ws-maybe "[:{\n]"
"\\|" ws-maybe ":\\)"
"\\|" "template" ws-maybe "<.*?>"
"\\|" "#include" ws-maybe "<" (regexp-opt headers) ">"
"\\)")))
"A regexp applied to C header files to check if they are really C++.")
;;;###autoload
(defun c-or-c++-ts-mode ()
"Analyze buffer and enable either C or C++ mode.
Some people and projects use .h extension for C++ header files
which is also the one used for C header files. This makes
matching on file name insufficient for detecting major mode that
should be used.
This function attempts to use file contents to determine whether
the code is C or C++ and based on that chooses whether to enable
`c-ts-mode' or `c++-ts-mode'."
(interactive)
(if (save-excursion
(save-restriction
(save-match-data ; Why `save-match-data'?
(widen)
(goto-char (point-min))
(re-search-forward c-ts-mode--c-or-c++-regexp nil t))))
(c++-ts-mode)
(c-ts-mode)))
(provide 'c-ts-mode) (provide 'c-ts-mode)
;;; c-ts-mode.el ends here ;;; c-ts-mode.el ends here

22
lisp/progmodes/cc-defs.el
View file

@ -1361,6 +1361,28 @@ nil; point is then left undefined."
(search-forward-regexp "\\(\n\\|.\\)") ; to set the match-data. (search-forward-regexp "\\(\n\\|.\\)") ; to set the match-data.
(point)))) (point))))
(defmacro c-search-forward-non-nil-char-property (property &optional limit)
"Search forward for a text-property PROPERTY value non-nil.
LIMIT bounds the search.
Leave point just after the character. The match data remain
unchanged. Return the value of PROPERTY. If a non-nil value
isn't found, return nil; point is then left undefined."
(declare (debug t))
`(let* ((-limit- (or ,limit (point-max)))
(value (c-get-char-property (point) ,property)))
(cond
((>= (point) -limit-)
nil)
(value
(forward-char)
value)
(t (let ((place (c-next-single-property-change
(point) ,property nil -limit-)))
(when place
(goto-char (1+ place))
(c-get-char-property place ,property)))))))
(defmacro c-search-backward-char-property (property value &optional limit) (defmacro c-search-backward-char-property (property value &optional limit)
"Search backward for a text-property PROPERTY having value VALUE. "Search backward for a text-property PROPERTY having value VALUE.
LIMIT bounds the search. The comparison is done with `equal'. LIMIT bounds the search. The comparison is done with `equal'.

40
lisp/progmodes/cc-engine.el
View file

@ -142,6 +142,10 @@
;; Put on the brace which introduces a brace list and on the commas ;; Put on the brace which introduces a brace list and on the commas
;; which separate the elements within it. ;; which separate the elements within it.
;; ;;
;; 'c-typedef This property is applied to the first character of a
;; "typedef" keyword. It's value is a list of the identifiers that
;; the "typedef" declares as types.
;;
;; 'c-<>-c-types-set ;; 'c-<>-c-types-set
;; This property is set on an opening angle bracket, and indicates that ;; This property is set on an opening angle bracket, and indicates that
;; any "," separators within the template/generic expression have been ;; any "," separators within the template/generic expression have been
@ -10024,10 +10028,10 @@ This function might do hidden buffer changes."
;; an identifier instead. ;; an identifier instead.
(declare (debug nil)) (declare (debug nil))
`(progn `(progn
(setq identifier-start type-start)
,(unless short ,(unless short
;; These identifiers are bound only in the inner let. ;; These identifiers are bound only in the inner let.
'(setq identifier-type at-type '(setq identifier-type at-type
identifier-start type-start
got-parens nil got-parens nil
got-identifier t got-identifier t
got-suffix t got-suffix t
@ -10102,10 +10106,11 @@ This function might do hidden buffer changes."
;; The second element of the return value is non-nil when something ;; The second element of the return value is non-nil when something
;; indicating the identifier is a type occurs in the declaration. ;; indicating the identifier is a type occurs in the declaration.
;; Specifically it is nil, or a three element list (A B C) where C is t ;; Specifically it is nil, or a three element list (A B C) where C is t
;; when context is '<> and the "identifier" is a found type, B is t when a ;; when context is '<> and the "identifier" is a found type, B is the
;; `c-typedef-kwds' ("typedef") is present, and A is t when some other ;; position of the `c-typedef-kwds' keyword ("typedef") when such is
;; `c-typedef-decl-kwds' (e.g. class, struct, enum) specifier is present. ;; present, and A is t when some other `c-typedef-decl-kwds' (e.g. class,
;; I.e., (some of) the declared identifier(s) are types. ;; struct, enum) specifier is present. I.e., (some of) the declared
;; identifier(s) are types.
;; ;;
;; The third element of the return value is non-nil when the declaration ;; The third element of the return value is non-nil when the declaration
;; parsed might be an expression. The fourth element is the position of ;; parsed might be an expression. The fourth element is the position of
@ -10173,6 +10178,9 @@ This function might do hidden buffer changes."
;; `c-decl-hangon-kwds' and their associated clauses that ;; `c-decl-hangon-kwds' and their associated clauses that
;; occurs after the type. ;; occurs after the type.
id-start id-start
;; The earlier value of `type-start' if we've shifted the type
;; backwards.
identifier-start
;; These store `at-type', `type-start' and `id-start' of the ;; These store `at-type', `type-start' and `id-start' of the
;; identifier before the one in those variables. The previous ;; identifier before the one in those variables. The previous
;; identifier might turn out to be the real type in a ;; identifier might turn out to be the real type in a
@ -10183,7 +10191,8 @@ This function might do hidden buffer changes."
;; Set if we've found a specifier (apart from "typedef") that makes ;; Set if we've found a specifier (apart from "typedef") that makes
;; the defined identifier(s) types. ;; the defined identifier(s) types.
at-type-decl at-type-decl
;; Set if we've a "typedef" keyword. ;; If we've a "typedef" keyword (?or similar), the buffer position of
;; its first character.
at-typedef at-typedef
;; Set if `context' is '<> and the identifier is definitely a type, or ;; Set if `context' is '<> and the identifier is definitely a type, or
;; has already been recorded as a found type. ;; has already been recorded as a found type.
@ -10266,7 +10275,7 @@ This function might do hidden buffer changes."
(looking-at "@[A-Za-z0-9]+"))) (looking-at "@[A-Za-z0-9]+")))
(save-match-data (save-match-data
(if (looking-at c-typedef-key) (if (looking-at c-typedef-key)
(setq at-typedef t))) (setq at-typedef (point))))
(setq kwd-sym (c-keyword-sym (match-string 1))) (setq kwd-sym (c-keyword-sym (match-string 1)))
(save-excursion (save-excursion
(c-forward-keyword-clause 1) (c-forward-keyword-clause 1)
@ -10486,9 +10495,9 @@ This function might do hidden buffer changes."
;; True if we've parsed the type decl to a token that is ;; True if we've parsed the type decl to a token that is
;; known to end declarations in this context. ;; known to end declarations in this context.
at-decl-end at-decl-end
;; The earlier values of `at-type' and `type-start' if we've ;; The earlier value of `at-type' if we've shifted the type
;; shifted the type backwards. ;; backwards.
identifier-type identifier-start identifier-type
;; If `c-parse-and-markup-<>-arglists' is set we need to ;; If `c-parse-and-markup-<>-arglists' is set we need to
;; turn it off during the name skipping below to avoid ;; turn it off during the name skipping below to avoid
;; getting `c-type' properties that might be bogus. That ;; getting `c-type' properties that might be bogus. That
@ -10530,6 +10539,10 @@ This function might do hidden buffer changes."
(progn (setq got-identifier nil) t) (progn (setq got-identifier nil) t)
;; It turned out to be the real identifier, ;; It turned out to be the real identifier,
;; so stop. ;; so stop.
(save-excursion
(c-backward-syntactic-ws)
(c-simple-skip-symbol-backward)
(setq identifier-start (point)))
nil)) nil))
t)) t))
@ -10555,6 +10568,10 @@ This function might do hidden buffer changes."
(and (looking-at c-identifier-start) (and (looking-at c-identifier-start)
(setq pos (point)) (setq pos (point))
(setq got-identifier (c-forward-name)) (setq got-identifier (c-forward-name))
(save-excursion
(c-backward-syntactic-ws)
(c-simple-skip-symbol-backward)
(setq identifier-start (point)))
(setq name-start pos)) (setq name-start pos))
(when (looking-at "[0-9]") (when (looking-at "[0-9]")
(setq got-number t)) ; We probably have an arithmetic expression. (setq got-number t)) ; We probably have an arithmetic expression.
@ -10573,7 +10590,8 @@ This function might do hidden buffer changes."
(setq at-type nil (setq at-type nil
name-start type-start name-start type-start
id-start type-start id-start type-start
got-identifier t))) got-identifier t)
(setq identifier-start type-start)))
;; Skip over type decl suffix operators and trailing noise macros. ;; Skip over type decl suffix operators and trailing noise macros.
(while (while

66
lisp/progmodes/cc-fonts.el
View file

@ -85,6 +85,8 @@
(cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs only. (cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs only.
(declare-function cl-set-difference "cl-seq" (cl-list1 cl-list2 &rest cl-keys))
;; Need to declare these local symbols during compilation since ;; Need to declare these local symbols during compilation since
;; they're referenced from lambdas in `byte-compile' calls that are ;; they're referenced from lambdas in `byte-compile' calls that are
;; executed at compile time. They don't need to have the proper ;; executed at compile time. They don't need to have the proper
@ -1109,10 +1111,12 @@ casts and declarations are fontified. Used on level 2 and higher."
;; additionally, mark the commas with c-type property 'c-decl-id-start or ;; additionally, mark the commas with c-type property 'c-decl-id-start or
;; 'c-decl-type-start (according to TYPES). Stop at LIMIT. ;; 'c-decl-type-start (according to TYPES). Stop at LIMIT.
;; ;;
;; If TYPES is t, fontify all identifiers as types, if it is nil fontify as ;; If TYPES is t, fontify all identifiers as types; if it is a number, a
;; either variables or functions, otherwise TYPES is a face to use. If ;; buffer position, additionally set the `c-deftype' text property on the
;; NOT-TOP is non-nil, we are not at the top-level ("top-level" includes ;; keyword at that position; if it is nil fontify as either variables or
;; being directly inside a class or namespace, etc.). ;; functions, otherwise TYPES is a face to use. If NOT-TOP is non-nil, we
;; are not at the top-level ("top-level" includes being directly inside a
;; class or namespace, etc.).
;; ;;
;; TEMPLATE-CLASS is non-nil when the declaration is in template delimiters ;; TEMPLATE-CLASS is non-nil when the declaration is in template delimiters
;; and was introduced by, e.g. "typename" or "class", such that if there is ;; and was introduced by, e.g. "typename" or "class", such that if there is
@ -1129,17 +1133,28 @@ casts and declarations are fontified. Used on level 2 and higher."
;;(message "c-font-lock-declarators from %s to %s" (point) limit) ;;(message "c-font-lock-declarators from %s to %s" (point) limit)
(c-fontify-types-and-refs (c-fontify-types-and-refs
() ()
;; If we're altering the declarators in a typedef, we need to scan ALL of
;; them because of the way we check for changes.
(let ((c-do-decl-limit (if (numberp types) (point-max) limit))
decl-ids)
(c-do-declarators (c-do-declarators
limit list not-top c-do-decl-limit
(cond ((eq types t) 'c-decl-type-start) list not-top
(cond ((or (numberp types)
(eq types t))
'c-decl-type-start)
((null types) 'c-decl-id-start)) ((null types) 'c-decl-id-start))
(lambda (id-start id-end end-pos _not-top is-function init-char) (lambda (id-start id-end end-pos _not-top is-function init-char)
(if (eq types t) (if (or (numberp types)
(eq types t))
(when id-start (when id-start
;; Register and fontify the identifier as a type. ;; Register and fontify the identifier as a type.
(let ((c-promote-possible-types t)) (let ((c-promote-possible-types t))
(goto-char id-start) (goto-char id-start)
(c-forward-type))) (c-forward-type))
(when (numberp types)
(push (buffer-substring-no-properties id-start id-end)
decl-ids)))
(when id-start (when id-start
(goto-char id-start) (goto-char id-start)
(when c-opt-identifier-prefix-key (when c-opt-identifier-prefix-key
@ -1147,7 +1162,7 @@ casts and declarations are fontified. Used on level 2 and higher."
(eq (match-end 1) id-end)) (eq (match-end 1) id-end))
(while (and (< (point) id-end) (while (and (< (point) id-end)
(re-search-forward c-opt-identifier-prefix-key id-end t)) (re-search-forward c-opt-identifier-prefix-key id-end t))
(c-forward-syntactic-ws limit)))) (c-forward-syntactic-ws c-do-decl-limit))))
;; Only apply the face when the text doesn't have one yet. ;; Only apply the face when the text doesn't have one yet.
;; Exception: The "" in C++'s operator"" will already wrongly have ;; Exception: The "" in C++'s operator"" will already wrongly have
;; string face. ;; string face.
@ -1164,7 +1179,7 @@ casts and declarations are fontified. Used on level 2 and higher."
(equal (buffer-substring-no-properties id-start id-end) (equal (buffer-substring-no-properties id-start id-end)
"\"\"")) "\"\""))
(goto-char id-end) (goto-char id-end)
(c-forward-syntactic-ws limit) (c-forward-syntactic-ws c-do-decl-limit)
(when (c-on-identifier) (when (c-on-identifier)
(c-put-font-lock-face (c-put-font-lock-face
(point) (point)
@ -1174,10 +1189,21 @@ casts and declarations are fontified. Used on level 2 and higher."
(eq init-char ?=) ; C++ "<class X = Y>"? (eq init-char ?=) ; C++ "<class X = Y>"?
(progn (progn
(goto-char end-pos) (goto-char end-pos)
(c-forward-token-2 1 nil limit) ; Over "=" (c-forward-token-2 1 nil c-do-decl-limit) ; Over "="
(let ((c-promote-possible-types t)) (let ((c-promote-possible-types t))
(c-forward-type t))))) (c-forward-type t)))))
accept-anon) ; Last argument to c-do-declarators. accept-anon) ; Last argument to c-do-declarators.
;; If we've changed types declared by a "typedef", update the `c-typedef'
;; text property.
(when (numberp types)
(let* ((old-decl-ids (c-get-char-property types 'c-typedef))
(old-types (c--set-difference old-decl-ids decl-ids :test #'equal))
(new-types (c--set-difference decl-ids old-decl-ids :test #'equal)))
(dolist (type old-types)
(c-unfind-type type))
;; The new types have already been added to `c-found-types', as needed.
(when (or old-types new-types)
(c-put-char-property types 'c-typedef decl-ids)))))
nil)) nil))
(defun c-get-fontification-context (match-pos not-front-decl &optional toplev) (defun c-get-fontification-context (match-pos not-front-decl &optional toplev)
@ -1433,7 +1459,10 @@ casts and declarations are fontified. Used on level 2 and higher."
(c-font-lock-declarators (c-font-lock-declarators
(min limit (point-max)) (min limit (point-max))
decl-list decl-list
(not (null (cadr decl-or-cast))) (cond ((null (cadr decl-or-cast))
nil)
((cadr (cadr decl-or-cast)))
(t t))
(not toplev) (not toplev)
template-class template-class
(memq context '(decl <>)))) (memq context '(decl <>))))
@ -1749,12 +1778,21 @@ casts and declarations are fontified. Used on level 2 and higher."
; speeds up lisp.h tremendously. ; speeds up lisp.h tremendously.
(save-excursion (save-excursion
(when (not (c-back-over-member-initializers decl-search-lim)) (when (not (c-back-over-member-initializers decl-search-lim))
(setq paren-state (c-parse-state))
(unless (or (eobp) (unless (or (eobp)
(looking-at "\\s(\\|\\s)")) (looking-at "\\s(\\|\\s)"))
(forward-char)) (forward-char))
(c-syntactic-skip-backward "^;{}" decl-search-lim t) (c-syntactic-skip-backward "^;{}" decl-search-lim t)
(when (eq (char-before) ?}) ;; Do we have the brace block of a struct, etc.?
(c-go-list-backward) ; brace block of struct, etc.? (when (cond
((and (consp (car paren-state))
(eq (char-before) ?}))
(goto-char (caar paren-state))
t)
((and (numberp (car paren-state))
(eq (char-after (car paren-state)) ?{))
(goto-char (car paren-state))
t))
(c-syntactic-skip-backward "^;{}" decl-search-lim t)) (c-syntactic-skip-backward "^;{}" decl-search-lim t))
(when (or (bobp) (when (or (bobp)
(memq (char-before) '(?\; ?{ ?}))) (memq (char-before) '(?\; ?{ ?})))

40
lisp/progmodes/cc-mode.el
View file

@ -2077,6 +2077,37 @@ with // and /*, not more generic line and block comments."
(not (eobp)))) (not (eobp))))
(forward-char)))))) (forward-char))))))
(defun c-before-change-de-typedef (beg end)
;; For each "typedef" starting in (BEG END), remove the defined types from
;; c-found-types
(let (prop)
(save-excursion
(goto-char beg)
(while (and (< (point) end)
(setq prop (c-search-forward-non-nil-char-property
'c-typedef)))
(dolist (type prop)
(c-unfind-type type))))))
(defun c-after-change-de-typedef (beg end _old-len)
;; For each former "typedef" in (BEG END), remove the defined types from
;; those which are no longer typedefs.
(let (prop)
(save-excursion
(goto-char beg)
(c-backward-token-2
1 nil (- (point) 20))
(while (and (< (point) end)
(setq prop (c-search-forward-non-nil-char-property
'c-typedef end)))
(backward-char)
(when (or (not (looking-at c-typedef-key))
(<= (match-end 1) beg))
(dolist (type prop)
(c-unfind-type type))
(c-clear-char-property (point) 'c-typedef))
(forward-char)))))
(defun c-update-new-id (end) (defun c-update-new-id (end)
;; Note the bounds of any identifier that END is in or just after, in ;; Note the bounds of any identifier that END is in or just after, in
;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to ;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to
@ -2086,7 +2117,9 @@ with // and /*, not more generic line and block comments."
(let ((id-beg (c-on-identifier))) (let ((id-beg (c-on-identifier)))
(setq c-new-id-start id-beg (setq c-new-id-start id-beg
c-new-id-end (and id-beg c-new-id-end (and id-beg
(progn (c-end-of-current-token) (point))) (progn (goto-char id-beg)
(c-forward-token-2)
(point)))
c-new-id-is-type nil)))) c-new-id-is-type nil))))
(defun c-post-command () (defun c-post-command ()
@ -2215,6 +2248,10 @@ with // and /*, not more generic line and block comments."
term-pos) term-pos)
(buffer-substring-no-properties beg end))))))) (buffer-substring-no-properties beg end)))))))
;; If we're about to delete "typedef"s, clear the identifiers from
;; `c-found-types'.
(c-before-change-de-typedef beg end)
(if c-get-state-before-change-functions (if c-get-state-before-change-functions
(mapc (lambda (fn) (mapc (lambda (fn)
(funcall fn beg end)) (funcall fn beg end))
@ -2306,6 +2343,7 @@ with // and /*, not more generic line and block comments."
(c-update-new-id end) (c-update-new-id end)
(c-trim-found-types beg end old-len) ; maybe we don't (c-trim-found-types beg end old-len) ; maybe we don't
; need all of these. ; need all of these.
(c-after-change-de-typedef beg end old-len)
(c-invalidate-sws-region-after beg end old-len) (c-invalidate-sws-region-after beg end old-len)
;; (c-invalidate-state-cache beg) ; moved to ;; (c-invalidate-state-cache beg) ; moved to
;; `c-before-change'. ;; `c-before-change'.

158
lisp/progmodes/ruby-ts-mode.el
View file

@ -152,7 +152,6 @@
"then" "then"
"ensure" "ensure"
"body_statement" "body_statement"
"parenthesized_statements"
"interpolation") "interpolation")
string-end) string-end)
"Regular expression of the nodes that can contain statements.") "Regular expression of the nodes that can contain statements.")
@ -221,9 +220,9 @@ values of OVERRIDE"
:language language :language language
:feature 'constant :feature 'constant
'((true) @font-lock-doc-markup-face '((true) @font-lock-constant-face
(false) @font-lock-doc-markup-face (false) @font-lock-constant-face
(nil) @font-lock-doc-markup-face) (nil) @font-lock-constant-face)
;; Before 'operator so (unary) works. ;; Before 'operator so (unary) works.
:language language :language language
@ -512,10 +511,6 @@ array or hash."
(first-child (ruby-ts--first-non-comment-child parent))) (first-child (ruby-ts--first-non-comment-child parent)))
(= (ruby-ts--lineno open-brace) (ruby-ts--lineno first-child)))) (= (ruby-ts--lineno open-brace) (ruby-ts--lineno first-child))))
(defun ruby-ts--assignment-ancestor (node &rest _)
"Return the assignment ancestor of NODE if any."
(treesit-parent-until node (ruby-ts--type-pred "\\`assignment\\'")))
(defun ruby-ts--statement-ancestor (node &rest _) (defun ruby-ts--statement-ancestor (node &rest _)
"Return the statement ancestor of NODE if any. "Return the statement ancestor of NODE if any.
A statement is defined as a child of a statement container where A statement is defined as a child of a statement container where
@ -531,26 +526,6 @@ a statement container is a node that matches
parent (treesit-node-parent parent))) parent (treesit-node-parent parent)))
statement)) statement))
(defun ruby-ts--is-in-condition (node &rest _)
"Return the condition node if NODE is within a condition."
(while (and node
(not (equal "condition" (treesit-node-field-name node)))
(not (string-match-p ruby-ts--statement-container-regexp
(treesit-node-type node))))
(setq node (treesit-node-parent node)))
(and (equal "condition" (treesit-node-field-name node)) node))
(defun ruby-ts--endless-method (node &rest _)
"Return the expression node if NODE is in an endless method.
i.e. expr of def foo(args) = expr is returned."
(let* ((method node))
(while (and method
(not (string-match-p ruby-ts--method-regex (treesit-node-type method))))
(setq method (treesit-node-parent method)))
(when method
(if (equal "=" (treesit-node-type (treesit-node-child method 3 nil)))
(treesit-node-child method 4 nil)))))
;; ;;
;; end of functions that can be used for queries ;; end of functions that can be used for queries
;; ;;
@ -587,11 +562,11 @@ i.e. expr of def foo(args) = expr is returned."
;; ;;
;; I'm using very restrictive patterns hoping to reduce rules ;; I'm using very restrictive patterns hoping to reduce rules
;; triggering unintentionally. ;; triggering unintentionally.
((match "else" "if") ((match "else" "if\\|unless")
(ruby-ts--align-keywords ruby-ts--parent-node) 0) (ruby-ts--align-keywords ruby-ts--parent-node) 0)
((match "elsif" "if") ((match "elsif" "if")
(ruby-ts--align-keywords ruby-ts--parent-node) 0) (ruby-ts--align-keywords ruby-ts--parent-node) 0)
((match "end" "if") ((match "end" "if\\|unless")
(ruby-ts--align-keywords ruby-ts--parent-node) 0) (ruby-ts--align-keywords ruby-ts--parent-node) 0)
((n-p-gp nil "then\\|else\\|elsif" "if\\|unless") ((n-p-gp nil "then\\|else\\|elsif" "if\\|unless")
(ruby-ts--align-keywords ruby-ts--grand-parent-node) ruby-indent-level) (ruby-ts--align-keywords ruby-ts--grand-parent-node) ruby-indent-level)
@ -664,6 +639,13 @@ i.e. expr of def foo(args) = expr is returned."
;; else the second query aligns ;; else the second query aligns
;; `ruby-indent-level' spaces in from the parent. ;; `ruby-indent-level' spaces in from the parent.
((and ruby-ts--align-chain-p (match "\\." "call")) ruby-ts--align-chain 0) ((and ruby-ts--align-chain-p (match "\\." "call")) ruby-ts--align-chain 0)
;; Obery ruby-method-call-indent, whether the dot is on
;; this line or the previous line.
((and (not ruby-ts--method-call-indent-p)
(or
(match "\\." "call")
(query "(call \".\" (identifier) @indent)")))
parent 0)
((match "\\." "call") parent ruby-indent-level) ((match "\\." "call") parent ruby-indent-level)
;; ruby-indent-after-block-in-continued-expression ;; ruby-indent-after-block-in-continued-expression
@ -697,23 +679,27 @@ i.e. expr of def foo(args) = expr is returned."
;; 2) With paren, 1st arg on next line ;; 2) With paren, 1st arg on next line
((and (query "(argument_list \"(\" _ @indent)") ((and (query "(argument_list \"(\" _ @indent)")
(node-is ")")) (node-is ")"))
(ruby-ts--bol ruby-ts--grand-parent-node) 0) ruby-ts--parent-call-or-bol 0)
((query "(argument_list \"(\" _ @indent)") ((query "(argument_list \"(\" _ @indent)")
(ruby-ts--bol ruby-ts--grand-parent-node) ruby-indent-level) ruby-ts--parent-call-or-bol ruby-indent-level)
;; 3) No paren, ruby-parenless-call-arguments-indent is t ;; 3) No paren, ruby-parenless-call-arguments-indent is t
((and ruby-ts--parenless-call-arguments-indent-p (parent-is "argument_list")) ((and ruby-ts--parenless-call-arguments-indent-p (parent-is "argument_list"))
first-sibling 0) first-sibling 0)
;; 4) No paren, ruby-parenless-call-arguments-indent is nil ;; 4) No paren, ruby-parenless-call-arguments-indent is nil
((parent-is "argument_list") (ruby-ts--bol ruby-ts--grand-parent-node) ruby-indent-level) ((parent-is "argument_list")
(ruby-ts--bol ruby-ts--statement-ancestor) ruby-indent-level)
;; Old... probably too simple ;; Old... probably too simple
((parent-is "block_parameters") first-sibling 1) ((parent-is "block_parameters") first-sibling 1)
((and (parent-is "binary") ((and (not ruby-ts--after-op-indent-p)
(or ruby-ts--assignment-ancestor (parent-is "binary\\|conditional"))
ruby-ts--is-in-condition (ruby-ts--bol ruby-ts--statement-ancestor) ruby-indent-level)
ruby-ts--endless-method))
first-sibling 0) ((parent-is "binary")
ruby-ts--binary-indent-anchor 0)
((parent-is "conditional") parent ruby-indent-level)
;; ruby-mode does not touch these... ;; ruby-mode does not touch these...
((match "bare_string" "string_array") no-indent 0) ((match "bare_string" "string_array") no-indent 0)
@ -732,37 +718,15 @@ i.e. expr of def foo(args) = expr is returned."
((and ruby-ts--same-line-hash-array-p (parent-is "array")) ((and ruby-ts--same-line-hash-array-p (parent-is "array"))
(nth-sibling 0 ruby-ts--true) 0) (nth-sibling 0 ruby-ts--true) 0)
;; NOTE to folks trying to understand my insanity... ((match "}" "hash") ruby-ts--parent-call-or-bol 0)
;; I having trouble understanding the "logic" of why things ((parent-is "hash") ruby-ts--parent-call-or-bol ruby-indent-level)
;; are indented like they are so I am adding special cases ((match "]" "array") ruby-ts--parent-call-or-bol 0)
;; hoping at some point I will be struck by lightning. ((parent-is "array") ruby-ts--parent-call-or-bol ruby-indent-level)
((and (n-p-gp "}" "hash" "pair")
(not ruby-ts--same-line-hash-array-p))
grand-parent 0)
((and (n-p-gp "pair" "hash" "pair")
(not ruby-ts--same-line-hash-array-p))
grand-parent ruby-indent-level)
((and (n-p-gp "}" "hash" "method")
(not ruby-ts--same-line-hash-array-p))
grand-parent 0)
((and (n-p-gp "pair" "hash" "method")
(not ruby-ts--same-line-hash-array-p))
grand-parent ruby-indent-level)
((n-p-gp "}" "hash" "assignment") (ruby-ts--bol ruby-ts--grand-parent-node) 0) ((parent-is "pair") ruby-ts--parent-call-or-bol 0)
((n-p-gp nil "hash" "assignment") (ruby-ts--bol ruby-ts--grand-parent-node) ruby-indent-level)
((n-p-gp "]" "array" "assignment") (ruby-ts--bol ruby-ts--grand-parent-node) 0)
((n-p-gp nil "array" "assignment") (ruby-ts--bol ruby-ts--grand-parent-node) ruby-indent-level)
((n-p-gp "}" "hash" "argument_list") first-sibling 0) ((match ")" "parenthesized_statements") parent-bol 0)
((n-p-gp nil "hash" "argument_list") first-sibling ruby-indent-level) ((parent-is "parenthesized_statements") parent-bol ruby-indent-level)
((n-p-gp "]" "array" "argument_list") first-sibling 0)
((n-p-gp nil "array" "argument_list") first-sibling ruby-indent-level)
((match "}" "hash") first-sibling 0)
((parent-is "hash") first-sibling ruby-indent-level)
((match "]" "array") first-sibling 0)
((parent-is "array") first-sibling ruby-indent-level)
;; If the previous method isn't finished yet, this will get ;; If the previous method isn't finished yet, this will get
;; the next method indented properly. ;; the next method indented properly.
@ -814,6 +778,66 @@ i.e. expr of def foo(args) = expr is returned."
(back-to-indentation) (back-to-indentation)
(point))))) (point)))))
(defun ruby-ts--binary-indent-anchor (_node parent _bol &rest _)
(save-excursion
(goto-char (treesit-node-start parent))
(when (string-match-p ruby-ts--statement-container-regexp
(treesit-node-type (treesit-node-parent parent)))
;; Hack alert: it's not the proper place to alter the offset.
;; Redoing the analysis in the OFFSET form seems annoying,
;; though. (**)
(forward-char ruby-indent-level))
(point)))
(defun ruby-ts--parent-call-or-bol (_not parent _bol &rest _)
(let* ((parent-bol (save-excursion
(goto-char (treesit-node-start parent))
(back-to-indentation)
(point)))
(found
(treesit-parent-until
parent
(lambda (node)
(or (< (treesit-node-start node) parent-bol)
(string-match-p "\\`array\\|hash\\'" (treesit-node-type node))
;; Method call on same line.
(equal (treesit-node-type node) "argument_list"))))))
(cond
((null found)
parent-bol)
;; No paren/curly/brace found on the same line.
((< (treesit-node-start found) parent-bol)
parent-bol)
;; Hash or array opener on the same line.
((string-match-p "\\`array\\|hash\\'" (treesit-node-type found))
(save-excursion
(goto-char (treesit-node-start (treesit-node-child found 1)))
(point)))
;; Parenless call found: indent to stmt with offset.
((not ruby-parenless-call-arguments-indent)
(save-excursion
(goto-char (treesit-node-start
(ruby-ts--statement-ancestor found)))
;; (**) Same.
(+ (point) ruby-indent-level)))
;; Call with parens -- ident to first arg.
((equal (treesit-node-type (treesit-node-child found 0))
"(")
(save-excursion
(goto-char (treesit-node-start (treesit-node-child found 1)))
(point)))
;; Indent to the parenless call args beginning.
(t
(save-excursion
(goto-char (treesit-node-start found))
(point))))))
(defun ruby-ts--after-op-indent-p (&rest _)
ruby-after-operator-indent)
(defun ruby-ts--method-call-indent-p (&rest _)
ruby-method-call-indent)
(defun ruby-ts--class-or-module-p (node) (defun ruby-ts--class-or-module-p (node)
"Predicate if NODE is a class or module." "Predicate if NODE is a class or module."
(string-match-p ruby-ts--class-or-module-regex (treesit-node-type node))) (string-match-p ruby-ts--class-or-module-regex (treesit-node-type node)))

6
lisp/replace.el
View file

@ -824,11 +824,11 @@ by this function to the end of values available via
(defvar-keymap read-regexp-map (defvar-keymap read-regexp-map
:parent minibuffer-local-map :parent minibuffer-local-map
"M-c" #'read-regexp-toggle-case-folding) "M-s c" #'read-regexp-toggle-case-fold)
(defvar read-regexp--case-fold nil) (defvar read-regexp--case-fold nil)
(defun read-regexp-toggle-case-folding () (defun read-regexp-toggle-case-fold ()
(interactive) (interactive)
(setq read-regexp--case-fold (setq read-regexp--case-fold
(if (or (eq read-regexp--case-fold 'fold) (if (or (eq read-regexp--case-fold 'fold)
@ -875,7 +875,7 @@ in \":\", followed by optional whitespace), DEFAULT is added to the prompt.
The optional argument HISTORY is a symbol to use for the history list. The optional argument HISTORY is a symbol to use for the history list.
If nil, use `regexp-history'. If nil, use `regexp-history'.
If the user has used the \\<read-regexp-map>\\[read-regexp-toggle-case-folding] command to specify case If the user has used the \\<read-regexp-map>\\[read-regexp-toggle-case-fold] command to specify case
sensitivity, the returned string will have a text property named sensitivity, the returned string will have a text property named
`case-fold' that has a value of either `fold' or `case-fold' that has a value of either `fold' or
`inhibit-fold'. (It's up to the caller of `read-regexp' to `inhibit-fold'. (It's up to the caller of `read-regexp' to

34
lisp/treesit.el
View file

@ -905,6 +905,14 @@ This is not a general optimization and should be RARELY needed!
See comments in `treesit-font-lock-fontify-region' for more See comments in `treesit-font-lock-fontify-region' for more
detail.") detail.")
(defvar-local treesit--font-lock-fast-mode-grace-count 5
"Grace counts before we turn on the fast mode.
When query takes abnormally long time to execute, we turn on the
\"fast mode\", but just to be on the safe side, we only turn on
the fast mode after this number of offenses. See bug#60691,
bug#60223.")
;; Some details worth explaining: ;; Some details worth explaining:
;; ;;
;; 1. When we apply face to a node, we clip the face into the ;; 1. When we apply face to a node, we clip the face into the
@ -927,13 +935,13 @@ detail.")
;; parse it into a enormously tall tree (10k levels tall). In that ;; parse it into a enormously tall tree (10k levels tall). In that
;; case querying the root node is very slow. So we try to get ;; case querying the root node is very slow. So we try to get
;; top-level nodes and query them. This ensures that querying is fast ;; top-level nodes and query them. This ensures that querying is fast
;; everywhere else, except for the problematic region. ;; everywhere else, except for the problematic region. (Bug#59415).
;; ;;
;; Some other time the source file has a top-level node that contains ;; Some other time the source file has a top-level node that contains
;; a huge number of children (say, 10k children), querying that node ;; a huge number of immediate children (say, 10k children), querying
;; is also very slow, so instead of getting the top-level node, we ;; that node is also very slow, so instead of getting the top-level
;; recursively go down the tree to find nodes that cover the region ;; node, we recursively go down the tree to find nodes that cover the
;; but are reasonably small. ;; region but are reasonably small. (Bug#59738).
;; ;;
;; 3. It is possible to capture a node that's completely outside the ;; 3. It is possible to capture a node that's completely outside the
;; region between START and END: as long as the whole pattern ;; region between START and END: as long as the whole pattern
@ -941,8 +949,8 @@ detail.")
;; returned. If the node is outside of that region, (max node-start ;; returned. If the node is outside of that region, (max node-start
;; start) and friends return bad values, so we filter them out. ;; start) and friends return bad values, so we filter them out.
;; However, we don't filter these nodes out if a function will process ;; However, we don't filter these nodes out if a function will process
;; the node, because could (and often do) fontify the relatives of the ;; the node, because it could (and often do) fontify the relatives of
;; captured node, not just the node itself. If we took out those ;; the captured node, not just the node itself. If we took out those
;; nodes author of those functions would be very confused. ;; nodes author of those functions would be very confused.
(defun treesit-font-lock-fontify-region (start end &optional loudly) (defun treesit-font-lock-fontify-region (start end &optional loudly)
"Fontify the region between START and END. "Fontify the region between START and END.
@ -979,9 +987,12 @@ If LOUDLY is non-nil, display some debugging information."
(end-time (current-time))) (end-time (current-time)))
;; If for any query the query time is strangely long, ;; If for any query the query time is strangely long,
;; switch to fast mode (see comments above). ;; switch to fast mode (see comments above).
(when (> (time-to-seconds (time-subtract end-time start-time)) (when (and (> (time-to-seconds
0.01) (time-subtract end-time start-time))
(setq-local treesit--font-lock-fast-mode t)) 0.01))
(if (> treesit--font-lock-fast-mode-grace-count 0)
(cl-decf treesit--font-lock-fast-mode-grace-count)
(setq-local treesit--font-lock-fast-mode t)))
;; For each captured node, fontify that node. ;; For each captured node, fontify that node.
(with-silent-modifications (with-silent-modifications
@ -1152,6 +1163,9 @@ See `treesit-simple-indent-presets'.")
(and (>= (point) comment-start-bol) (and (>= (point) comment-start-bol)
adaptive-fill-regexp adaptive-fill-regexp
(looking-at adaptive-fill-regexp) (looking-at adaptive-fill-regexp)
;; If previous line is an empty line, don't
;; indent.
(not (looking-at (rx (* whitespace) eol)))
(match-end 0)))))) (match-end 0))))))
;; TODO: Document. ;; TODO: Document.
(cons 'grand-parent (cons 'grand-parent

8
lisp/vc/vc-dir.el
View file

@ -325,7 +325,6 @@ See `run-hooks'."
(define-key map "U" #'vc-dir-unmark-all-files) (define-key map "U" #'vc-dir-unmark-all-files)
(define-key map "\C-?" #'vc-dir-unmark-file-up) (define-key map "\C-?" #'vc-dir-unmark-file-up)
(define-key map "\M-\C-?" #'vc-dir-unmark-all-files) (define-key map "\M-\C-?" #'vc-dir-unmark-all-files)
(define-key map "%" #'vc-dir-mark-by-regexp)
;; Movement. ;; Movement.
(define-key map "n" #'vc-dir-next-line) (define-key map "n" #'vc-dir-next-line)
(define-key map " " #'vc-dir-next-line) (define-key map " " #'vc-dir-next-line)
@ -361,8 +360,13 @@ See `run-hooks'."
(define-key branch-map "l" #'vc-print-branch-log) (define-key branch-map "l" #'vc-print-branch-log)
(define-key branch-map "s" #'vc-switch-branch)) (define-key branch-map "s" #'vc-switch-branch))
(let ((regexp-map (make-sparse-keymap)))
(define-key map "%" regexp-map)
(define-key regexp-map "m" #'vc-dir-mark-by-regexp))
(let ((mark-map (make-sparse-keymap))) (let ((mark-map (make-sparse-keymap)))
(define-key map "*" mark-map) (define-key map "*" mark-map)
(define-key mark-map "%" #'vc-dir-mark-by-regexp)
(define-key mark-map "r" #'vc-dir-mark-registered-files)) (define-key mark-map "r" #'vc-dir-mark-registered-files))
;; Hook up the menu. ;; Hook up the menu.
@ -791,7 +795,7 @@ MARK-FILES should be a list of absolute filenames."
vc-ewoc)) vc-ewoc))
(defun vc-dir-mark-registered-files () (defun vc-dir-mark-registered-files ()
"Mark files that are in one of registered state: edited, added or removed." "Mark files that are in one of registered states: edited, added or removed."
(interactive) (interactive)
(vc-dir-mark-state-files '(edited added removed))) (vc-dir-mark-state-files '(edited added removed)))

12
lisp/window.el
View file

@ -5670,7 +5670,8 @@ the original point in both windows."
(defun split-window-below (&optional size window-to-split) (defun split-window-below (&optional size window-to-split)
"Split WINDOW-TO-SPLIT into two windows, one above the other. "Split WINDOW-TO-SPLIT into two windows, one above the other.
WINDOW-TO-SPLIT is above. The newly split-off window is WINDOW-TO-SPLIT defaults to the selected window and and will be above
the other window after splitting. The newly split-off window is
below and displays the same buffer. Return the new window. below and displays the same buffer. Return the new window.
If optional argument SIZE is omitted or nil, both windows get the If optional argument SIZE is omitted or nil, both windows get the
@ -5691,7 +5692,9 @@ amount of redisplay; this is convenient on slow terminals."
;; `split-window' would not signal an error here. ;; `split-window' would not signal an error here.
(error "Size of new window too small")) (error "Size of new window too small"))
(setq new-window (split-window window-to-split size)) (setq new-window (split-window window-to-split size))
(unless split-window-keep-point (when (and (null split-window-keep-point)
(or (null window-to-split)
(eq window-to-split (selected-window))))
(with-current-buffer (window-buffer window-to-split) (with-current-buffer (window-buffer window-to-split)
;; Use `save-excursion' around vertical movements below ;; Use `save-excursion' around vertical movements below
;; (Bug#10971). Note: When WINDOW-TO-SPLIT's buffer has a ;; (Bug#10971). Note: When WINDOW-TO-SPLIT's buffer has a
@ -5732,8 +5735,9 @@ handled as in `split-window-below'."
(defun split-window-right (&optional size window-to-split) (defun split-window-right (&optional size window-to-split)
"Split WINDOW-TO-SPLIT into two side-by-side windows. "Split WINDOW-TO-SPLIT into two side-by-side windows.
WINDOW-TO-SPLIT is on the left. The newly split-off window is on WINDOW-TO-SPLIT defaults to the selected window and and will be on the
the right and displays the same buffer. Return the new window. left after splitting. The newly split-off window is on the right and
displays the same buffer. Return the new window.
If optional argument SIZE is omitted or nil, both windows get the If optional argument SIZE is omitted or nil, both windows get the
same width, or close to it. If SIZE is positive, the left-hand same width, or close to it. If SIZE is positive, the left-hand

10
src/buffer.c
View file

@ -525,14 +525,14 @@ get_truename_buffer (register Lisp_Object filename)
return Qnil; return Qnil;
} }
/* Run buffer-list-update-hook if Vrun_hooks is non-nil, and BUF is NULL /* Run buffer-list-update-hook if Vrun_hooks is non-nil and BUF does
or does not have buffer hooks inhibited. BUF is NULL when called by not have buffer hooks inhibited. */
make-indirect-buffer, since it does not inhibit buffer hooks. */
static void static void
run_buffer_list_update_hook (struct buffer *buf) run_buffer_list_update_hook (struct buffer *buf)
{ {
if (! (NILP (Vrun_hooks) || (buf && buf->inhibit_buffer_hooks))) eassert (buf);
if (! (NILP (Vrun_hooks) || buf->inhibit_buffer_hooks))
call1 (Vrun_hooks, Qbuffer_list_update_hook); call1 (Vrun_hooks, Qbuffer_list_update_hook);
} }
@ -907,7 +907,7 @@ does not run the hooks `kill-buffer-hook',
set_buffer_internal_1 (old_b); set_buffer_internal_1 (old_b);
} }
run_buffer_list_update_hook (NULL); run_buffer_list_update_hook (b);
return buf; return buf;
} }

66
src/treesit.c
View file

@ -42,8 +42,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#undef ts_node_end_byte #undef ts_node_end_byte
#undef ts_node_eq #undef ts_node_eq
#undef ts_node_field_name_for_child #undef ts_node_field_name_for_child
#undef ts_node_first_child_for_byte
#undef ts_node_first_named_child_for_byte
#undef ts_node_has_error #undef ts_node_has_error
#undef ts_node_is_extra #undef ts_node_is_extra
#undef ts_node_is_missing #undef ts_node_is_missing
@ -99,8 +97,6 @@ DEF_DLL_FN (TSNode, ts_node_descendant_for_byte_range,
DEF_DLL_FN (uint32_t, ts_node_end_byte, (TSNode)); DEF_DLL_FN (uint32_t, ts_node_end_byte, (TSNode));
DEF_DLL_FN (bool, ts_node_eq, (TSNode, TSNode)); DEF_DLL_FN (bool, ts_node_eq, (TSNode, TSNode));
DEF_DLL_FN (const char *, ts_node_field_name_for_child, (TSNode, uint32_t)); DEF_DLL_FN (const char *, ts_node_field_name_for_child, (TSNode, uint32_t));
DEF_DLL_FN (TSNode, ts_node_first_child_for_byte, (TSNode, uint32_t));
DEF_DLL_FN (TSNode, ts_node_first_named_child_for_byte, (TSNode, uint32_t));
DEF_DLL_FN (bool, ts_node_has_error, (TSNode)); DEF_DLL_FN (bool, ts_node_has_error, (TSNode));
DEF_DLL_FN (bool, ts_node_is_extra, (TSNode)); DEF_DLL_FN (bool, ts_node_is_extra, (TSNode));
DEF_DLL_FN (bool, ts_node_is_missing, (TSNode)); DEF_DLL_FN (bool, ts_node_is_missing, (TSNode));
@ -174,8 +170,6 @@ init_treesit_functions (void)
LOAD_DLL_FN (library, ts_node_end_byte); LOAD_DLL_FN (library, ts_node_end_byte);
LOAD_DLL_FN (library, ts_node_eq); LOAD_DLL_FN (library, ts_node_eq);
LOAD_DLL_FN (library, ts_node_field_name_for_child); LOAD_DLL_FN (library, ts_node_field_name_for_child);
LOAD_DLL_FN (library, ts_node_first_child_for_byte);
LOAD_DLL_FN (library, ts_node_first_named_child_for_byte);
LOAD_DLL_FN (library, ts_node_has_error); LOAD_DLL_FN (library, ts_node_has_error);
LOAD_DLL_FN (library, ts_node_is_extra); LOAD_DLL_FN (library, ts_node_is_extra);
LOAD_DLL_FN (library, ts_node_is_missing); LOAD_DLL_FN (library, ts_node_is_missing);
@ -232,8 +226,6 @@ init_treesit_functions (void)
#define ts_node_end_byte fn_ts_node_end_byte #define ts_node_end_byte fn_ts_node_end_byte
#define ts_node_eq fn_ts_node_eq #define ts_node_eq fn_ts_node_eq
#define ts_node_field_name_for_child fn_ts_node_field_name_for_child #define ts_node_field_name_for_child fn_ts_node_field_name_for_child
#define ts_node_first_child_for_byte fn_ts_node_first_child_for_byte
#define ts_node_first_named_child_for_byte fn_ts_node_first_named_child_for_byte
#define ts_node_has_error fn_ts_node_has_error #define ts_node_has_error fn_ts_node_has_error
#define ts_node_is_extra fn_ts_node_is_extra #define ts_node_is_extra fn_ts_node_is_extra
#define ts_node_is_missing fn_ts_node_is_missing #define ts_node_is_missing fn_ts_node_is_missing
@ -2095,6 +2087,41 @@ return nil. */)
return make_treesit_node (XTS_NODE (node)->parser, sibling); return make_treesit_node (XTS_NODE (node)->parser, sibling);
} }
/* Our reimplementation of ts_node_first_child_for_byte. The current
implementation of that function has problems (see bug#60127), so
before it's fixed upstream, we use our own reimplementation of it.
Return true if there is a valid sibling, return false otherwise.
If the return value is false, the position of the cursor is
undefined. (We use cursor because technically we can't make a null
node for ourselves, also, using cursor is more convenient.)
TODO: Remove this function once tree-sitter fixed the bug. */
static bool treesit_cursor_first_child_for_byte
(TSTreeCursor *cursor, ptrdiff_t pos, bool named)
{
if (!ts_tree_cursor_goto_first_child (cursor))
return false;
TSNode node = ts_tree_cursor_current_node (cursor);
while (ts_node_end_byte (node) <= pos)
{
if (ts_tree_cursor_goto_next_sibling (cursor))
node = ts_tree_cursor_current_node (cursor);
else
/* Reached the end and still can't find a valid sibling. */
return false;
}
while (named && (!ts_node_is_named (node)))
{
if (ts_tree_cursor_goto_next_sibling (cursor))
node = ts_tree_cursor_current_node (cursor);
else
/* Reached the end and still can't find a named sibling. */
return false;
}
return true;
}
DEFUN ("treesit-node-first-child-for-pos", DEFUN ("treesit-node-first-child-for-pos",
Ftreesit_node_first_child_for_pos, Ftreesit_node_first_child_for_pos,
Streesit_node_first_child_for_pos, 2, 3, 0, Streesit_node_first_child_for_pos, 2, 3, 0,
@ -2119,16 +2146,17 @@ Note that this function returns an immediate child, not the smallest
ptrdiff_t byte_pos = buf_charpos_to_bytepos (buf, XFIXNUM (pos)); ptrdiff_t byte_pos = buf_charpos_to_bytepos (buf, XFIXNUM (pos));
TSNode treesit_node = XTS_NODE (node)->node; TSNode treesit_node = XTS_NODE (node)->node;
TSNode child;
if (NILP (named))
child = ts_node_first_child_for_byte (treesit_node, byte_pos - visible_beg);
else
child = ts_node_first_named_child_for_byte (treesit_node,
byte_pos - visible_beg);
if (ts_node_is_null (child)) TSTreeCursor cursor = ts_tree_cursor_new (treesit_node);
ptrdiff_t treesit_pos = byte_pos - visible_beg;
bool success;
success = treesit_cursor_first_child_for_byte (&cursor, treesit_pos,
!NILP (named));
TSNode child = ts_tree_cursor_current_node (&cursor);
ts_tree_cursor_delete (&cursor);
if (!success)
return Qnil; return Qnil;
return make_treesit_node (XTS_NODE (node)->parser, child); return make_treesit_node (XTS_NODE (node)->parser, child);
} }
@ -3270,9 +3298,9 @@ a regexp. */)
Lisp_Object parser = XTS_NODE (root)->parser; Lisp_Object parser = XTS_NODE (root)->parser;
Lisp_Object parent = Fcons (Qnil, Qnil); Lisp_Object parent = Fcons (Qnil, Qnil);
TSTreeCursor cursor; /* In this function we never traverse above NODE, so we don't need
if (!treesit_cursor_helper (&cursor, XTS_NODE (root)->node, parser)) to use treesit_cursor_helper. */
return Qnil; TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (root)->node);
treesit_build_sparse_tree (&cursor, parent, predicate, process_fn, treesit_build_sparse_tree (&cursor, parent, predicate, process_fn,
the_limit, parser); the_limit, parser);

96
test/lisp/erc/erc-scenarios-base-local-modules.el
View file

@ -19,8 +19,17 @@
;;; Commentary: ;;; Commentary:
;; These tests all use `sasl' because, as of ERC 5.5, it's the one ;; A local module doubles as a minor mode whose mode variable and
;; and only local module. ;; associated local data can withstand service disruptions.
;; Unfortunately, the current implementation is too unwieldy to be
;; made public because it doesn't perform any of the boiler plate
;; needed to save and restore buffer-local and "network-local" copies
;; of user options. Ultimately, a user-friendly framework must fill
;; this void if third-party local modules are ever to become
;; practical.
;;
;; The following tests all use `sasl' because, as of ERC 5.5, it's the
;; only local module.
;;; Code: ;;; Code:
@ -206,7 +215,7 @@
(erc-cmd-QUIT "") (erc-cmd-QUIT "")
(funcall expect 10 "finished"))) (funcall expect 10 "finished")))
(ert-info ("Disabling works from a target buffer.") (ert-info ("Disabling works from a target buffer")
(with-current-buffer "#chan" (with-current-buffer "#chan"
(should erc-sasl-mode) (should erc-sasl-mode)
(call-interactively #'erc-sasl-disable) (call-interactively #'erc-sasl-disable)
@ -214,10 +223,9 @@
(should (local-variable-p 'erc-sasl-mode)) (should (local-variable-p 'erc-sasl-mode))
(should-not (buffer-local-value 'erc-sasl-mode (get-buffer "foonet"))) (should-not (buffer-local-value 'erc-sasl-mode (get-buffer "foonet")))
(erc-cmd-RECONNECT) (erc-cmd-RECONNECT)
(with-current-buffer "#chan"
(funcall expect 10 "Some enigma, some riddle") (funcall expect 10 "Some enigma, some riddle")
(should-not erc-sasl-mode) ; regression (should-not erc-sasl-mode) ; regression
(should (local-variable-p 'erc-sasl-mode)))) (should (local-variable-p 'erc-sasl-mode)))
(with-current-buffer "foonet" (with-current-buffer "foonet"
(should (local-variable-p 'erc-sasl-mode)) (should (local-variable-p 'erc-sasl-mode))
@ -239,4 +247,82 @@
(should erc-sasl-mode) (should erc-sasl-mode)
(funcall expect 10 "User modes for tester"))))) (funcall expect 10 "User modes for tester")))))
(defvar-local erc-scenarios-base-local-modules--local-var nil)
(define-erc-module -phony-sblm- nil
"Test module for `erc-scenarios-base-local-modules--var-persistence'."
((when-let ((vars (or erc--server-reconnecting erc--target-priors)))
(should (assq 'erc--phony-sblm--mode vars))
(setq erc-scenarios-base-local-modules--local-var
(alist-get 'erc-scenarios-base-local-modules--local-var vars)))
(setq erc-scenarios-base-local-modules--local-var
(or erc-scenarios-base-local-modules--local-var
(if erc--target 100 0))))
((kill-local-variable 'erc-scenarios-base-local-modules--local-var))
'local)
;; Note: this file has grown too expensive (time-wise) and must be
;; split up. When that happens, this test should be rewritten without
;; any time-saving hacks, namely, server-initiated JOINs and an
;; absence of QUITs. (That said, three connections in under 2 seconds
;; is pretty nice.)
(ert-deftest erc-scenarios-base-local-modules--var-persistence ()
:tags '(:expensive-test)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/reconnect")
(erc-server-flood-penalty 0.1)
(dumb-server (erc-d-run "localhost" t 'options 'options 'options))
(port (process-contact dumb-server :service))
(erc-modules (cons '-phony-sblm- (remq 'autojoin erc-modules)))
(expect (erc-d-t-make-expecter))
(server-buffer-name (format "127.0.0.1:%d" port)))
(ert-info ("Initial authentication succeeds as expected")
(with-current-buffer (erc :server "127.0.0.1"
:port port
:nick "tester"
:password "changeme"
:full-name "tester")
(should (string= (buffer-name) server-buffer-name)))
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "FooNet"))
(funcall expect 10 "This server is in debug mode")
(should erc--phony-sblm--mode)
(should (eql erc-scenarios-base-local-modules--local-var 0))
(setq erc-scenarios-base-local-modules--local-var 1)))
(ert-info ("Save module's local var in target buffer")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(should (eql erc-scenarios-base-local-modules--local-var 100))
(setq erc-scenarios-base-local-modules--local-var 101)
(funcall expect 20 "welcome")))
(with-current-buffer "FooNet" (funcall expect 20 "terminated"))
(ert-info ("Vars reused when mode was left enabled")
(with-current-buffer "#chan"
(erc-cmd-RECONNECT)
(funcall expect 20 "welcome")
(should (eql erc-scenarios-base-local-modules--local-var 101))
(erc--phony-sblm--mode -1))
(with-current-buffer "FooNet"
(funcall expect 10 "User modes for tester")
(should (eql erc-scenarios-base-local-modules--local-var 1))))
(with-current-buffer "FooNet" (funcall expect 20 "terminated"))
(ert-info ("Local binding gone when mode disabled in target")
(with-current-buffer "#chan"
(erc-cmd-RECONNECT)
(funcall expect 20 "welcome")
(should-not erc--phony-sblm--mode)
(should-not erc-scenarios-base-local-modules--local-var))
;; But value retained in server buffer, where mode is active.
(with-current-buffer "FooNet"
(funcall expect 10 "User modes for tester")
(should (eql erc-scenarios-base-local-modules--local-var 1))))))
;;; erc-scenarios-local-modules.el ends here ;;; erc-scenarios-local-modules.el ends here

19
test/lisp/erc/erc-tests.el
View file

@ -1251,6 +1251,10 @@
(setq calls nil))))) (setq calls nil)))))
(ert-deftest erc--merge-local-modes () (ert-deftest erc--merge-local-modes ()
(cl-letf (((get 'erc-b-mode 'erc-module) 'b)
((get 'erc-c-mode 'erc-module) 'c)
((get 'erc-d-mode 'erc-module) 'd)
((get 'erc-e-mode 'erc-module) 'e))
(ert-info ("No existing modes") (ert-info ("No existing modes")
(let ((old '((a) (b . t))) (let ((old '((a) (b . t)))
@ -1262,7 +1266,13 @@
(let ((old '((a) (erc-b-mode) (c . t) (erc-d-mode . t) (erc-e-mode . t))) (let ((old '((a) (erc-b-mode) (c . t) (erc-d-mode . t) (erc-e-mode . t)))
(new '(erc-b-mode erc-d-mode))) (new '(erc-b-mode erc-d-mode)))
(should (equal (erc--merge-local-modes new old) (should (equal (erc--merge-local-modes new old)
'((erc-d-mode erc-e-mode) . (erc-b-mode))))))) '((erc-d-mode erc-e-mode) . (erc-b-mode))))))
(ert-info ("Non-module erc-prefixed mode ignored")
(let ((old '((erc-b-mode) (erc-f-mode . t) (erc-d-mode . t)))
(new '(erc-b-mode)))
(should (equal (erc--merge-local-modes new old)
'((erc-d-mode) . (erc-b-mode))))))))
(ert-deftest define-erc-module--global () (ert-deftest define-erc-module--global ()
(let ((global-module '(define-erc-module mname malias (let ((global-module '(define-erc-module mname malias
@ -1300,13 +1310,15 @@ Some docstring"
(ignore c) (ignore d)) (ignore c) (ignore d))
(defalias 'erc-malias-mode #'erc-mname-mode) (defalias 'erc-malias-mode #'erc-mname-mode)
(put 'erc-malias-mode 'erc-module 'mname)
(put 'erc-mname-mode 'erc-module 'mname)
(put 'erc-mname-mode 'definition-name 'mname) (put 'erc-mname-mode 'definition-name 'mname)
(put 'erc-mname-enable 'definition-name 'mname) (put 'erc-mname-enable 'definition-name 'mname)
(put 'erc-mname-disable 'definition-name 'mname)))))) (put 'erc-mname-disable 'definition-name 'mname))))))
(ert-deftest define-erc-module--local () (ert-deftest define-erc-module--local ()
(let* ((global-module '(define-erc-module mname malias (let* ((global-module '(define-erc-module mname nil ; no alias
"Some docstring" "Some docstring"
((ignore a) (ignore b)) ((ignore a) (ignore b))
((ignore c) (ignore d)) ((ignore c) (ignore d))
@ -1353,8 +1365,7 @@ When called interactively, do so in all buffers for the current connection."
(setq erc-mname-mode nil) (setq erc-mname-mode nil)
(ignore c) (ignore d)))) (ignore c) (ignore d))))
(defalias 'erc-malias-mode #'erc-mname-mode) (put 'erc-mname-mode 'erc-module 'mname)
(put 'erc-mname-mode 'definition-name 'mname) (put 'erc-mname-mode 'definition-name 'mname)
(put 'erc-mname-enable 'definition-name 'mname) (put 'erc-mname-enable 'definition-name 'mname)
(put 'erc-mname-disable 'definition-name 'mname)))))) (put 'erc-mname-disable 'definition-name 'mname))))))

10
test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld
View file

@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*- ;; -*- mode: lisp-data; -*-
((pass 10 "PASS :barnet:changeme")) ((pass 10 "PASS :barnet:changeme"))
((nick 3 "NICK tester")) ((nick 10 "NICK tester"))
((user 3 "USER user 0 * :tester") ((user 10 "USER user 0 * :tester")
(0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester") (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
(0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16") (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.barnet.org 003 tester :This server was created Wed, 12 May 2021 07:41:08 UTC") (0 ":irc.barnet.org 003 tester :This server was created Wed, 12 May 2021 07:41:08 UTC")
@ -17,7 +17,7 @@
(0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3") (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.barnet.org 422 tester :MOTD File is missing")) (0 ":irc.barnet.org 422 tester :MOTD File is missing"))
((mode-user 10.2 "MODE tester +i") ((mode-user 10 "MODE tester +i")
;; No mode answer ^ ;; No mode answer ^
(0 ":tester!~u@xrir8fpe4d7ak.irc JOIN #chan") (0 ":tester!~u@xrir8fpe4d7ak.irc JOIN #chan")
@ -36,9 +36,9 @@
(0 ":irc.znc.in 306 tester :You have been marked as being away") (0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":irc.barnet.org 305 tester :You are no longer marked as being away")) (0 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
((~join 3 "JOIN #chan")) ((~join 10 "JOIN #chan"))
((mode 5 "MODE #chan") ((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt") (0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620805269") (0 ":irc.barnet.org 329 tester #chan 1620805269")
(0.1 ":joe!~u@svpn88yjcdj42.irc PRIVMSG #chan :mike: But, in defense, by mercy, 'tis most just.") (0.1 ":joe!~u@svpn88yjcdj42.irc PRIVMSG #chan :mike: But, in defense, by mercy, 'tis most just.")

10
test/lisp/erc/resources/base/netid/bouncer/foonet-again.eld
View file

@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*- ;; -*- mode: lisp-data; -*-
((pass 10 "PASS :foonet:changeme")) ((pass 10 "PASS :foonet:changeme"))
((nick 3 "NICK tester")) ((nick 10 "NICK tester"))
((user 3 "USER user 0 * :tester") ((user 10 "USER user 0 * :tester")
(0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
(0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16") (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.foonet.org 003 tester :This server was created Wed, 12 May 2021 07:41:09 UTC") (0 ":irc.foonet.org 003 tester :This server was created Wed, 12 May 2021 07:41:09 UTC")
@ -17,7 +17,7 @@
(0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.foonet.org 422 tester :MOTD File is missing")) (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
((mode-user 10.2 "MODE tester +i") ((mode-user 10 "MODE tester +i")
;; No mode answer ^ ;; No mode answer ^
(0 ":tester!~u@nvfhxvqm92rm6.irc JOIN #chan") (0 ":tester!~u@nvfhxvqm92rm6.irc JOIN #chan")
(0 ":irc.foonet.org 353 tester = #chan :alice @bob tester") (0 ":irc.foonet.org 353 tester = #chan :alice @bob tester")
@ -36,9 +36,9 @@
(0 ":irc.foonet.org NOTICE tester :[07:00:32] 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.") (0 ":irc.foonet.org NOTICE tester :[07:00:32] 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.")
(0 ":irc.foonet.org 305 tester :You are no longer marked as being away")) (0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
((~join 3 "JOIN #chan")) ((~join 10 "JOIN #chan"))
((mode 8 "MODE #chan") ((mode 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt") (0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620805271") (0 ":irc.foonet.org 329 tester #chan 1620805271")
(0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :bob: Grows, lives, and dies, in single blessedness.") (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :bob: Grows, lives, and dies, in single blessedness.")

94
test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb Normal file
View file

@ -0,0 +1,94 @@
variable = foo(
[
qwe
], [
rty
], {
a: 3
}
)
tee = [
qwe
]
qux = [1,
2]
att = {a: 1,
b: 2}
a = 1 ? 2 :(
2 + 3
)
unless bismark
sink += 12
else
dog = 99
end
foo1 =
subject.update(
1
)
foo2 =
subject.
update(
# Might make sense to indent this to 'subject' instead; but this
# style seems more popular.
2
)
foo > bar &&
tee < qux
1 .. 2 &&
3
a = foo(j, k) -
bar_tee
qux = foo.fee ?
bar :
tee
with_paren = (a + b *
c * d +
12)
without_paren = a + b *
c * d +
12
{'a' => {
'b' => 'c',
'd' => %w(e f)
}
}
[1, 2, {
'b' => 'c',
'd' => %w(e f)
}
]
foo(a, {
a: b,
c: d
})
foo(foo, bar:
tee)
foo(foo, :bar =>
tee)
# Local Variables:
# mode: ruby-ts
# ruby-after-operator-indent: t
# ruby-block-indent: t
# ruby-method-call-indent: t
# ruby-method-params-indent: t
# End:

6
test/lisp/progmodes/ruby-ts-mode-tests.el
View file

@ -250,8 +250,12 @@ The whitespace before and including \"|\" on each line is removed."
(should (equal (buffer-string) orig)))) (should (equal (buffer-string) orig))))
(kill-buffer buf))))) (kill-buffer buf)))))
(ruby-ts-deftest-indent "ruby-method-params-indent.rb") (ruby-ts-deftest-indent "ruby-ts.rb")
(ruby-ts-deftest-indent "ruby-after-operator-indent.rb")
(ruby-ts-deftest-indent "ruby-block-indent.rb") (ruby-ts-deftest-indent "ruby-block-indent.rb")
(ruby-ts-deftest-indent "ruby-method-call-indent.rb")
(ruby-ts-deftest-indent "ruby-method-params-indent.rb")
(ruby-ts-deftest-indent "ruby-parenless-call-arguments-indent.rb")
(provide 'ruby-ts-mode-tests) (provide 'ruby-ts-mode-tests)

42
test/src/buffer-tests.el
View file

@ -8315,29 +8315,35 @@ dicta sunt, explicabo. "))
(remove-hook 'buffer-list-update-hook bluh)))) (remove-hook 'buffer-list-update-hook bluh))))
(ert-deftest buffer-tests-inhibit-buffer-hooks-indirect () (ert-deftest buffer-tests-inhibit-buffer-hooks-indirect ()
"Indirect buffers do not call `get-buffer-create'." "Test `make-indirect-buffer' argument INHIBIT-BUFFER-HOOKS."
(dolist (inhibit '(nil t)) (let* ( base run-bluh run-kbh run-kbqf
(let ((base (get-buffer-create "foo" inhibit))) (bluh (lambda () (setq run-bluh t)))
(kbh (lambda () (setq run-kbh t)))
(kbqf (lambda () (setq run-kbqf t))))
(dolist (inhibit-base '(nil t))
(unwind-protect (unwind-protect
(dotimes (_i 11) (let (indirect)
(let* (flag* (setq base (generate-new-buffer " base" inhibit-base))
(flag (lambda () (prog1 t (setq flag* t)))) (dolist (inhibit-indirect '(nil t))
(indirect (make-indirect-buffer base "foo[indirect]" nil (dotimes (_ 11)
inhibit)))
(unwind-protect (unwind-protect
(progn (let ((name (generate-new-buffer-name " indirect")))
(with-current-buffer indirect (setq run-bluh nil run-kbh nil run-kbqf nil)
(add-hook 'kill-buffer-query-functions flag nil t)) (add-hook 'buffer-list-update-hook bluh)
(kill-buffer indirect) (with-current-buffer
(if inhibit (setq indirect (make-indirect-buffer
(should-not flag*) base name nil inhibit-indirect))
(should flag*))) (add-hook 'kill-buffer-hook kbh nil t)
(let (kill-buffer-query-functions) (add-hook 'kill-buffer-query-functions kbqf nil t)
(kill-buffer))
(should (xor inhibit-indirect run-bluh))
(should (xor inhibit-indirect run-kbh))
(should (xor inhibit-indirect run-kbqf)))
(remove-hook 'buffer-list-update-hook bluh)
(when (buffer-live-p indirect) (when (buffer-live-p indirect)
(kill-buffer indirect)))))) (kill-buffer indirect))))))
(let (kill-buffer-query-functions)
(when (buffer-live-p base) (when (buffer-live-p base)
(kill-buffer base))))))) (kill-buffer base))))))
(ert-deftest zero-length-overlays-and-not () (ert-deftest zero-length-overlays-and-not ()
(with-temp-buffer (with-temp-buffer