diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS
index 945e69fc690..c8388f74577 100644
--- a/admin/MAINTAINERS
+++ b/admin/MAINTAINERS
@@ -96,6 +96,10 @@ Dmitry Gutov
test/indent/ruby.rb
lisp/progmodes/xref.el
lisp/progmodes/project.el
+ lisp/thread.el
+ src/thread.c
+
+ Thread-related code in src/process.c
Ulf Jasper
Newsticker
@@ -323,12 +327,14 @@ Michael Albinus
lisp/autorevert.el
lisp/eshell/em-tramp.el
lisp/files.el (file-name-non-special)
+ lisp/files-x.el (connection-local variables)
lisp/net/ange-ftp.el
lisp/notifications.el
lisp/shadowfile.el
test/infra/*
test/lisp/autorevert-tests.el
test/lisp/files-tests.el (file-name-non-special)
+ test/lisp/files-x-tests.el (connection-local variables)
test/lisp/shadowfile-tests.el
test/src/inotify-test.el
@@ -381,6 +387,10 @@ Harald Jörg
Spencer Baugh
lisp/progmodes/flymake.el
+ lisp/thread.el
+ src/thread.c
+
+ Thread-related code in src/process.c
Yuan Fu
lisp/progmodes/c-ts-mode.el
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt
index 61d19e54b8e..3257dc6ce46 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -380,12 +380,14 @@ As soon as possible after a release, the Emacs web pages at
should be updated.
(See admin/notes/www for general information.)
-The pages to update are:
+The pages and files to update are:
-emacs.html (for a new major release, a more thorough update is needed)
-history.html
-add the new NEWS file as news/NEWS.xx.y
-Copy new etc/MACHINES to MACHINES and CONTRIBUTE to CONTRIBUTE
+ . emacs.html (see below; for a new major release, a more thorough
+ update is needed)
+ . history.html (add a line for the new release)
+ . add the new NEWS file as news/NEWS.xx.y
+ . copy new etc/MACHINES to MACHINES and CONTRIBUTE to CONTRIBUTE
+ . possibly/rarely also download.html (see below)
For every new release, a banner is displayed on top of the emacs.html
page. Uncomment the release banner in emacs.html. Keep it on the page
diff --git a/admin/tree-sitter/treesit-admin.el b/admin/tree-sitter/treesit-admin.el
index 2e85d6b0d8c..1f1fa1ce752 100644
--- a/admin/tree-sitter/treesit-admin.el
+++ b/admin/tree-sitter/treesit-admin.el
@@ -316,7 +316,7 @@ Return non-nil if all queries are valid, nil otherwise."
;; TODO: A more generic way to find all queries.
(let ((c-ts-mode-enable-doxygen t)
(c-ts-mode-enable-doxygen t)
- (java-ts-mode-enabel-doxygen t))
+ (java-ts-mode-enable-doxygen t))
(funcall mode))
(font-lock-mode -1)
treesit-font-lock-settings)))
diff --git a/configure.ac b/configure.ac
index 8c2e6b421d9..140ff76029e 100644
--- a/configure.ac
+++ b/configure.ac
@@ -2232,9 +2232,9 @@ AC_CACHE_CHECK([for flag to work around GCC union bugs],
[/* Work around GCC bugs 117423 and 119085 re holes in unions:
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=117423
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=119085
- These are fixed in GCC 15.2.
+ These are fixed in GCC 14.4 and 15.2.
- Working wround them also works around GCC bug 58416
+ Working around them also works around GCC bug 58416
with double in unions on x86, where the generated insns
copy non-floating-point data via fldl/fstpl instruction pairs.
This can misbehave if the data's bit pattern looks like a NaN.
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 602c8e5bfb2..e49823384ce 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -702,14 +702,14 @@ the directory.
@kindex touchscreen-hold @r{(Dired)}
@findex dired-click-to-select-mode
@findex dired-enable-click-to-select-mode
-Enter a ``click to select'' mode, where using the mouse button
-@kbd{mouse-2} on a file name will cause its mark to be toggled. This
-mode is useful when performing file management using a touch screen
-device.
+Enter a ``click to select'' mode (@code{dired-click-to-select-mode}),
+where using the mouse button @kbd{mouse-2} on a file name will cause its
+mark to be toggled. This mode is useful when performing file management
+using a touch screen device.
-It is enabled when a ``hold'' gesture (@pxref{Touchscreens}) is
-detected over a file name, and is automatically disabled once a Dired
-command operates on the marked files.
+It is enabled when a ``hold'' gesture (@pxref{Touchscreens}) is detected
+over a file name, and is automatically disabled once a Dired command
+that operates on the marked files finishes.
@end table
@node Operating on Files
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index b373dc092f8..b32c704bd12 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -868,6 +868,8 @@ Miscellaneous Commands and Features of VC
* Change Logs and VC:: Generating a change log file from log entries.
* VC Delete/Rename:: Deleting and renaming version-controlled files.
* Revision Tags:: Symbolic names for revisions.
+* Merge Bases:: The most recent revision existing on both branches.
+* Outgoing Base Diffs:: Diffs including all outstanding changes on a branch.
* Other Working Trees:: Multiple sets of workfiles.
* Version Headers:: Inserting version control headers into working files.
* Editing VC Commands:: Editing the VC shell commands that Emacs will run.
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index ffa3b7f2a58..62311e583b2 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -516,7 +516,7 @@ following subsections. You can use @kbd{C-x v v} either in a
file-visiting buffer, in a Dired buffer, or in a VC Directory buffer;
in the latter two cases the command operates on the fileset consisting
of the marked files. You can also use @kbd{C-x v v}, in a buffer with
-patches under Diff Mode (@pxref{Diff Mode}), in which case the command
+patches under Diff mode (@pxref{Diff Mode}), in which case the command
operates on the files whose diffs are shown in the buffer.
Note that VC filesets are distinct from the named filesets used
@@ -1070,11 +1070,18 @@ non-@code{nil}, @kbd{C-x v I} becomes a prefix key, and
@code{vc-log-incoming} becomes bound to @kbd{C-x v I L}.
@item M-x vc-root-diff-incoming
-Display a diff of the changes that a pull operation will retrieve.
+Display a diff of all changes that a pull operation will retrieve.
If you customize @code{vc-use-incoming-outgoing-prefixes} to
non-@code{nil}, this command becomes available on @kbd{C-x v I D}.
+@item M-x vc-diff-incoming
+Display a diff of changes that a pull operation will retrieve, but
+limited to the current fileset.
+
+If you customize @code{vc-use-incoming-outgoing-prefixes} to
+non-@code{nil}, this command becomes available on @kbd{C-x v I =}.
+
@item C-x v O
Display log entries for the changes that will be sent by the next
``push'' operation (@code{vc-log-outgoing}).
@@ -1084,12 +1091,19 @@ non-@code{nil}, @kbd{C-x v O} becomes a prefix key, and
@code{vc-log-outgoing} becomes bound to @kbd{C-x v O L}.
@item M-x vc-root-diff-outgoing
-Display a diff of the changes that will be sent by the next push
+Display a diff of all changes that will be sent by the next push
operation.
If you customize @code{vc-use-incoming-outgoing-prefixes} to
non-@code{nil}, this command is bound to @kbd{C-x v O D}.
+@item M-x vc-diff-outgoing
+Display a diff of changes that will be sent by the next push operation,
+but limited to the current fileset.
+
+If you customize @code{vc-use-incoming-outgoing-prefixes} to
+non-@code{nil}, this command becomes available on @kbd{C-x v O =}.
+
@item C-x v h
Display the history of changes made in the region of file visited by
the current buffer (@code{vc-region-history}).
@@ -1176,13 +1190,21 @@ version control system can be a branch name.
@findex vc-root-diff-outgoing
The closely related commands @code{vc-root-diff-incoming} and
@code{vc-root-diff-outgoing} are the diff analogues of
-@code{vc-log-incoming} and @code{vc-log-outgoing}. These display a diff
-buffer reporting the changes that would be pulled or pushed. You can
+@code{vc-log-incoming} and @code{vc-log-outgoing}. These display diff
+buffers reporting the changes that would be pulled or pushed. You can
use a prefix argument here too to specify a particular remote location.
@code{vc-root-diff-outgoing} is useful as a way to preview your push and
quickly check that all and only the changes you intended to include were
committed and will be pushed.
+@findex vc-diff-incoming
+@findex vc-diff-outgoing
+ The commands @code{vc-diff-incoming} and @code{vc-diff-outgoing} are
+very similar. They also display changes that would be pulled or pushed.
+The difference is that the diffs reported are limited to the current
+fileset. Don't forget that actual pull and push operations always
+affect the whole working tree, not just the current fileset.
+
@cindex VC log buffer, commands in
@cindex vc-log buffer
In the @file{*vc-change-log*} buffer, you can use the following keys
@@ -1793,7 +1815,7 @@ and so on, depending on the number of existing branches at that point.
@kindex C-x v b c
@findex vc-create-branch
This procedure will not work for distributed version control systems
-like git or Mercurial. For those systems you should use the command
+like Git or Mercurial. For those systems you should use the command
@code{vc-create-branch} (@w{@kbd{C-x v b c @var{branch-name} @key{RET}}})
instead.
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index c3008a48b04..b5049ccbd01 100644
--- a/doc/emacs/modes.texi
+++ b/doc/emacs/modes.texi
@@ -507,6 +507,25 @@ predictable behavior, we recommend that you always customize
this variable overrides any remapping that Emacs might decide to perform
internally.
+@vindex treesit-enabled-modes
+ As a convenience feature for enabling major modes based on the
+tree-sitter library (@pxref{Parsing Program Source,,, elisp, The Emacs
+Lisp Reference Manual}), you can customize the user option
+@code{treesit-enabled-modes} to selectively enable or disable
+tree-sitter based modes: if the value is @code{t}, that enables all the
+available tree-sitter based modes; if it is a list of mode names, that
+enables only those modes. Customizing this option adds the
+corresponding mappings to @code{major-mode-remap-alist} such as
+remapping from @code{c-mode} to @code{c-ts-mode} (if you enable the
+latter). By default, this option's value is @code{nil}, so no
+tree-sitter based modes are enabled.
+
+Enabling a tree-stter based mode means that visiting files in the
+corresponding programming language will automatically turn on that mode,
+instead of any non-tree-sitter based modes for the same language. For
+example, if you enable @code{c-ts-mode}, visiting C source files will
+turn on @code{c-ts-mode} instead of @code{c-mode}.
+
@findex normal-mode
If you have changed the major mode of a buffer, you can return to
the major mode Emacs would have chosen automatically, by typing
diff --git a/doc/emacs/screen.texi b/doc/emacs/screen.texi
index ca3690edb9a..e2546ce132d 100644
--- a/doc/emacs/screen.texi
+++ b/doc/emacs/screen.texi
@@ -234,7 +234,7 @@ current buffer is on a remote machine, @samp{@@} is displayed instead.
@var{d} appears if the window is dedicated to its current buffer.
It appears as @samp{D} for strong dedication and @samp{d} for other
forms of dedication. If the window is not dedicated, @var{d} does not
-appear. @xref{Dedicated Windows,, elisp, The Emacs Lisp Reference
+appear. @xref{Dedicated Windows,,, elisp, The Emacs Lisp Reference
Manual}.
@var{fr} gives the selected frame name (@pxref{Frames}). It appears
diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi
index 72e660a2def..f235ccfa5fb 100644
--- a/doc/emacs/vc1-xtra.texi
+++ b/doc/emacs/vc1-xtra.texi
@@ -14,6 +14,8 @@
* Change Logs and VC:: Generating a change log file from log entries.
* VC Delete/Rename:: Deleting and renaming version-controlled files.
* Revision Tags:: Symbolic names for revisions.
+* Merge Bases:: The most recent revision existing on both branches.
+* Outgoing Base Diffs:: Diffs including all outstanding changes on a branch.
* Other Working Trees:: Multiple sets of workfiles.
* Version Headers:: Inserting version control headers into working files.
* Editing VC Commands:: Editing the VC shell commands that Emacs will run.
@@ -227,6 +229,153 @@ an old tag, the renamed file is retrieved under its new name, which is
not the name that the makefile expects. So the program won't really
work as retrieved.
+@node Merge Bases
+@subsubsection Merge Bases
+@cindex merge bases
+
+@table @kbd
+@item C-x v M D
+Report diffs of changes on a branch since it diverged from another
+(@code{vc-diff-mergebase}).
+
+@item C-x v M L
+Display log messages for revisions on a branch since it diverged from
+another (@code{vc-log-mergebase}).
+@end table
+
+@c This definition is possibly dVCS-specific -- can revisions exist on
+@c more than one branch for older VCS? This needs thinking through if
+@c any of our centalized VCS gain support for these commands.
+The @dfn{merge base} of two branches is the most recent revision that
+exists on both branches. If neither of the branches was ever merged
+into the other (@pxref{Merging}), then the merge base is the revision
+that the older of the two branches was at when the newer branch was
+created from it (@pxref{Creating Branches}). If one of the branches was
+ever merged into the other, then the merge base is the most recent merge
+point.
+
+The commands described in this section are currently implemented only
+for decentralized version control systems (@pxref{VCS Repositories}).
+
+@kindex C-x v M D
+@findex vc-diff-mergebase
+@kindex C-x v M L
+@findex vc-log-mergebase
+Merge bases are useful to make certain comparisons between branches, and
+Emacs provides two commands for doing so. Each of @kbd{C-x v M D}
+(@code{vc-diff-mergebase}) and @kbd{C-x v M L} (@code{vc-log-mergebase})
+prompts for two branches, finds their merge base, and then compares that
+merge base with the second of the two branches. The commands report
+diffs and display change history, respectively.
+
+The typical use case for these commands is when one of the branches was
+originally created from the other and you or a collaborator have made
+merges of one of the branches into the other at least once. Then you
+can use these commands to see what changes on one branch have not yet
+been merged into the other.
+
+Call the branch which has the changes you are interested in the ``source
+branch'' and the branch into which these changes have not yet been
+merged the ``target branch''. Specify the target branch when prompted
+for the ``older revision'' and the source branch when prompted for the
+``newer revision''.@footnote{The concept of merge bases generalizes from
+branches to any two revisions. The merge base of two revisions is the
+most recent revision that can be found in the revision history of both
+of the two revisions. @kbd{C-x v M D} and @kbd{C-x v M L} accept any
+two revisions, not just branches. Comparing two branches is the same as
+comparing the revisions at the ends of the branches.
+
+(In fact the concept generalizes to any number of revisions, but Emacs's
+commands for merge bases work with only two, so we limit ourselves to
+that.)} Then @kbd{C-x v M D} shows you a preview of what would change
+on the target branch if you were to merge the source branch into it, and
+@kbd{C-x v M L} shows you a log of the changes on the source branch not
+yet merged into the target branch.
+
+@node Outgoing Base Diffs
+@subsubsection Commands for diffs including all outstanding changes
+@cindex outstanding changes
+
+@table @kbd
+@item C-x v B =
+Display diffs of changes to the VC fileset since the merge base of this
+branch and its upstream counterpart (@code{vc-diff-outgoing-base}).
+
+@item C-x v B D
+Display all changes since the merge base of this branch and its upstream
+counterpart (@code{vc-root-diff-outgoing-base}).
+@end table
+
+For decentralized version control systems (@pxref{VCS Repositories}),
+these commands provide specialized versions of @kbd{C-x v M D} (see
+@pxref{Merge Bases}) which also take into account the state of upstream
+repositories. These commands are useful both when working on a single
+branch and when developing features on a separate branch
+(@pxref{Branches}). These two cases involve using the commands
+differently, and so we will describe them separately.
+
+First, consider working on a single branch. @dfn{Outstanding changes}
+are those which you haven't yet pushed upstream. This includes both
+unpushed commits and uncommitted changes in your working tree. In many
+cases the reason these changes are not pushed yet is that they are not
+finished: the changes committed so far don't make sense in isolation.
+
+@kindex C-x v B =
+@findex vc-diff-outgoing-base
+@kindex C-x v B D
+@findex vc-root-diff-outgoing-base
+Type @kbd{C-x v B D} (@code{vc-root-diff-outgoing-base}) to display a
+summary of all these changes, committed and uncommitted. This summary
+is in the form of a diff of what committing and pushing (@pxref{Pulling
+/ Pushing}) all these changes would do to the upstream repository. You
+can use @kbd{C-x v B =} (@code{vc-diff-outgoing-base}) instead to limit
+the display of changes to the current VC fileset. (The difference
+between @w{@kbd{C-x v B D}} and @w{@kbd{C-x v B =}} is like the
+difference between @kbd{C-x v D} and @kbd{C-x v =} (@pxref{Old
+Revisions}).)@footnote{Another point of comparison is that these
+commands are like @w{@kbd{C-x v O =}} (@code{vc-fileset-diff-outgoing})
+and @kbd{C-x v O D} (@code{vc-root-diff-outgoing}) except that they
+include uncommitted changes in the reported diffs. Like those other
+commands, you can use a prefix argument to specify a particular upstream
+location.}
+
+Second, consider developing a feature on a separate branch. Call this
+the @dfn{feature branch},@footnote{Many version control workflows
+involve developing new features on isolated branches. However, the term
+``feature branch'' is usually reserved for a particular kind of isolated
+branch, one that other branches are repeatedly merged into.
+
+That doesn't matter to this explanation, so we use ``feature branch'' to
+refer to the separate branch used for developing the feature even though
+whether it is really a feature branch depends on other aspects of the
+branching workflow in use.} and call the branch from which the feature
+branch was originally created the @dfn{trunk} or @dfn{development
+trunk}.
+
+In this case, outstanding changes is a more specific notion than just
+unpushed and uncommitted changes on the feature branch. You're not
+finished sharing changes with your collaborators until they have been
+merged into the trunk, and pushed. Therefore, in this example,
+outstanding changes are those which haven't yet been integrated into the
+upstream repository's development trunk. That means committed changes
+on the feature branch that haven't yet been merged into the trunk, plus
+uncommitted changes.
+
+@cindex outgoing base, version control
+The @dfn{outgoing base} is the upstream location for which the changes
+are destined once they are no longer outstanding. In this case, that's
+the upstream version of the trunk, to which you and your collaborators
+push finished work.
+
+To display a summary of outgoing changes in this multi-branch example,
+supply a prefix argument, by typing @w{@kbd{C-u C-x v B =}} or
+@w{@kbd{C-u C-x v B D}}. When prompted, enter the outgoing base.
+Exactly what you must supply here depends on the name of your
+development trunk and the version control system in use. For example,
+with Git, usually you will enter @kbd{origin/master}. We hope to
+improve these commands such that no prefix argument is required in the
+multi-branch case, too.
+
@node Other Working Trees
@subsubsection Multiple Working Trees for One Repository
@@ -324,6 +473,16 @@ do and do not exist. In other words, the file or directory the current
buffer visits probably exists in other working trees too, and this
command lets you switch to those versions of the file.
+@kbd{C-x v w w} also works in Diff mode (@pxref{Diff Mode}). Instead of
+switching to a different buffer, the command changes the default
+directory of the Diff mode buffer to the corresponding directory under
+another working tree. This is useful with Diff mode buffers generated
+by VC commands, such as @kbd{C-x v =} and @kbd{C-x v D} (@pxref{Old
+Revisions}). You can use @kbd{C-x v w w} and then standard Diff mode
+commands like @w{@kbd{C-c C-a}} (@code{diff-apply-hunk}) and @kbd{C-c
+RET C-a} (@code{diff-apply-buffer}) to apply hunks from one working tree
+to another.
+
@kindex C-x v w s
@findex vc-working-tree-switch-project
An alternative way to switch between working trees is @kbd{C-x v w s}
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 4d00d27bd46..8df8cd215f5 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -1489,8 +1489,8 @@ Each clause normally has the form @w{@code{(@var{condition}
@findex bind*
@code{(bind* @var{bindings}@dots{})} means to bind @var{bindings} (like
the bindings list in @code{let*}, @pxref{Local Variables}) for the body
-of the clause. As a condition, it counts as true if the first binding's
-value is non-@code{nil}.
+of the clause, and all subsequent clauses. As a condition, it counts as
+true if the first binding's value is non-@code{nil}.
@findex match*
@findex pcase*
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 15836591032..2f5e4d27c46 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -256,38 +256,47 @@ commands; all except for @kbd{S} resume execution of the program, at
least for a certain distance.
@table @kbd
+@findex edebug-stop
@item S
Stop: don't execute any more of the program, but wait for more
Edebug commands (@code{edebug-stop}).
@c FIXME Does not work. https://debbugs.gnu.org/9764
+@findex edebug-step-mode
@item @key{SPC}
Step: stop at the next stop point encountered (@code{edebug-step-mode}).
+@findex edebug-next-mode
@item n
Next: stop at the next stop point encountered after an expression
(@code{edebug-next-mode}). Also see @code{edebug-forward-sexp} in
@ref{Jumping}.
+@findex edebug-trace-mode
@item t
Trace: pause (normally one second) at each Edebug stop point
(@code{edebug-trace-mode}).
+@findex edebug-Trace-fast-mode
@item T
Rapid trace: update the display at each stop point, but don't actually
pause (@code{edebug-Trace-fast-mode}).
+@findex edebug-go-mode
@item g
Go: run until the next breakpoint (@code{edebug-go-mode}). @xref{Breakpoints}.
+@findex edebug-continue-mode
@item c
Continue: pause one second at each breakpoint, and then continue
(@code{edebug-continue-mode}).
+@findex edebug-Continue-fast-mode
@item C
Rapid continue: move point to each breakpoint, but don't pause
(@code{edebug-Continue-fast-mode}).
+@findex edebug-Go-nonstop-mode
@item G
Go non-stop: ignore breakpoints (@code{edebug-Go-nonstop-mode}). You
can still stop the program by typing @kbd{S}, or any editing command.
@@ -345,25 +354,30 @@ in trace mode or continue mode. The default is 1 second.
The commands described in this section execute until they reach a
specified location. All except @kbd{i} make a temporary breakpoint to
-establish the place to stop, then switch to go mode. Any other
-breakpoint reached before the intended stop point will also stop
-execution. @xref{Breakpoints}, for the details on breakpoints.
+establish the place to stop, then switch to go mode (@pxref{Edebug
+Execution Modes}). Any other breakpoint reached before the intended
+stop point will also stop execution. @xref{Breakpoints}, for the
+details on breakpoints.
These commands may fail to work as expected in case of nonlocal exit,
as that can bypass the temporary breakpoint where you expected the
program to stop.
@table @kbd
+@findex edebug-goto-here
@item h
Proceed to the stop point near where point is (@code{edebug-goto-here}).
+@findex edebug-forward-sexp
@item f
Run the program for one expression
(@code{edebug-forward-sexp}).
+@findex edebug-step-out
@item o
Run the program until the end of the containing sexp (@code{edebug-step-out}).
+@findex edebug-step-in
@item i
Step into the function or macro called by the form after point
(@code{edebug-step-in}).
@@ -397,7 +411,7 @@ containing sexp is a function definition itself, @kbd{o} continues until
just before the last sexp in the definition. If that is where you are
now, it returns from the function and then stops. In other words, this
command does not exit the currently executing function unless you are
-positioned after the last sexp.
+positioned after the last sexp of that function.
Normally, the @kbd{h}, @kbd{f}, and @kbd{o} commands display ``Break''
and pause for @code{edebug-sit-for-seconds} before showing the result
@@ -421,14 +435,17 @@ arrange to deinstrument it.
Some miscellaneous Edebug commands are described here.
@table @kbd
+@findex edebug-help
@item ?
Display the help message for Edebug (@code{edebug-help}).
+@findex abort-recursive-edit @r{(Edebug)}
@item a
@itemx C-]
Abort one level back to the previous command level
-(@code{abort-recursive-edit}).
+(@code{abort-recursive-edit}). @xref{Recursive Editing}.
+@findex top-level @r{(Edebug)}
@item q
Return to the top level editor command loop (@code{top-level}). This
exits all recursive editing levels, including all levels of Edebug
@@ -436,14 +453,17 @@ activity. However, instrumented code protected with
@code{unwind-protect} or @code{condition-case} forms may resume
debugging.
+@findex edebug-top-level-nonstop
@item Q
Like @kbd{q}, but don't stop even for protected code
(@code{edebug-top-level-nonstop}).
+@findex edebug-previous-result
@item r
Redisplay the most recently known expression result in the echo area
(@code{edebug-previous-result}).
+@findex edebug-pop-to-backtrace
@item d
Display a backtrace, excluding Edebug's own functions for clarity
(@code{edebug-pop-to-backtrace}).
@@ -473,9 +493,10 @@ display a backtrace of all the pending evaluations with @kbd{d}.
@node Breaks
@subsection Breaks
-Edebug's step mode stops execution when the next stop point is reached.
-There are three other ways to stop Edebug execution once it has started:
-breakpoints, the global break condition, and source breakpoints.
+Edebug's step mode (@pxref{Edebug Execution Modes}) stops execution when
+the next stop point is reached. There are three other ways to stop
+Edebug execution once it has started: breakpoints, the global break
+condition, and source breakpoints.
@menu
* Breakpoints:: Breakpoints at stop points.
@@ -495,6 +516,9 @@ the first one at or after point in the source code buffer. Here are the
Edebug commands for breakpoints:
@table @kbd
+@findex edebug-set-breakpoint
+@vindex edebug-enabled-breakpoint @r{(face)}
+@vindex edebug-disabled-breakpoint @r{(face)}
@item b
Set a breakpoint at the stop point at or after point
(@code{edebug-set-breakpoint}). If you use a prefix argument, the
@@ -502,26 +526,34 @@ breakpoint is temporary---it turns off the first time it stops the
program. An overlay with the @code{edebug-enabled-breakpoint} or
@code{edebug-disabled-breakpoint} faces is put at the breakpoint.
+@findex edebug-unset-breakpoint
@item u
Unset the breakpoint (if any) at the stop point at or after
point (@code{edebug-unset-breakpoint}).
+@findex edebug-unset-breakpoints
@item U
Unset any breakpoints in the current form
(@code{edebug-unset-breakpoints}).
+@findex edebug-toggle-disable-breakpoint
@item D
Toggle whether to disable the breakpoint near point
(@code{edebug-toggle-disable-breakpoint}). This command is mostly
useful if the breakpoint is conditional and it would take some work to
recreate the condition.
+@findex edebug-set-conditional-breakpoint
@item x @var{condition} @key{RET}
Set a conditional breakpoint which stops the program only if
evaluating @var{condition} produces a non-@code{nil} value
(@code{edebug-set-conditional-breakpoint}). With a prefix argument,
the breakpoint is temporary.
+@item X @var{condition} @key{RET}
+Set @code{edebug-global-break-condition} to @var{condition}.
+
+@findex edebug-next-breakpoint
@item B
Move point to the next breakpoint in the current definition
(@code{edebug-next-breakpoint}).
@@ -542,6 +574,8 @@ conditional breakpoint, use @kbd{x}, and specify the condition
expression in the minibuffer. Setting a conditional breakpoint at a
stop point that has a previously established conditional breakpoint puts
the previous condition expression in the minibuffer so you can edit it.
+(You can also use @kbd{X} to set the global break condition, to be
+evaluated at every stop point, @pxref{Global Break Condition}.)
You can make a conditional or unconditional breakpoint
@dfn{temporary} by using a prefix argument with the command to set the
@@ -566,8 +600,9 @@ point in the buffer.
condition is satisfied, no matter where that may occur. Edebug
evaluates the global break condition at every stop point; if it
evaluates to a non-@code{nil} value, then execution stops or pauses
-depending on the execution mode, as if a breakpoint had been hit. If
-evaluating the condition gets an error, execution does not stop.
+depending on the execution mode (@pxref{Edebug Execution Modes}), as if
+a breakpoint had been hit. If evaluating the condition gets an error,
+execution does not stop.
@findex edebug-set-global-break-condition
The condition expression is stored in
@@ -603,7 +638,8 @@ argument reaches zero:
When the @code{fac} definition is instrumented and the function is
called, the call to @code{edebug} acts as a breakpoint. Depending on
-the execution mode, Edebug stops or pauses there.
+the execution mode (@pxref{Edebug Execution Modes}), Edebug stops or
+pauses there.
If no instrumented code is being executed when @code{edebug} is called,
that function calls @code{debug}.
@@ -640,17 +676,27 @@ configuration is the collection of windows and contents that were in
effect outside of Edebug.
@table @kbd
-@item P
-@itemx v
+@findex edebug-view-outside
+@item v
Switch to viewing the outside window configuration
(@code{edebug-view-outside}). Type @kbd{C-x X w} to return to Edebug.
+@findex edebug-bounce-point
@item p
Temporarily display the outside current buffer with point at its
outside position (@code{edebug-bounce-point}), pausing for one second
before returning to Edebug. With a prefix argument @var{n}, pause for
@var{n} seconds instead.
+@findex edebug-bounce-to-previous-value
+@item P
+Temporarily display the outside current buffer with the outside point
+corresponding to the previously-evaluated value
+(@code{edebug-bounce-to-previous-value}), pausing for one second
+before returning to Edebug. With a prefix argument @var{n}, pause for
+@var{n} seconds instead.
+
+@findex edebug-where
@item w
Move point back to the current stop point in the source code buffer
(@code{edebug-where}).
@@ -659,6 +705,7 @@ If you use this command in a different window displaying the same
buffer, that window will be used instead to display the current
definition in the future.
+@findex edebug-toggle-save-windows
@item W
@c Its function is not simply to forget the saved configuration -- dan
Toggle whether Edebug saves and restores the outside window
@@ -673,6 +720,23 @@ source code buffer, you must use @kbd{C-x X W} from the global keymap.
bounce to the point in the current buffer with @kbd{p}, even if
it is not normally displayed.
+ You can also bounce to buffer positions other than the current point.
+Suppose you are debugging the form
+
+@example
+(make-overlay beg end)
+@end example
+
+@noindent
+and you would like to know where @code{beg} and @code{end} are located
+in the outside buffer. Then you could either evaluate these, for
+example, with @kbd{C-x C-e}, or step over them with @kbd{n}, and
+immediately after that press @kbd{P}, to bounce to the position you have
+previously evaluated. The previous value for the purpose of the @kbd{P}
+command is what Edebug has evaluated before its last stop point or what
+you have evaluated in the context outside of Edebug, for example, with
+@kbd{C-x C-e}.
+
After moving point, you may wish to jump back to the stop point.
You can do that with @kbd{w} from a source code buffer. You can jump
back to the stop point in the source code buffer from any buffer using
@@ -697,6 +761,7 @@ explicitly saves and restores. @xref{The Outside Context}, for details
on this process.
@table @kbd
+@findex edebug-eval-expression
@item e @var{exp} @key{RET}
Evaluate expression @var{exp} in the context outside of Edebug
(@code{edebug-eval-expression}). That is, Edebug tries to minimize
@@ -707,30 +772,47 @@ pretty-print the result there.
By default, this command
suppresses the debugger during evaluation, so that an error in the
evaluated expression won't add a new error on top of the existing one.
-Set the @code{debug-allow-recursive-debug} user option to a
-non-@code{nil} value to override this.
+Set the @code{debug-allow-recursive-debug} user option (@pxref{Error
+Debugging}) to a non-@code{nil} value to override this.
+@findex eval-expression @r{(Edebug)}
@item M-: @var{exp} @key{RET}
Evaluate expression @var{exp} in the context of Edebug itself
(@code{eval-expression}).
+@findex edebug-eval-last-sexp
@item C-x C-e
Evaluate the expression before point, in the context outside of Edebug
-(@code{edebug-eval-last-sexp}). With the prefix argument of zero
-(@kbd{C-u 0 C-x C-e}), don't shorten long items (like strings and
-lists). Any other prefix will result in the value being
-pretty-printed in a separate buffer.
+(@code{edebug-eval-last-sexp}) and show the value in the minibuffer.
+With the prefix argument of zero (@kbd{C-u 0 C-x C-e}), don't shorten
+long items (like strings and lists) when showing the value, due to
+@code{edebug-print-length} and @code{edebug-print-level}
+(@pxref{Printing in Edebug}). Any other prefix will result in the value
+being pretty-printed in a separate buffer instead of the minibuffer.
@end table
+@xref{Eval List}, for additional Edebug features related to evaluating
+lists of expressions interactively.
+
+@cindex lexical binding (Edebug)
+@findex cl-macrolet @r{(Edebug)}
+@findex cl-symbol-macrolet @r{(Edebug)}
+ Edebug supports evaluation of expressions containing references to
+lexically bound symbols created by the following constructs in
+@file{cl-lib.el}: @code{cl-macrolet} and @code{cl-symbol-macrolet}.
+@c FIXME? What about lexical-binding = t?
+
@node Eval List
@subsection Evaluation List Buffer
+@cindex evaluation list buffer
You can use the @dfn{evaluation list buffer}, called @file{*edebug*}, to
evaluate expressions interactively. You can also set up the
@dfn{evaluation list} of expressions to be evaluated automatically each
time Edebug updates the display.
@table @kbd
+@findex edebug-visit-eval-list
@item E
Switch to the evaluation list buffer @file{*edebug*}
(@code{edebug-visit-eval-list}).
@@ -741,20 +823,25 @@ Interaction mode (@pxref{Lisp Interaction,,, emacs, The GNU Emacs
Manual}) as well as these special commands:
@table @kbd
+@findex edebug-eval-print-last-sexp
@item C-j
Evaluate the expression before point, in the outside context, and
insert the value in the buffer (@code{edebug-eval-print-last-sexp}).
With prefix argument of zero (@kbd{C-u 0 C-j}), don't shorten long
-items (like strings and lists).
+items (like strings and lists) due to @code{edebug-print-length} and
+@code{edebug-print-level} (@pxref{Printing in Edebug}).
+@findex edebug-eval-last-sexp
@item C-x C-e
Evaluate the expression before point, in the context outside of Edebug
(@code{edebug-eval-last-sexp}).
+@findex edebug-update-eval-list
@item C-c C-u
Build a new evaluation list from the contents of the buffer
(@code{edebug-update-eval-list}).
+@findex edebug-delete-eval-item
@item C-c C-d
Delete the evaluation list group that point is in
(@code{edebug-delete-eval-item}).
@@ -797,24 +884,36 @@ not interrupt your debugging.
several expressions have been added to it:
@smallexample
+@group
(current-buffer)
#
;---------------------------------------------------------------
+@end group
+@group
(selected-window)
#
;---------------------------------------------------------------
+@end group
+@group
(point)
196
;---------------------------------------------------------------
+@end group
+@group
bad-var
"Symbol's value as variable is void: bad-var"
;---------------------------------------------------------------
+@end group
+@group
(recursion-depth)
0
;---------------------------------------------------------------
+@end group
+@group
this-command
eval-last-sexp
;---------------------------------------------------------------
+@end group
@end smallexample
To delete a group, move point into it and type @kbd{C-c C-d}, or simply
@@ -825,8 +924,9 @@ the expression at a suitable place, insert a new comment line, then type
contents don't matter.
After selecting @file{*edebug*}, you can return to the source code
-buffer with @kbd{C-c C-w}. The @file{*edebug*} buffer is killed when
-you continue execution, and recreated next time it is needed.
+buffer with @kbd{C-c C-w} (@pxref{Edebug Views}). The @file{*edebug*}
+buffer is killed when you continue execution, and recreated next time it
+is needed.
@node Printing in Edebug
@subsection Printing in Edebug
@@ -860,8 +960,10 @@ to a non-@code{nil} value.
Here is an example of code that creates a circular structure:
@example
+@group
(setq a (list 'x 'y))
(setcar a a)
+@end group
@end example
@noindent
@@ -883,11 +985,14 @@ printing results. The default value is @code{t}.
@node Trace Buffer
@subsection Trace Buffer
@cindex trace buffer
+@cindex Edebug trace buffer
+@cindex tracing in Edebug
Edebug can record an execution trace, storing it in a buffer named
@file{*edebug-trace*}. This is a log of function calls and returns,
showing the function names and their arguments and values. To enable
-trace recording, set @code{edebug-trace} to a non-@code{nil} value.
+trace recording, set @code{edebug-trace} to a non-@code{nil} value
+(@pxref{Edebug Options}).
Making a trace buffer is not the same thing as using trace execution
mode (@pxref{Edebug Execution Modes}).
@@ -918,7 +1023,7 @@ value of the last form in @var{body}.
@defun edebug-trace format-string &rest format-args
This function inserts text in the trace buffer. It computes the text
-with @code{(apply 'format @var{format-string} @var{format-args})}.
+with @w{@code{(apply 'format @var{format-string} @var{format-args})}}.
It also appends a newline to separate entries.
@end defun
@@ -945,10 +1050,10 @@ correctly; Edebug will tell you when you have tried enough different
conditions that each form has returned two different values.
Coverage testing makes execution slower, so it is only done if
-@code{edebug-test-coverage} is non-@code{nil}. Frequency counting is
-performed for all executions of an instrumented function, even if the
-execution mode is Go-nonstop, and regardless of whether coverage testing
-is enabled.
+@code{edebug-test-coverage} is non-@code{nil} (@pxref{Edebug Options}).
+Frequency counting is performed for all executions of an instrumented
+function, even if the execution mode is Go-nonstop, and regardless of
+whether coverage testing is enabled.
@kindex C-x X =
@findex edebug-temp-display-freq-count
@@ -981,6 +1086,7 @@ breakpoint, and setting @code{edebug-test-coverage} to @code{t}, when
the breakpoint is reached, the frequency data looks like this:
@example
+@group
(defun fac (n)
(if (= n 0) (edebug))
;#6 1 = =5
@@ -989,7 +1095,8 @@ the breakpoint is reached, the frequency data looks like this:
(* n (fac (1- n)))
;# 5 0
1))
-;# 0
+a;# 0
+@end group
@end example
The comment lines show that @code{fac} was called 6 times. The
@@ -1030,15 +1137,19 @@ using Edebug. You can also enlarge the value of
@code{edebug-max-depth} if Edebug reaches the limit of recursion depth
instrumenting code that contains very large quoted lists.
+@vindex executing-kbd-macro @r{(Edebug)}
@item
The state of keyboard macro execution is saved and restored. While
Edebug is active, @code{executing-kbd-macro} is bound to @code{nil}
-unless @code{edebug-continue-kbd-macro} is non-@code{nil}.
+unless @code{edebug-continue-kbd-macro} is non-@code{nil} (@pxref{Edebug
+Options}).
@end itemize
@node Edebug Display Update
@subsubsection Edebug Display Update
+@cindex Edebug and display updates
+@cindex display updates, and Edebug
@c This paragraph is not filled, because LaLiberte's conversion script
@c needs an xref to be on just one line.
@@ -1059,13 +1170,13 @@ following data (though some of them are deliberately not restored if an
error or quit signal occurs).
@itemize @bullet
-@item
@cindex current buffer point and mark (Edebug)
+@item
Which buffer is current, and the positions of point and the mark in the
current buffer, are saved and restored.
-@item
@cindex window configuration (Edebug)
+@item
The outside window configuration is saved and restored if
@code{edebug-save-windows} is non-@code{nil} (@pxref{Edebug Options}).
If the value of @code{edebug-save-windows} is a list, only the listed
@@ -1079,7 +1190,7 @@ The window start and horizontal scrolling of the source code buffer are
not restored, however, so that the display remains coherent within Edebug.
@cindex buffer point changed by Edebug
-@cindex edebug overwrites buffer point position
+@cindex Edebug overwrites buffer point position
Saving and restoring the outside window configuration can sometimes
change the positions of point in the buffers on which the Lisp program
you are debugging operates, especially if your program moves point.
@@ -1091,11 +1202,14 @@ set @code{edebug-save-windows} to @code{nil}
The value of point in each displayed buffer is saved and restored if
@code{edebug-save-displayed-buffer-points} is non-@code{nil}.
+@vindex overlay-arrow-position @r{(Edebug)}
+@vindex overlay-arrow-string @r{(Edebug)}
@item
The variables @code{overlay-arrow-position} and
@code{overlay-arrow-string} are saved and restored, so you can safely
invoke Edebug from the recursive edit elsewhere in the same buffer.
+@vindex cursor-in-echo-area @r{(Edebug)}
@item
@code{cursor-in-echo-area} is locally bound to @code{nil} so that
the cursor shows up in the window.
@@ -1103,6 +1217,8 @@ the cursor shows up in the window.
@node Edebug Recursive Edit
@subsubsection Edebug Recursive Edit
+@cindex Edebug and recursive edit
+@cindex recursive edit, and Edebug
When Edebug is entered and actually reads commands from the user, it
saves (and later restores) these additional data:
@@ -1149,6 +1265,8 @@ Edebug is active, @code{defining-kbd-macro} is bound to
@node Edebug and Macros
@subsection Edebug and Macros
+@cindex Edebug and macros
+@cindex macros, debugging with Edebug
To make Edebug properly instrument expressions that call macros, some
extra care is needed. This subsection explains the details.
@@ -1172,23 +1290,26 @@ time later.)
Therefore, you must define an Edebug specification for each macro
that Edebug will encounter, to explain the format of calls to that
-macro. To do this, add a @code{debug} declaration to the macro
-definition. Here is a simple example that shows the specification for
-the @code{for} example macro (@pxref{Argument Evaluation}).
+macro. To do this, add a @code{debug} declaration (@pxref{Declare
+Form}) to the macro definition. Here is a simple example that shows the
+specification for the @code{for} example macro (@pxref{Argument
+Evaluation}).
@smallexample
+@group
(defmacro for (var from init to final do &rest body)
"Execute a simple \"for\" loop.
For example, (for i from 1 to 10 do (print i))."
(declare (debug (symbolp "from" form "to" form "do" &rest form)))
...)
+@end group
@end smallexample
The Edebug specification says which parts of a call to the macro are
forms to be evaluated. For simple macros, the specification
often looks very similar to the formal argument list of the macro
definition, but specifications are much more general than macro
-arguments. @xref{Defining Macros}, for more explanation of
+arguments. @xref{Declare Form}, for more details about
the @code{declare} form.
@c See, e.g., https://debbugs.gnu.org/10577
@@ -1252,6 +1373,7 @@ are instrumented.
@subsubsection Specification List
@cindex Edebug specification list
+@cindex specification list, Edebug
A @dfn{specification list} is required for an Edebug specification if
some arguments of a macro call are evaluated while others are not. Some
elements in a specification list match one or more arguments, but others
@@ -1358,8 +1480,8 @@ This is successful when there are no more arguments to match at the
current argument list level; otherwise it fails. See sublist
specifications and the backquote example.
+@cindex preventing backtracking, in Edebug specification list
@item gate
-@cindex preventing backtracking
No argument is matched but backtracking through the gate is disabled
while matching the remainder of the specifications at this level. This
is primarily used to generate more specific syntax error messages.
@@ -1385,8 +1507,8 @@ sexps whose first element is a symbol and then lets
with that head symbol according to @code{pcase--match-pat-args} and
pass them to the @var{pf} it received as argument.
-@item @var{other-symbol}
@cindex indirect specifications
+@item @var{other-symbol}
Any other symbol in a specification list may be a predicate or an
indirect specification.
@@ -1408,8 +1530,8 @@ specification fails and the argument is not instrumented.
Some suitable predicates include @code{symbolp}, @code{integerp},
@code{stringp}, @code{vectorp}, and @code{atom}.
-@item [@var{elements}@dots{}]
@cindex [@dots{}] (Edebug)
+@item [@var{elements}@dots{}]
A vector of elements groups the elements into a single @dfn{group
specification}. Its meaning has nothing to do with vectors.
@@ -1470,8 +1592,8 @@ The argument, a symbol, is the name of an argument of the defining form.
However, lambda-list keywords (symbols starting with @samp{&})
are not allowed.
-@item lambda-list
@cindex lambda-list (Edebug)
+@item lambda-list
This matches a lambda list---the argument list of a lambda expression.
@item def-body
@@ -1791,6 +1913,7 @@ a breakpoint. Set to @code{nil} to prevent the pause, non-@code{nil}
to allow it.
@end defopt
+@cindex Edebug, changing behavior with instrumented code
@defopt edebug-behavior-alist
By default, this alist contains one entry with the key @code{edebug}
and a list of three functions, which are the default implementations
@@ -1798,6 +1921,7 @@ of the functions inserted in instrumented code: @code{edebug-enter},
@code{edebug-before} and @code{edebug-after}. To change Edebug's
behavior globally, modify the default entry.
+@vindex edebug-behavior, symbol property
Edebug's behavior may also be changed on a per-definition basis by
adding an entry to this alist, with a key of your choice and three
functions. Then set the @code{edebug-behavior} symbol property of an
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 37a07421e94..81edcc63d5b 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1934,6 +1934,19 @@ Nested association lists is supported:
Nesting @code{let-alist} inside each other is allowed, but the code in
the inner @code{let-alist} can't access the variables bound by the
outer @code{let-alist}.
+
+Indexing into lists is also supported:
+
+@lisp
+(setq colors '((rose . red) (lily . (yellow pink))))
+(let-alist colors .lily.1)
+ @result{} pink
+@end lisp
+
+Note that forms like @samp{.0} or @samp{.3} are interpreted as numbers
+rather than as symbols, so they won't be bound to the corresponding
+values in ALIST.
+
@end defmac
@node Property Lists
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index 836d980ff0d..f6a3a0e2c26 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -690,7 +690,7 @@ and @code{define-overloadable-function} (see the commentary in
(@pxref{Top,Autotyping,,autotype,Autotyping}),
@code{transient-define-prefix}, @code{transient-define-suffix},
@code{transient-define-infix}, @code{transient-define-argument}, and
-@code{transient-define-group} (@pxref{TOP,Transient,,transient,Transient
+@code{transient-define-group} (@pxref{Top,Transient,,transient,Transient
User and Developer Manual}).
@end table
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index ba86b2d7b13..33c02aaabe3 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1289,10 +1289,11 @@ the Tabulated List buffer. Its value should be either a list or a
function.
If the value is a list, each list element corresponds to one group, and
-should have the form @w{@code{(@var{group-name} @var{entries})}}, where
+should have the form
+@w{@code{(@var{group-name} @var{entry1} @var{entry2} @dots{})}}, where
@var{group-name} is a string inserted before all group entries, and
-@var{entries} have the same format as @code{tabulated-list-entries}
-(see above).
+@var{entry1}, @var{entry2} and so on each have the same format as an
+element of @code{tabulated-list-entries} (see above).
Otherwise, the value should be a function which returns a list of the
above form when called with no arguments.
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 5588d32c5e9..2f7c6876a8f 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -1441,8 +1441,8 @@ x
The @var{array} should be mutable. @xref{Mutability}.
If @var{array} is a string and @var{object} is not a character, a
-@code{wrong-type-argument} error results. The function converts a
-unibyte string to multibyte if necessary to insert a character.
+@code{wrong-type-argument} error results. For more information about
+string mutation, @pxref{Modifying Strings}.
@end defun
@defun fillarray array object
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 93025574893..a3b335b426e 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -467,12 +467,10 @@ described in this section. @xref{Mutability}.
The most basic way to alter the contents of an existing string is with
@code{aset} (@pxref{Array Functions}). @w{@code{(aset @var{string}
@var{idx} @var{char})}} stores @var{char} into @var{string} at character
-index @var{idx}. It will automatically convert a pure-@acronym{ASCII}
-@var{string} to a multibyte string (@pxref{Text Representations}) if
-needed, but we recommend to always make sure @var{string} is multibyte
-(e.g., by using @code{string-to-multibyte}, @pxref{Converting
-Representations}), if @var{char} is a non-@acronym{ASCII} character, not
-a raw byte.
+index @var{idx}. When @var{string} is a unibyte string (@pxref{Text
+Representations}), @var{char} must be a single byte (0--255); when
+@var{string} is multibyte, both @var{char} and the previous character at
+@var{idx} must be ASCII (0--127).
To clear out a string that contained a password, use
@code{clear-string}:
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 60bf8ecc37b..943d08579ed 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4641,6 +4641,8 @@ with @var{tochar} in @var{string}. By default, substitution occurs in
a copy of @var{string}, but if the optional argument @var{inplace} is
non-@code{nil}, the function modifies the @var{string} itself. In any
case, the function returns the resulting string.
+
+For restrictions when altering an existing string, @pxref{Modifying Strings}.
@end defun
@deffn Command translate-region start end table
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index eda442ecb38..9b7cdd8b37f 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -35714,6 +35714,14 @@ The default value of @code{calc-string-maximum-character} is @code{0xFF}
or 255.
@end defvar
+@defvar calc-inhibit-startup-message
+The variable @code{calc-inhibit-startup-message} controls display of a
+welcome message when starting Calc. If it is @code{nil} (the default),
+Calc will print a brief message listing key bindings to get help or to
+quit. If it is non-@code{nil}, Calc will start without printing
+anything.
+@end defvar
+
@node Reporting Bugs
@appendix Reporting Bugs
diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi
index e50716ff654..5c24364286d 100644
--- a/doc/misc/efaq-w32.texi
+++ b/doc/misc/efaq-w32.texi
@@ -913,6 +913,7 @@ The doc string contains a list of the system sounds you can use.
* Multilingual fonts::
* Font menu::
* Line ends::
+* UTF-8 encoding::
@end menu
@node Font names
@@ -1191,6 +1192,69 @@ recent versions of Emacs, this is seldom useful for existing files,
but can still be used to influence the choice of line ends for newly
created files.
+@node UTF-8 encoding
+@section Can I use UTF-8 as default encoding on MS-Windows?
+@cindex UTF-8 as default encoding on Windows
+@cindex codepage 65001 support in Emacs
+
+Recent versions of MS-Windows (Windows 10 since build 1803, and Windows
+11 or later versions) allow to use UTF-8 (a.k.a.@: ``codepage 65001'')
+as the default system codepage. As of this writing, this is still an
+experimental feature, even in Windows 11, and is disabled by default.
+On Windows 11 you can enable it as follows:
+
+@enumerate
+@item
+Open Settings.
+
+@item
+Select ``Time & Language'', then ``Language & region''.
+
+@item
+Click on ``Administrative language settings''.
+
+@item
+On the dialog that pops up click ``Change system locale...''
+
+@item
+In the ``Region Settings'' dialog that pops up, check the check-box
+labeled ``Beta: Use Unicode UTF-8 for worldwide language support'', then
+confirm by clicking ``OK'' to both dialogs.
+@end enumerate
+
+@cindex UCRT runtime library
+@cindex MSVCRT runtime library
+Emacs supports this feature starting from version 30.2, but only when
+running on the versions of Windows that provide this feature, and only
+if the Emacs executable was linked against the @samp{UCRT} library as
+the Windows C runtime, not against the older @samp{MSVCRT}. This is
+because the C functions that deal with non-ASCII characters, as
+implemented by @samp{MSVCRT}, don't support UTF-8 as the multibyte
+encoding of non-ASCII characters. (Which runtime to link against is
+determined by the person who built your Emacs binary. Note that using
+Emacs linked against @samp{UCRT} needs all of the libraries loaded by
+Emacs dynamically, such as GnuTLS, image libraries like @samp{rsvg},
+Tree-sitter, and all the others, to be also linked against @samp{UCRT},
+otherwise subtle problems could happen when dealing with non-ASCII
+characters and strings.)
+
+If you have an Emacs linked against @samp{UCRT}, and you turned on the
+UTF-8 support in Windows as described above, you can customize Emacs to
+use UTF-8 as your default encoding, e.g., by adding
+
+@lisp
+ (prefer-coding-system 'utf-8)
+@end lisp
+
+@noindent
+to your init file, or by using the @samp{UTF-8} language environment
+(@pxref{Language Environments,,, emacs, The GNU Emacs Manual}) in your
+Emacs sessions.
+
+Please be aware that, since this feature of Windows is still in beta,
+there could be some subtle issues with it. So we do not yet recommend
+to turn this on, unless you feel adventurous.
+
@c ------------------------------------------------------------
@node Printing
@chapter Printing
diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi
index 39225535089..bf6f2fdb430 100644
--- a/doc/misc/eieio.texi
+++ b/doc/misc/eieio.texi
@@ -881,7 +881,7 @@ help with this a plethora of predicates have been created.
@anchor{find-class}
Return the class that @var{symbol} represents.
If there is no class, @code{nil} is returned if @var{errorp} is @code{nil}.
-If @var{errorp} is non-@code{nil}, @code{wrong-argument-type} is signaled.
+If @var{errorp} is non-@code{nil}, @code{wrong-type-argument} is signaled.
@end defun
@defun class-p class
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index 465d3dede13..75a459580a9 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -2042,8 +2042,8 @@ Matches zero or more copies of the glob pattern @var{x}. For example,
@item @var{x}##
Matches one or more copies of the glob pattern @var{x}. Thus,
-@samp{fo#.el} matches @file{fo.el}, @file{foo.el}, @file{fooo.el},
-etc.
+@samp{fo##.el} matches @file{fo.el}, @file{foo.el}, @file{fooo.el},
+etc, but not @file{f.el}.
@item @var{x}~@var{y}
Matches anything that matches the pattern @var{x} but not @var{y}. For
diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi
index d6c8778d785..42935703c11 100644
--- a/doc/misc/flymake.texi
+++ b/doc/misc/flymake.texi
@@ -152,7 +152,7 @@ variables})
@cindex next and previous diagnostic
If the diagnostics are outside the visible region of the buffer,
-@code{flymake-goto-next-error} and @code{flymake-goto-prev-error} are
+@code{flymake-goto-next-error} and @code{flymake-goto-prev-error}
let you navigate to the next/previous erroneous regions,
respectively. It might be a good idea to map them to @kbd{M-n} and
@kbd{M-p} in @code{flymake-mode}, by adding to your init file:
@@ -316,10 +316,8 @@ reported.
The indicator type which Flymake should use to indicate lines with
errors or warnings.
Depending on your preference, this can either use @code{fringes} or
-@code{margins} for indicating errors.
-If set to @code{fringes} (the default), it will automatically fall back
-to using margins in windows or frames without fringes, such as text
-terminals.
+@code{margins} for indicating errors. On text terminals, only
+@code{margins} is available.
@item flymake-error-bitmap
A bitmap used in the fringe to mark lines for which an error has
diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi
index 40ffbac737d..33e1cee8d3c 100644
--- a/doc/misc/reftex.texi
+++ b/doc/misc/reftex.texi
@@ -4507,7 +4507,7 @@ The keymap which is active in the labels selection process
@defopt reftex-bibfile-ignore-regexps
List of regular expressions to exclude files in
-@code{\\bibliography@{..@}}. File names matched by any of these regexps
+@code{\bibliography@{..@}}. File names matched by any of these regexps
will not be parsed. Intended for files which contain only
@code{@@string} macro definitions and the like, which are ignored by
@RefTeX{} anyway.
@@ -4605,7 +4605,7 @@ return the string to insert into the buffer.
@defopt reftex-cite-prompt-optional-args
Non-@code{nil} means, prompt for empty optional arguments in cite macros.
When an entry in @code{reftex-cite-format} is given with square brackets to
-indicate optional arguments (for example @samp{\\cite[][]@{%l@}}), RefTeX can
+indicate optional arguments (for example @samp{\cite[][]@{%l@}}), RefTeX can
prompt for values. Possible values are:
@example
nil @r{Never prompt for optional arguments}
@@ -4658,7 +4658,7 @@ The keymap which is active in the citation-key selection process
@end deffn
@defopt reftex-cite-key-separator
-String used to separate several keys in a single @samp{\\cite} macro.
+String used to separate several keys in a single @samp{\cite} macro.
Per default this is @samp{","} but if you often have to deal with a lot
of entries and need to break the macro across several lines you might
want to change it to @samp{", "}.
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 1dc616918d0..f2b1ddbcfb6 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -2376,9 +2376,11 @@ value is @t{"-l"}, but some shells, like @command{ksh}, prefer
All @file{tramp-sh.el} based methods accept the property
@t{"session-timeout"}. This is the time (in seconds) after a
connection is disabled for security reasons, and must be
-reestablished. A value of @code{nil} disables this feature. Most of
-the methods do not set this property except the @option{sudo},
-@option{doas} and @option{run0} methods, which use predefined values.
+reestablished@footnote{If there is a modified buffer, or a buffer
+under @code{auto-revert}, this is suppressed.}. A value of @code{nil}
+disables this feature. Most of the methods do not set this property
+except the @option{sudo}, @option{doas} and @option{run0} methods,
+which use predefined values.
@item @t{"~"}@*
@t{"~user"}
@@ -3659,6 +3661,8 @@ behavior: @file{@trampfn{method,user@@host,path/to/file}}.
For specifying port numbers, affix @file{#} to the host
name. For example: @file{@trampfn{ssh,daniel@@melancholia#42,.emacs}}.
+If the host is an IPv6 address, the port is appended like this:
+@file{@trampfn{ssh,@value{ipv6prefix}::1@value{ipv6postfix}#42,.emacs}}.
All method, user name, host name, port number and local name parts are
optional, @xref{Default Method}, @xref{Default User}, @xref{Default Host}.
@@ -5474,12 +5478,12 @@ Disable excessive traces. Set @code{tramp-verbose} to 3 or lower,
default being 3. Increase trace levels temporarily when hunting for
bugs.
-@item
-Use a package with @value{tramp} specific implementation of high-level
-operations. For example, the GNU ELPA package @file{tramp-hlo}
-implements specialized versions of @code{dir-locals--all-files},
-@code{locate-dominating-file} and @code{dir-locals-find-file} for
-@value{tramp}'s @code{tramp-sh} backend (@pxref{New operations}).
+@c @item
+@c Use a package with @value{tramp} specific implementation of high-level
+@c operations. For example, the GNU ELPA package @file{tramp-hlo}
+@c implements specialized versions of @code{dir-locals--all-files},
+@c @code{locate-dominating-file} and @code{dir-locals-find-file} for
+@c @value{tramp}'s @code{tramp-sh} backend (@pxref{New operations}).
@end itemize
@@ -6834,7 +6838,8 @@ they are kept. Example:
@value{tramp} messages are raised with verbosity levels ranging from 0
to 10. @value{tramp} does not display all messages; only those with a
-verbosity level less than or equal to @code{tramp-verbose}.
+verbosity level less than or equal to 3, when @code{tramp-verbose}
+permits.
@noindent
The verbosity levels are
@@ -6921,7 +6926,7 @@ maintainers, analyzing the remote commands for performance analysis.
The debug buffer can be very large, if @code{tramp-verbose} is high,
and @value{tramp} runs for a long time. If the buffer size exceeds
-@code{tramp-debug-buffer-limit} (3GB by default), a warning will be
+@code{tramp-debug-buffer-limit} (100MB by default), a warning will be
raised. This user option can be adapted to your needs; a value of 0
means that there is no limit (no warning).
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index dd960994b4f..513ed8f706d 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -36,6 +36,10 @@ The command 'erc-fill-wrap-cycle-visual-movement' was mistakenly given
the key binding "C-c a" in an inadvertent holdover from development. It
has been removed.
+** The 'fill-wrap' module no longer depends on 'scrolltobottom'.
+This change also affects the option 'erc-fill-function' when it's set to
+'erc-fill-wrap'.
+
** Updated defaults for the 'track' module's face-list options.
The default values of options 'erc-track-faces-priority-list' and
'erc-track-faces-normal-list' have both gained a face for buttonized
diff --git a/etc/NEWS b/etc/NEWS
index 83f52df69cb..ac8e56326bf 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -183,6 +183,14 @@ different completion categories by customizing
be updated as you type, or nil to suppress this always. Note that for
large or inefficient completion tables this can slow down typing.
+---
+*** RET chooses the completion selected with M-/M-
+If a completion candidate is selected with M- or M-, hitting
+RET will exit completion with that as the result. This works both in
+minibuffer completion and in-buffer completion. This supersedes
+'minibuffer-completion-auto-choose', which previously provided similar
+behavior; that variable is now nil by default.
+
+++
*** New user option 'completion-pcm-leading-wildcard'.
This option configures how the partial-completion style does completion.
@@ -426,6 +434,12 @@ docstring for arguments passed to a help-text function.
When non-nil, it truncates the tab bar, and therefore prevents
wrapping and resizing the tab bar to more than one line.
+---
+*** New user option 'tab-line-define-keys'.
+When t, the default, it redefines window buffer switching keys
+such as 'C-x ' and 'C-x ' to tab-line specific variants
+for switching tabs.
+
---
*** New command 'tab-line-move-tab-forward' ('C-x M-').
Together with the new command 'tab-line-move-tab-backward'
@@ -504,12 +518,13 @@ This user option controls the automatic deletion of projects from
'project-list-file' that cannot be accessed when prompting for a
project.
-The value can be a predicate which takes one argument and should return
-non-nil if the project should be removed. If set to nil, all the
-inaccessible projects will not be removed automatically.
+The value must be an alist where each element must be in the form:
-By default this is set to 'project-prune-zombies-default' function
-which removes all non-remote projects.
+ (WHEN . PREDICATE)
+
+where WHEN specifies where the deletion will be performed, and PREDICATE
+a function which takes one argument, and must return non-nil if the
+project should be removed.
---
*** New command 'project-save-some-buffers' bound to 'C-x p C-x s'.
@@ -524,6 +539,16 @@ shell sessions. For example, 'C-2 C-x p s' switches to or creates a
buffer named "*name-of-project-shell<2>*". By comparison, a plain
universal argument as in 'C-u C-x p s' always creates a new session.
+---
+*** 'project-switch-buffer' re-uniquifies buffer names while prompting.
+When 'uniquify-buffer-name-style' is non-nil, 'project-switch-buffer'
+changes the buffer names to only make them unique within the given
+project, during completion. That makes some items shorter.
+
+*** 'project-switch-buffer' uses 'project-buffer' as completion category.
+The category defaults are the same as for 'buffer' but any user
+customizations would need to be re-added.
+
** Registers
*** New functions 'buffer-to-register' and 'file-to-register'.
@@ -595,6 +620,14 @@ To use the ':foreground' or current text color ensure the 'fill' attribute
in the SVG is set to 'currentcolor', or set the image spec's ':css'
value to 'svg {fill: currentcolor;}'.
+---
+** Errors signaled by 'emacsclient' connections can now enter the debugger.
+If 'debug-on-error' is non-nil, errors signaled by Lisp programs
+executed due to 'emacsclient' connections will now enter the Lisp
+debugger and show the backtrace. If 'debug-on-error' is nil, these
+errors will be sent to 'emacsclient', as before, and will be displayed
+on the terminal from which 'emacsclient' was invoked.
+
* Editing Changes in Emacs 31.1
@@ -708,6 +741,15 @@ to the value 'fill-region-as-paragraph-semlf' to enable functions like
'fill-paragraph' and 'fill-region' to fill text using "semantic
linefeeds".
+---
+** Temporary files are named differently when 'file-precious-flag' is set.
+When the user option 'file-precious-flag' is set to a non-nil value,
+Emacs now names the temporary file it creates while saving buffers using
+the original file name with ".tmp" appended to it. Thus, if saving the
+buffer fails for some reason, and the temporary file is not renamed back
+to the original file's name, you can easily identify which file's saving
+failed.
+
+++
** 'C-u C-x .' clears the fill prefix.
You can now use 'C-u C-x .' to clear the fill prefix, similarly to how
@@ -733,6 +775,7 @@ the default UI you get, i.e., when 'register-use-preview' is 'traditional'.
** Tree-sitter
++++
*** New user option 'treesit-enabled-modes'.
You can customize it either to t to enable all available ts-modes,
or to select a list of ts-modes to enable. Depending on customization,
@@ -1458,9 +1501,10 @@ replies.
---
*** 'imap-authenticate' can now use PLAIN authentication.
-"AUTH=PLAIN" support is auto-enabled if the IMAP server supports it. Pass
-a specific authentication type to 'imap-authenticate' or remove 'plain'
-from 'imap-authenticators' if you do not wish to use "AUTH=PLAIN".
+"AUTH=PLAIN" support is auto-enabled if the IMAP server supports it. If
+you do not wish to use "AUTH=PLAIN", pass a specific authentication type
+to 'imap-open' for 'imap-authenticate' to use, or remove 'plain' from
+'imap-authenticators'.
** Rmail
@@ -2131,15 +2175,27 @@ relevant buffers before generating the contents of a VC Directory buffer
(like the third-party package Magit does with its status buffer).
+++
-*** New commands 'vc-root-diff-incoming' and 'vc-root-diff-outgoing'.
-These commands report diffs of all the changes that would be pulled and
-would be pushed, respectively. They are the diff analogues of the
-existing commands 'vc-log-incoming' and 'vc-log-outgoing'.
+*** New commands to report incoming and outgoing diffs.
+'vc-root-diff-incoming' and 'vc-root-diff-outgoing' report diffs of all
+the changes that would be pulled and would be pushed, respectively.
+They are the diff analogues of the existing commands 'vc-log-incoming'
+and 'vc-log-outgoing'.
In particular, 'vc-root-diff-outgoing' is useful as a way to preview
your push and ensure that all and only the changes you intended to
include were committed and will be pushed.
+'vc-diff-incoming' and 'vc-diff-outgoing' are similar but limited to the
+current VC fileset.
+
++++
+*** New commands to report diffs of outstanding changes.
+'C-x v B =' ('vc-diff-outgoing-base') and 'C-x v B D'
+('vc-root-diff-outgoing-base') report diffs of changes since the merge
+base with the remote branch, including uncommitted changes.
+They are useful to view all outstanding (unmerged, unpushed) changes on
+the current branch.
+
+++
*** New user option 'vc-use-incoming-outgoing-prefixes'.
If this is customized to non-nil, 'C-x v I' and 'C-x v O' become prefix
@@ -2499,14 +2555,21 @@ If non-nil, FFAP always finds remote files in buffers with remote
'default-directory'. If nil, FFAP finds local files first for absolute
file names in above buffers. The default is nil.
+** Debugging
+
++++
+*** New command 'edebug-bounce-to-previous-value' (bound to 'P')
+This command temporarily displays the outside current buffer with the
+outside point corresponding to the previous value, where the previous
+value is what Edebug has evaluated before its last stop point or what
+the user has evaluated in the context outside of Edebug.
+
+This replaces the binding of command 'edebug-view-outside' to 'P', which
+is still available on 'v'.
+
---
** Flymake
-*** Windows without fringes now automatically use margin indicators.
-When 'flymake-indicator-type' is set to 'fringes', as is now the default,
-flymake will automatically fall back to using margin indicators in
-windows without fringes, including any window on a text terminal.
-
*** Enhanced 'flymake-show-diagnostics-at-end-of-line'
The new value 'fancy' allowed for this user option will attempt to
layout diagnostics below the affected line using unicode graphics to
@@ -2534,6 +2597,13 @@ The tabulated listings produced by 'flymake-show-buffer-diagnostics' and
'flymake-show-project-diagnostics' now automatically adjust their column
widths based on content, optimizing display space and readability.
+*** New user option 'elisp-flymake-byte-compile-executable'.
+This allows customizing the Emacs executable used for Flymake byte
+compilation in emacs-lisp-mode. This option should be set when editing
+Lisp code which will run with a different Emacs version than the running
+Emacs, such as code from an older or newer version of Emacs. This will
+provide more accurate warnings from byte compilation.
+
** SQLite
+++
@@ -2588,6 +2658,11 @@ Latin-1 range 0-255. This hard-coded maximum is replaced by
the display of matching vectors as Unicode strings. The default value
is 0xFF or 255 to preserve the existing behavior.
++++
+*** New user option 'calc-inhibit-startup-message'.
+If it is non-nil, inhibit Calc from printing its startup message. The
+default value is nil to preserve the existing behavior.
+
** Time
*** New user option 'world-clock-sort-order'.
@@ -2669,9 +2744,32 @@ A major mode based on the tree-sitter library for editing "go.work"
files. If tree-sitter is properly set-up by the user, it can be
enabled for files named "go.work".
+** New package 'lua-mode'.
+The 'lua-mode' package from NonGNU ELPA is now included in Emacs.
+
+** New library 'timeout'.
+This library provides functions to throttle or debounce Emacs Lisp
+functions. This is useful for corralling overeager code that is slow
+and blocks Emacs, or does not provide ways to limit how often it runs.
+
* Incompatible Lisp Changes in Emacs 31.1
++++
+** String mutation has been restricted further.
+'aset' on unibyte strings now requires the new character to be a single
+byte (0-255). On multibyte strings the new character and the character
+being replaced must both be ASCII (0-127).
+
+These rules ensure that mutation will never transform a unibyte string
+to multibyte, and that the size of a string in bytes (as reported by
+'string-bytes') never changes. They also allow strings to be
+represented more efficiently in the future.
+
+Other functions that use 'aset' to modify string data, such as
+'subst-char-in-string' with a non-nil INPLACE argument, will signal an
+error if called with arguments that would violate these rules.
+
** Nested backquotes are not supported any more in Pcase patterns.
---
@@ -2794,6 +2892,12 @@ function 'load-path-filter-cache-directory-files', calling 'load' will
cache the directories it scans and their files, and the following
lookups should be faster.
++++
+** 'let-alist' supports indexing into lists.
+The macro 'let-alist' now interprets symbols containing numbers as list
+indices. For example, '.key.0' looks up 'key' in the alist and then
+returns its first element.
+
** Lexical binding
---
@@ -3017,6 +3121,11 @@ a remote host. It must be used in conjunction with the function
+++
** 'read-directory-name' now accepts an optional PREDICATE argument.
+---
+** JSON parse error line and column are now obsolete.
+The column number is no longer available; the line number will be
+removed in next Emacs release.
+
* Changes in Emacs 31.1 on Non-Free Operating Systems
diff --git a/etc/symbol-releases.eld b/etc/symbol-releases.eld
index 9732f60fc16..3c666423cc0 100644
--- a/etc/symbol-releases.eld
+++ b/etc/symbol-releases.eld
@@ -9,6 +9,8 @@
;; TYPE being `fun' or `var'.
(
+ ("30.1" fun dired-click-to-select-mode)
+ ("30.1" var dired-click-to-select-mode)
("29.1" fun plistp)
("29.1" fun help-key)
("28.1" fun always)
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 17182357739..9dacf766108 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -212,7 +212,8 @@ autoloads-force:
$(MAKE) autoloads
ldefs-boot.el: autoloads-force
- sed '/^;; Local Variables:/a ;; no-byte-compile: t'\
+ sed '/^;; Local Variables:/a\
+;; no-byte-compile: t'\
< $(lisp)/loaddefs.el > $(lisp)/ldefs-boot.el
# This is required by the bootstrap-emacs target in ../src/Makefile, so
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 8f6c71a4b74..0c5d3475aa6 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1067,8 +1067,19 @@ using `make-temp-file', and the generated name is returned."
(setq coding
(coding-system-change-text-conversion coding 'raw-text)))
(unless (memq coding '(nil no-conversion))
+ ;; If CODING specifies a certain EOL conversion, reset that, to
+ ;; force 'decode-coding-region' below determine EOL conversion
+ ;; from the file's data...
+ (if (numberp (coding-system-eol-type coding))
+ (setq coding (coding-system-change-eol-conversion coding nil)))
(decode-coding-region (point-min) (point-max) coding)
- (setq last-coding-system-used coding))
+ ;; ...then augment CODING with the actual EOL conversion
+ ;; determined from the file's data.
+ (let ((eol-type (coding-system-eol-type last-coding-system-used)))
+ (if (numberp eol-type)
+ (setq last-coding-system-used
+ (coding-system-change-eol-conversion coding eol-type))
+ (setq last-coding-system-used coding))))
(set-buffer-modified-p nil)
(kill-local-variable 'buffer-file-coding-system)
(after-insert-file-set-coding (- (point-max) (point-min))))))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index a350419b320..6f4664dd6c4 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1468,11 +1468,17 @@ commands given here will actually operate on the *Calculator* stack."
(calc-mode))
(setq max-lisp-eval-depth (max max-lisp-eval-depth 1000))
(when calc-always-load-extensions
- (require 'calc-ext))
+ (require 'calc-ext)
+ (calc-load-everything))
(when calc-language
(require 'calc-ext)
(calc-set-language calc-language calc-language-option t)))
+(defcustom calc-inhibit-startup-message nil
+ "If non-nil, inhibit the Calc startup message."
+ :version "31.1"
+ :type 'boolean)
+
(defcustom calc-make-windows-dedicated nil
"If non-nil, windows displaying Calc buffers will be marked dedicated.
See `window-dedicated-p' for what that means."
@@ -1524,9 +1530,10 @@ See `window-dedicated-p' for what that means."
(with-current-buffer (calc-trail-buffer)
(and calc-display-trail
(calc-trail-display 1 t)))
- (message (substitute-command-keys
- (concat "Welcome to the GNU Emacs Calculator! \\"
- "Press \\[calc-help] or \\[calc-help-prefix] for help, \\[calc-quit] to quit")))
+ (unless calc-inhibit-startup-message
+ (message (substitute-command-keys
+ (concat "Welcome to the GNU Emacs Calculator! \\"
+ "Press \\[calc-help] or \\[calc-help-prefix] for help, \\[calc-quit] to quit"))))
(run-hooks 'calc-start-hook)
(and (windowp full-display)
(window-point full-display)
@@ -1534,10 +1541,11 @@ See `window-dedicated-p' for what that means."
(and calc-make-windows-dedicated
(set-window-dedicated-p nil t))
(calc-check-defines)
- (when (and calc-said-hello interactive)
- (sit-for 2)
- (message ""))
- (setq calc-said-hello t)))))
+ (unless calc-inhibit-startup-message
+ (when (and calc-said-hello interactive)
+ (sit-for 2)
+ (message ""))
+ (setq calc-said-hello t))))))
;;;###autoload
(defun full-calc (&optional interactive)
@@ -3515,11 +3523,6 @@ See Info node `(calc)Defining Functions'."
(defcalcmodevar math-half-2-word-size 2147483648
"One-half of two to the power of `calc-word-size'.")
-(when calc-always-load-extensions
- (require 'calc-ext)
- (calc-load-everything))
-
-
(run-hooks 'calc-load-hook)
(provide 'calc)
diff --git a/lisp/comint.el b/lisp/comint.el
index b9c910eff43..bbb9820c16a 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1197,7 +1197,7 @@ This function makes `comint-dynamic-list-input-ring' obsolete."
(ring-elements comint-input-ring)
(user-error "No history available")))
(completion-in-region-mode-predicate
- (lambda () (get-buffer-window "*Completions*" 0))))
+ (lambda () (minibuffer--completions-visible))))
(completion-in-region
(comint-line-beginning-position) (point-max)
(completion-table-with-metadata
@@ -3521,7 +3521,7 @@ The optional argument COMMON-SUBSTRING, if non-nil, should be a string
specifying a common substring for adding the faces
`completions-first-difference' and `completions-common-part' to
the completions."
- (let ((window (get-buffer-window "*Completions*" 0)))
+ (let ((window (minibuffer--completions-visible)))
(setq completions (sort completions #'string-lessp))
(if (and (eq last-command this-command)
window (window-live-p window) (window-buffer window)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 3bc296e4ad1..e49d1552c08 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -77,10 +77,10 @@
(const box) integer)
(const :tag "Hollow cursor" hollow)
(const :tag "Vertical bar" bar)
- (cons :tag "Vertical bar with specified height"
+ (cons :tag "Vertical bar with specified width"
(const bar) integer)
(const :tag "Horizontal bar" hbar)
- (cons :tag "Horizontal bar with specified width"
+ (cons :tag "Horizontal bar with specified height"
(const hbar) integer)
(const :tag "None "nil))))
(pcase-dolist
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 049d200f590..e28106d9865 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -330,14 +330,13 @@ only in the active region if `dired-mark-region' is non-nil."
(interactive
(list
(let* ((target-dir (dired-dwim-target-directory))
- (defaults (dired-dwim-target-defaults nil target-dir)))
+ (defaults (dired-dwim-target-defaults nil target-dir)))
(minibuffer-with-setup-hook
(lambda ()
- (setq-local minibuffer-default-add-function nil)
- (setq minibuffer-default defaults))
+ (setq-local minibuffer-default-add-function nil))
(read-directory-name (format "Compare %s with: "
(dired-current-directory))
- target-dir target-dir t)))
+ target-dir defaults t)))
(read-from-minibuffer "Mark if (lisp expr or RET): " nil nil t nil "nil"))
dired-mode)
(let* ((dir1 (dired-current-directory))
@@ -2668,17 +2667,12 @@ Optional arg HOW-TO determines how to treat the target.
(dired-one-file ; fluid variable inside dired-create-files
(and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
(target-dir (dired-dwim-target-directory))
- (default (and dired-one-file
- (not dired-dwim-target) ; Bug#25609
- (expand-file-name (file-name-nondirectory
- (car fn-list))
- target-dir)))
(defaults (dired-dwim-target-defaults fn-list target-dir))
(target (expand-file-name ; fluid variable inside dired-create-files
(minibuffer-with-setup-hook
(lambda ()
- (setq-local minibuffer-default-add-function nil)
- (setq minibuffer-default defaults))
+ ;; Don't run `read-file-name--defaults'
+ (setq-local minibuffer-default-add-function nil))
(dired-mark-read-file-name
(format "%s %%s %s: "
(if dired-one-file op1 operation)
@@ -2688,7 +2682,7 @@ Optional arg HOW-TO determines how to treat the target.
;; other operations copy (etc) to the
;; prompted file name.
"from" "to"))
- target-dir op-symbol arg rfn-list default))))
+ target-dir op-symbol arg rfn-list defaults))))
(into-dir
(progn
(when
@@ -2813,28 +2807,26 @@ Optional arg HOW-TO determines how to treat the target.
this-dir)))
(defun dired-dwim-target-defaults (fn-list target-dir)
- ;; Return a list of default values for file-reading functions in Dired.
- ;; This list may contain directories from Dired buffers in other windows.
- ;; `fn-list' is a list of file names used to build a list of defaults.
- ;; When nil or more than one element, a list of defaults will
- ;; contain only directory names. `target-dir' is a directory name
- ;; to exclude from the returned list, for the case when this
- ;; directory name is already presented in initial input.
- ;; For Dired operations that support `dired-dwim-target',
- ;; the argument `target-dir' should have the value returned
- ;; from `dired-dwim-target-directory'.
+ "Return a list of default values for file-reading functions in Dired.
+
+This list may contain directories from Dired buffers in other windows.
+FN-LIST is a list of file names used to build a list of defaults.
+When nil or more than one element, a list of defaults will
+contain only directory names.
+
+TARGET-DIR should be the initial input in the minibuffer for the
+file-reading function. For Dired operations that support
+`dired-dwim-target', TARGET-DIR should have the value returned from
+`dired-dwim-target-directory'."
(let ((dired-one-file
(and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
(current-dir (and (eq major-mode 'dired-mode)
(dired-current-directory)))
;; Get a list of directories of visible buffers in dired-mode.
(dired-dirs (dired-dwim-target-directories)))
- ;; Force the current dir to be the first in the list.
+ ;; Force TARGET-DIR then CURRENT-DIR to be first in the list.
(setq dired-dirs
- (delete-dups (delq nil (cons current-dir dired-dirs))))
- ;; Remove the target dir (if specified) or the current dir from
- ;; default values, because it should be already in initial input.
- (setq dired-dirs (delete (or target-dir current-dir) dired-dirs))
+ (delete-dups (delq nil (cons target-dir (cons current-dir dired-dirs)))))
;; Return a list of default values.
(if dired-one-file
;; For one file operation, provide a list that contains
@@ -2847,10 +2839,7 @@ Optional arg HOW-TO determines how to treat the target.
(mapcar (lambda (dir)
(expand-file-name
(file-name-nondirectory (car fn-list)) dir))
- (reverse dired-dirs))
- (list (expand-file-name
- (file-name-nondirectory (car fn-list))
- (or target-dir current-dir))))
+ (reverse dired-dirs)))
;; For multi-file operation, return only a list of other directories.
dired-dirs)))
diff --git a/lisp/dired.el b/lisp/dired.el
index 103c273ccfd..996ca9c23bb 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -4057,7 +4057,10 @@ non-empty directories is allowed."
(message "(No deletions requested)")))))
(defun dired-post-do-command ()
- "Disable `dired-click-to-select-mode' after an operation."
+ "Disable `dired-click-to-select-mode' if enabled..
+This is called after Dired finishes an operation on marked files, and it
+disables `dired-click-to-select-mode' that is automatically enabled
+by the \"hold\" touch-screen gestures."
(when dired-click-to-select-mode
(dired-click-to-select-mode -1)))
@@ -5381,12 +5384,14 @@ When this minor mode is enabled, using `mouse-2' on a file name
within a Dired buffer will toggle its mark instead of going to it
within another window.
-Disabling this minor mode will unmark all files within the Dired
-buffer.
-
-`dired-click-to-select-mode' is automatically disabled after any
-Dired operation (command whose name starts with `dired-do')
-completes."
+This minor mode is intended to be used when performing file management
+using a touch-screen device. The mode is automatically enabled when a
+\"hold\" gesture over a file name is received, and is therefore
+automatically disabled after any Dired operation on the marked
+files (any command whose name starts with \"dired-do-\" and which
+performs some operation on the marked files) completes. When the mode
+is automatically disabled, it unmarks all the marked files in the Dired
+buffer."
:group 'dired
:lighter " Click-To-Select"
(unless (derived-mode-p '(dired-mode wdired-mode))
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index ed86f663100..611aa712628 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -433,7 +433,7 @@ will select it.)"
(substitute-key-definition 'describe-syntax 'electric-describe-syntax map)
map))
-;;;###(autoload 'ehelp-command "ehelp" "Prefix command for ehelp." t 'keymap)
+;;;###autoload (autoload 'ehelp-command "ehelp" "Prefix command for ehelp." t 'keymap)
(defalias 'ehelp-command ehelp-map)
(put 'ehelp-command 'documentation "Prefix command for ehelp.")
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index cbfca753b30..4fc56ae4b5d 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3591,6 +3591,7 @@ This assumes the function has the `important-return-value' property."
(cl-nset-exclusive-or 1 2)
(cl-nreconc 1)
(cl-sort 1) (cl-stable-sort 1) (cl-merge 2 3)
+ (cl-fill 1) (cl-replace 1)
)))
(dolist (entry mutating-fns)
(put (car entry) 'mutates-arguments (cdr entry))))
@@ -5880,11 +5881,11 @@ and corresponding effects."
;;; Core compiler macros.
(put 'featurep 'compiler-macro
- (lambda (form feature &rest _ignore)
+ (lambda (form feature &rest rest)
;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so
;; we can safely optimize away this test.
- (if (member feature '('xemacs 'sxemacs 'emacs))
- (eval form)
+ (if (and (member feature '('xemacs 'sxemacs 'emacs)) (not rest))
+ (featurep (cadr feature))
form)))
;; Report comma operator used outside of backquote.
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 284e3acd959..fc349787c93 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -2617,7 +2617,11 @@ when edebug becomes active."
(defvar edebug-eval-list nil) ;; List of expressions to evaluate.
-(defvar edebug-previous-result nil) ;; Last result returned.
+;; Last value seen while single-stepping or evaluating in the outside
+;; environment.
+(defvar edebug-previous-value nil)
+;; Last value seen while single-stepping, converted to a string.
+(defvar edebug-previous-result nil)
(defun edebug--display (value offset-index arg-mode)
;; edebug--display-1 is too big, we should split it. This function
@@ -3113,6 +3117,37 @@ before returning. The default is one second."
(sit-for arg)
(edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
+(defun edebug-bounce-to-previous-value (arg)
+ "Bounce point to previous value in the outside current buffer.
+The previous value is what Edebug has evaluated before its last stop
+point or what you have evaluated in the context outside of Edebug, for
+example, by calling function `edebug-eval-expression', whatever comes
+later.
+If prefix argument ARG is supplied, sit for that many seconds before
+returning. The default is one second."
+ (interactive "p")
+ (if (not edebug-active)
+ (error "Edebug is not active"))
+ (if (not (integer-or-marker-p edebug-previous-value))
+ (error "Previous value not a number or marker"))
+ (save-excursion
+ ;; If the buffer's currently displayed, avoid set-window-configuration.
+ (save-window-excursion
+ (let ((point-info ""))
+ (edebug-pop-to-buffer edebug-outside-buffer)
+ (cond
+ ((< edebug-previous-value (point-min))
+ (setq point-info (format " (< Point min: %s)" (point-min))))
+ ((> edebug-previous-value (point-max))
+ (setq point-info (format " (> Point max: %s)" (point-max))))
+ ((invisible-p edebug-previous-value)
+ (setq point-info (format " (invisible)"))))
+ (goto-char edebug-previous-value)
+ (message "Current buffer: %s Point: %s%s"
+ (current-buffer) edebug-previous-value point-info)
+ (sit-for arg)
+ (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))))))
+
;; Joe Wells, here is a start at your idea of adding a buffer to the internal
;; display list. Still need to use this list in edebug--display.
@@ -3743,7 +3778,8 @@ Return the result of the last expression."
(if edebug-unwrap-results
(setq previous-value
(edebug-unwrap* previous-value)))
- (setq edebug-previous-result
+ (setq edebug-previous-value previous-value
+ edebug-previous-result
(concat "Result: "
(edebug-safe-prin1-to-string previous-value)
(eval-expression-print-format previous-value))))
@@ -3785,6 +3821,8 @@ this is the prefix key.)"
(values--store-value value)
(concat (edebug-safe-prin1-to-string value)
(eval-expression-print-format value)))))
+ ;; Provide a defined previous value also in case of an error.
+ (setq edebug-previous-value (if errored nil value))
(cond
(errored
(message "Error: %s" errored))
@@ -3901,9 +3939,9 @@ be installed in `emacs-lisp-mode-map'.")
;; views
"w" #'edebug-where
- "v" #'edebug-view-outside ; maybe obsolete??
+ "v" #'edebug-view-outside
"p" #'edebug-bounce-point
- "P" #'edebug-view-outside ; same as v
+ "P" #'edebug-bounce-to-previous-value
"W" #'edebug-toggle-save-windows
;; misc
@@ -4517,6 +4555,7 @@ It is removed when you hit any char."
("Views"
["Where am I?" edebug-where t]
["Bounce to Current Point" edebug-bounce-point t]
+ ["Bounce to Previous Value" edebug-bounce-to-previous-value t]
["View Outside Windows" edebug-view-outside t]
["Previous Result" edebug-previous-result t]
["Show Backtrace" edebug-pop-to-backtrace t]
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index e1051eb7d4e..7f7b2adde45 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -593,7 +593,7 @@ OBJECT can be an instance or a class."
(defun find-class (symbol &optional errorp)
"Return the class that SYMBOL represents.
If there is no class, nil is returned if ERRORP is nil.
-If ERRORP is non-nil, `wrong-argument-type' is signaled."
+If ERRORP is non-nil, `wrong-type-argument' is signaled."
(let ((class (cl--find-class symbol)))
(cond
((eieio--class-p class) class)
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index cf21af8f101..1ebddf98fe4 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -813,7 +813,7 @@ This mainly sets up debugger-related bindings."
(letrec ((debugfun (lambda (err)
(ert--run-test-debugger test-execution-info
err debugfun))))
- (handler-bind (((error quit) debugfun))
+ (handler-bind ((t debugfun))
(funcall (ert-test-body (ert--test-execution-info-test
test-execution-info))))))))
(ert-pass))
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index deeeec132cf..1e88630959d 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -350,7 +350,8 @@ The default implementation delegates to `map-apply'."
(cl-defgeneric map-filter (pred map)
"Return an alist of key/val pairs for which (PRED key val) is non-nil in MAP.
-The default implementation delegates to `map-apply'."
+The default implementation delegates to `map-apply'.
+This does not modify MAP."
(delq nil (map-apply (lambda (key val)
(and (funcall pred key val)
(cons key val)))
@@ -358,7 +359,8 @@ The default implementation delegates to `map-apply'."
(cl-defgeneric map-remove (pred map)
"Return an alist of the key/val pairs for which (PRED key val) is nil in MAP.
-The default implementation delegates to `map-filter'."
+The default implementation delegates to `map-filter'.
+This does not modify MAP."
(map-filter (lambda (key val) (not (funcall pred key val)))
map))
@@ -457,7 +459,8 @@ MAP may be of a type other than TYPE."
(defun map-merge (type &rest maps)
"Merge into a map of TYPE all the key/value pairs in MAPS.
-See `map-into' for all supported values of TYPE."
+See `map-into' for all supported values of TYPE.
+This does not modify any of the MAPS."
(apply #'map--merge
(lambda (result key value)
(setf (map-elt result key) value)
@@ -469,7 +472,8 @@ See `map-into' for all supported values of TYPE."
When two maps contain the same key, call FUNCTION on the two
values and use the value FUNCTION returns.
Each of MAPS can be an alist, plist, hash-table, or array.
-See `map-into' for all supported values of TYPE."
+See `map-into' for all supported values of TYPE.
+This does not modify any of the MAPS."
(let ((not-found (list nil)))
(apply #'map--merge
(lambda (result key value)
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index 6c2350e9548..3edaca78e32 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -140,7 +140,7 @@ usually more efficient than that of a simplified version:
(open (cond ((stringp paren) paren) (paren "\\(")))
(re (if strings
(regexp-opt-group
- (delete-dups (sort (copy-sequence strings) 'string-lessp))
+ (delete-dups (sort strings))
(or open t) (not open))
;; No strings: return an unmatchable regexp.
(concat (or open "\\(?:") regexp-unmatchable "\\)"))))
@@ -250,7 +250,7 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher."
(prefixes
;; Sorting is necessary in cases such as ("ad" "d").
(sort (mapcar (lambda (s) (substring s 0 n)) strings)
- 'string-lessp)))
+ :in-place t)))
(concat open-group
(regexp-opt-group prefixes t t)
(regexp-quote (nreverse xiffus))
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index c512d42cd15..58f95c7d89a 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -581,7 +581,7 @@ a list of named character classes in the order they occur in BODY."
(cons (rx--condense-intervals
(sort (append conses
(mapcan #'rx--string-to-intervals strings))
- #'car-less-than-car))
+ :key #'car :in-place t))
(nreverse classes))))
(defun rx--generate-alt (negated intervals classes)
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index a7954e7614c..d8ffdb1fa20 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -274,7 +274,8 @@ Value is a sequence of the same type as SEQUENCE."
(cl-defgeneric seq-sort (pred sequence)
"Sort SEQUENCE using PRED as the sorting comparison function.
-The result is a sequence of the same type as SEQUENCE."
+The result is a sequence of the same type as SEQUENCE. The sort
+operates on a copy of SEQUENCE and does not modify SEQUENCE."
(let ((result (seq-sort pred (append sequence nil))))
(seq-into result (type-of sequence))))
@@ -285,7 +286,8 @@ The result is a sequence of the same type as SEQUENCE."
(defun seq-sort-by (function pred sequence)
"Sort SEQUENCE transformed by FUNCTION using PRED as the comparison function.
Elements of SEQUENCE are transformed by FUNCTION before being
-sorted. FUNCTION must be a function of one argument."
+sorted. FUNCTION must be a function of one argument. The sort
+operates on a copy of SEQUENCE and does not modify SEQUENCE."
(seq-sort (lambda (a b)
(funcall pred
(funcall function a)
@@ -293,7 +295,8 @@ sorted. FUNCTION must be a function of one argument."
sequence))
(cl-defgeneric seq-reverse (sequence)
- "Return a sequence with elements of SEQUENCE in reverse order."
+ "Return a sequence with elements of SEQUENCE in reverse order.
+This does not modify SEQUENCE."
(let ((result '()))
(seq-map (lambda (elt)
(push elt result))
@@ -307,6 +310,7 @@ sorted. FUNCTION must be a function of one argument."
(cl-defgeneric seq-concatenate (type &rest sequences)
"Concatenate SEQUENCES into a single sequence of type TYPE.
TYPE must be one of following symbols: `vector', `string' or `list'.
+This does not modify any of the SEQUENCES.
\n(fn TYPE SEQUENCE...)"
(setq sequences (mapcar #'seq-into-sequence sequences))
@@ -321,7 +325,9 @@ TYPE must be one of following symbols: `vector', `string' or `list'.
The default implementation is to signal an error if SEQUENCE is not a
sequence, specific functions should be implemented for new types
-of sequence."
+of sequence.
+
+This does not modify SEQUENCE."
(unless (sequencep sequence)
(error "Cannot convert %S into a sequence" sequence))
sequence)
@@ -329,7 +335,7 @@ of sequence."
(cl-defgeneric seq-into (sequence type)
"Concatenate the elements of SEQUENCE into a sequence of type TYPE.
TYPE can be one of the following symbols: `vector', `string' or
-`list'."
+`list'. This does not modify SEQUENCE."
(pcase type
(`vector (seq--into-vector sequence))
(`string (seq--into-string sequence))
@@ -338,7 +344,8 @@ TYPE can be one of the following symbols: `vector', `string' or
;;;###autoload
(cl-defgeneric seq-filter (pred sequence)
- "Return a list of all the elements in SEQUENCE for which PRED returns non-nil."
+ "Return a list of all the elements in SEQUENCE for which PRED returns non-nil.
+This does not modify SEQUENCE."
(let ((exclude (make-symbol "exclude")))
(delq exclude (seq-map (lambda (elt)
(if (funcall pred elt)
@@ -348,7 +355,8 @@ TYPE can be one of the following symbols: `vector', `string' or
;;;###autoload
(cl-defgeneric seq-remove (pred sequence)
- "Return a list of all the elements in SEQUENCE for which PRED returns nil."
+ "Return a list of all the elements in SEQUENCE for which PRED returns nil.
+This does not modify SEQUENCE."
(seq-filter (lambda (elt) (not (funcall pred elt)))
sequence))
@@ -359,7 +367,8 @@ TYPE can be one of the following symbols: `vector', `string' or
N is the (zero-based) index of the element that should not be in
the result.
-The result is a sequence of the same type as SEQUENCE."
+The result is a sequence of the same type as SEQUENCE.
+This does not modify SEQUENCE."
(seq-concatenate
(if (listp sequence) 'list (type-of sequence))
(seq-subseq sequence 0 n)
@@ -376,7 +385,9 @@ third element of SEQUENCE, etc. FUNCTION will be called with
INITIAL-VALUE (and then the accumulated value) as the first
argument, and the elements from SEQUENCE as the second argument.
-If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called."
+If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called.
+
+This does not modify SEQUENCE."
(if (seq-empty-p sequence)
initial-value
(let ((acc initial-value))
@@ -411,7 +422,9 @@ If no such element is found, return DEFAULT.
Note that `seq-find' has an ambiguity if the found element is
identical to DEFAULT, as in that case it is impossible to know
-whether an element was found or not."
+whether an element was found or not.
+
+This does not modify SEQUENCE."
(catch 'seq--break
(seq-doseq (elt sequence)
(when (funcall pred elt)
@@ -485,7 +498,8 @@ The result is a list of (zero-based) indices."
;;;###autoload
(cl-defgeneric seq-uniq (sequence &optional testfn)
"Return a list of the elements of SEQUENCE with duplicates removed.
-TESTFN is used to compare elements, and defaults to `equal'."
+TESTFN is used to compare elements, and defaults to `equal'.
+This does not modify SEQUENCE."
(let ((result '()))
(seq-doseq (elt sequence)
(unless (seq-contains-p result elt testfn)
@@ -521,14 +535,16 @@ TESTFN is used to compare elements, and defaults to `equal'."
(cl-defgeneric seq-mapcat (function sequence &optional type)
"Concatenate the results of applying FUNCTION to each element of SEQUENCE.
-The result is a sequence of type TYPE; TYPE defaults to `list'."
+The result is a sequence of type TYPE; TYPE defaults to `list'.
+This does not modify SEQUENCE."
(apply #'seq-concatenate (or type 'list)
(seq-map function sequence)))
(cl-defgeneric seq-partition (sequence n)
"Return list of elements of SEQUENCE grouped into sub-sequences of length N.
The last sequence may contain less than N elements. If N is a
-negative integer or 0, the function returns nil."
+negative integer or 0, the function returns nil.
+This does not modify SEQUENCE."
(unless (< n 1)
(let ((result '()))
(while (not (seq-empty-p sequence))
@@ -540,7 +556,8 @@ negative integer or 0, the function returns nil."
(cl-defgeneric seq-union (sequence1 sequence2 &optional testfn)
"Return a list of all the elements that appear in either SEQUENCE1 or SEQUENCE2.
\"Equality\" of elements is defined by the function TESTFN, which
-defaults to `equal'."
+defaults to `equal'.
+This does not modify SEQUENCE1 or SEQUENCE2."
(let* ((accum (lambda (acc elt)
(if (seq-contains-p acc elt testfn)
acc
@@ -553,7 +570,8 @@ defaults to `equal'."
(cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
"Return a list of all the elements that appear in both SEQUENCE1 and SEQUENCE2.
\"Equality\" of elements is defined by the function TESTFN, which
-defaults to `equal'."
+defaults to `equal'.
+This does not modify SEQUENCE1 or SEQUENCE2."
(seq-reduce (lambda (acc elt)
(if (seq-contains-p sequence2 elt testfn)
(cons elt acc)
@@ -564,7 +582,8 @@ defaults to `equal'."
(cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn)
"Return list of all the elements that appear in SEQUENCE1 but not in SEQUENCE2.
\"Equality\" of elements is defined by the function TESTFN, which
-defaults to `equal'."
+defaults to `equal'.
+This does not modify SEQUENCE1 or SEQUENCE2."
(seq-reduce (lambda (acc elt)
(if (seq-contains-p sequence2 elt testfn)
acc
@@ -576,7 +595,7 @@ defaults to `equal'."
(cl-defgeneric seq-group-by (function sequence)
"Apply FUNCTION to each element of SEQUENCE.
Separate the elements of SEQUENCE into an alist using the results as
-keys. Keys are compared using `equal'."
+keys. Keys are compared using `equal'. This does not modify SEQUENCE."
(seq-reduce
(lambda (acc elt)
(let* ((key (funcall function elt))
@@ -692,7 +711,7 @@ Signal an error if SEQUENCE is empty."
(defun seq-split (sequence length)
"Split SEQUENCE into a list of sub-sequences of at most LENGTH elements.
All the sub-sequences will be LENGTH long, except the last one,
-which may be shorter."
+which may be shorter. This does not modify SEQUENCE."
(when (< length 1)
(error "Sub-sequence length must be larger than zero"))
(let ((result nil)
@@ -705,7 +724,8 @@ which may be shorter."
(nreverse result)))
(defun seq-keep (function sequence)
- "Apply FUNCTION to SEQUENCE and return the list of all the non-nil results."
+ "Apply FUNCTION to SEQUENCE and return the list of all the non-nil results.
+This does not modify SEQUENCE."
(delq nil (seq-map function sequence)))
(provide 'seq)
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 40b2fb0886b..f4220501b35 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -142,13 +142,14 @@ arguments and must return a list of the above form.")
(defvar-local tabulated-list-groups nil
"Groups displayed in the current Tabulated List buffer.
This should be either a function, or a list.
-If a list, each element has the form (GROUP-NAME ENTRIES),
+If a list, each element has the form (GROUP-NAME ENTRY1 ENTRY2 ...),
where:
- GROUP-NAME is a group name as a string, which is displayed
at the top line of each group.
- - ENTRIES is a list described in `tabulated-list-entries'.
+ - ENTRY1, ENTRY2 and so on each have the same format as an element
+ of `tabulated-list-entries'.
If `tabulated-list-groups' is a function, it is called with no
arguments and must return a list of the above form.")
diff --git a/lisp/emacs-lisp/timeout.el b/lisp/emacs-lisp/timeout.el
new file mode 100644
index 00000000000..c949e7a912e
--- /dev/null
+++ b/lisp/emacs-lisp/timeout.el
@@ -0,0 +1,243 @@
+;;; timeout.el --- Throttle or debounce Elisp functions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
+
+;; Author: Karthik Chikmagalur
+;; Maintainer: Karthik Chikmagalur
+;; Keywords: convenience, extensions
+;; Version: 2.0
+;; Package-Requires: ((emacs "24.4"))
+;; URL: https://github.com/karthink/timeout
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see .
+
+;;; Commentary:
+
+;; timeout is a small Elisp library that provides higher order functions to
+;; throttle or debounce Elisp functions. This is useful for corralling
+;; over-eager code that:
+;; (i) is slow and blocks Emacs, and
+;; (ii) does not provide customization options to limit how often it runs,
+;;
+;; To throttle a function FUNC to run no more than once every 2 seconds, run
+;; (timeout-throttle 'func 2.0)
+;;
+;; To debounce a function FUNC to run after a delay of 0.3 seconds, run
+;; (timeout-debounce 'func 0.3)
+;;
+;; To create a new throttled or debounced version of FUNC instead, run
+;;
+;; (timeout-throttled-func 'func 2.0)
+;; (timeout-debounced-func 'func 0.3)
+;;
+;; You can bind this via `defalias':
+;;
+;; (defalias 'throttled-func (timeout-throttled-func 'func 2.0))
+;;
+;; The interactive spec and documentation of FUNC is carried over to the new
+;; function.
+
+;;; Code:
+
+(require 'nadvice)
+
+(defun timeout--throttle-advice (&optional timeout)
+ "Return a function that throttles its argument function.
+
+TIMEOUT defaults to 1 second.
+
+When FUNC does not run because of the throttle, the result from the
+previous successful call is returned.
+
+This is intended for use as function advice."
+ (let ((throttle-timer)
+ (timeout (or timeout 1.0))
+ (result))
+ (lambda (orig-fn &rest args)
+ "Throttle calls to this function."
+ (prog1 result
+ (unless (and throttle-timer (timerp throttle-timer))
+ (setq result (apply orig-fn args))
+ (setq throttle-timer
+ (run-with-timer
+ timeout nil
+ (lambda ()
+ (cancel-timer throttle-timer)
+ (setq throttle-timer nil)))))))))
+
+(defun timeout--debounce-advice (&optional delay default)
+ "Return a function that debounces its argument function.
+
+DELAY defaults to 0.50 seconds. The function returns immediately with
+value DEFAULT when called the first time. On future invocations, the
+result from the previous call is returned.
+
+This is intended for use as function advice."
+ (let ((debounce-timer nil)
+ (delay (or delay 0.50)))
+ (lambda (orig-fn &rest args)
+ "Debounce calls to this function."
+ (prog1 default
+ (if (timerp debounce-timer)
+ (timer-set-idle-time debounce-timer delay)
+ (setq debounce-timer
+ (run-with-idle-timer
+ delay nil
+ (lambda (buf)
+ (cancel-timer debounce-timer)
+ (setq debounce-timer nil)
+ (setq default
+ (if (buffer-live-p buf)
+ (with-current-buffer buf
+ (apply orig-fn args))
+ (apply orig-fn args))))
+ (current-buffer))))))))
+
+(defun timeout-debounce (func &optional delay default)
+ "Debounce FUNC by making it run DELAY seconds after it is called.
+
+This advises FUNC, when called (interactively or from code), to
+run after DELAY seconds. If FUNC is called again within this time,
+the timer is reset.
+
+DELAY defaults to 0.5 seconds. Using a delay of 0 removes any
+debounce advice.
+
+The function returns immediately with value DEFAULT when called the
+first time. On future invocations, the result from the previous call is
+returned."
+ (if (and delay (= delay 0))
+ (advice-remove func 'debounce)
+ (advice-add func :around (timeout--debounce-advice delay default)
+ '((name . debounce)
+ (depth . -99)))))
+
+(defun timeout-throttle (func &optional throttle)
+ "Make FUNC run no more frequently than once every THROTTLE seconds.
+
+THROTTLE defaults to 1 second. Using a throttle of 0 removes any
+throttle advice.
+
+When FUNC does not run because of the throttle, the result from the
+previous successful call is returned."
+ (if (and throttle (= throttle 0))
+ (advice-remove func 'throttle)
+ (advice-add func :around (timeout--throttle-advice throttle)
+ '((name . throttle)
+ (depth . -98)))))
+
+(defun timeout-throttled-func (func &optional throttle)
+ "Return a throttled version of function FUNC.
+
+The throttled function runs no more frequently than once every THROTTLE
+seconds. THROTTLE defaults to 1 second.
+
+When FUNC does not run because of the throttle, the result from the
+previous successful call is returned."
+ (let ((throttle-timer nil)
+ (throttle (or throttle 1))
+ (result))
+ (if (commandp func)
+ ;; INTERACTIVE version
+ (lambda (&rest args)
+ (:documentation
+ (concat
+ (documentation func)
+ (format "\n\nThrottle calls to this function by %f seconds" throttle)))
+ (interactive (advice-eval-interactive-spec
+ (cadr (interactive-form func))))
+ (prog1 result
+ (unless (and throttle-timer (timerp throttle-timer))
+ (setq result (apply func args))
+ (setq throttle-timer
+ (run-with-timer
+ throttle nil
+ (lambda ()
+ (cancel-timer throttle-timer)
+ (setq throttle-timer nil)))))))
+ ;; NON-INTERACTIVE version
+ (lambda (&rest args)
+ (:documentation
+ (concat
+ (documentation func)
+ (format "\n\nThrottle calls to this function by %f seconds" throttle)))
+ (prog1 result
+ (unless (and throttle-timer (timerp throttle-timer))
+ (setq result (apply func args))
+ (setq throttle-timer
+ (run-with-timer
+ throttle nil
+ (lambda ()
+ (cancel-timer throttle-timer)
+ (setq throttle-timer nil))))))))))
+
+(defun timeout-debounced-func (func &optional delay default)
+ "Return a debounced version of function FUNC.
+
+The debounced function runs DELAY seconds after it is called. DELAY
+defaults to 0.5 seconds.
+
+The function returns immediately with value DEFAULT when called the
+first time. On future invocations, the result from the previous call is
+returned."
+ (let ((debounce-timer nil)
+ (delay (or delay 0.50)))
+ (if (commandp func)
+ ;; INTERACTIVE version
+ (lambda (&rest args)
+ (:documentation
+ (concat
+ (documentation func)
+ (format "\n\nDebounce calls to this function by %f seconds" delay)))
+ (interactive (advice-eval-interactive-spec
+ (cadr (interactive-form func))))
+ (prog1 default
+ (if (timerp debounce-timer)
+ (timer-set-idle-time debounce-timer delay)
+ (setq debounce-timer
+ (run-with-idle-timer
+ delay nil
+ (lambda (buf)
+ (cancel-timer debounce-timer)
+ (setq debounce-timer nil)
+ (setq default
+ (if (buffer-live-p buf)
+ (with-current-buffer buf
+ (apply func args))
+ (apply func args))))
+ (current-buffer))))))
+ ;; NON-INTERACTIVE version
+ (lambda (&rest args)
+ (:documentation
+ (concat
+ (documentation func)
+ (format "\n\nDebounce calls to this function by %f seconds" delay)))
+ (prog1 default
+ (if (timerp debounce-timer)
+ (timer-set-idle-time debounce-timer delay)
+ (setq debounce-timer
+ (run-with-idle-timer
+ delay nil
+ (lambda (buf)
+ (cancel-timer debounce-timer)
+ (setq debounce-timer nil)
+ (setq default
+ (if (buffer-live-p buf)
+ (with-current-buffer buf
+ (apply func args))
+ (apply func args))))
+ (current-buffer)))))))))
+
+(provide 'timeout)
+;;; timeout.el ends here
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 145a4c174a8..291dcc2e306 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -417,11 +417,8 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
" " #'erc-fill--wrap-beginning-of-line)
(defvar erc-button-mode)
-(defvar erc-scrolltobottom-mode)
(defvar erc-legacy-invisible-bounds-p)
-(defvar erc-fill--wrap-scrolltobottom-exempt-p nil)
-
(defun erc-fill--wrap-ensure-dependencies ()
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
(when erc-legacy-invisible-bounds-p
@@ -434,10 +431,6 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
(unless erc-fill-mode
(push 'fill missing-deps)
(erc-fill-mode +1))
- (unless (or erc-scrolltobottom-mode erc-fill--wrap-scrolltobottom-exempt-p
- (memq 'scrolltobottom erc-modules))
- (push 'scrolltobottom missing-deps)
- (erc-scrolltobottom-mode +1))
(when erc-fill-wrap-merge
(require 'erc-button)
(unless erc-button-mode
@@ -515,11 +508,10 @@ This normally poses at most a minor inconvenience. Users of the
logged messages and instead prepends them to every line.
A so-called \"local\" module, `fill-wrap' depends on the global
-modules `fill', `stamp', `button', and `scrolltobottom'. It
-activates them as needed when initializing and leaves them
-enabled when shutting down. To opt out of `scrolltobottom'
-specifically, disable its minor mode, `erc-scrolltobottom-mode',
-via `erc-fill-wrap-mode-hook'."
+modules `fill', `stamp', `button'. It therefore activates them
+as needed when initializing and leaves them enabled when shutting
+down. Users may also find the `scrolltobottom' module a
+necessary addition for this fill style."
((erc-fill--wrap-ensure-dependencies)
(when erc-fill-wrap-merge-indicator
(erc-fill--wrap-massage-legacy-indicator-type))
@@ -618,14 +610,20 @@ message has been marked `erc--ephemeral'."
Ignore any `invisible' props that may be present when figuring.
Expect the target region to be free of `line-prefix' and
`wrap-prefix' properties, and expect `display-line-numbers-mode'
-to be disabled."
+to be disabled. On Emacs 28 and below, return END minus BEG."
+ ;; Rely on `buffer-text-pixel-size' here even for buffers displayed in
+ ;; another window because temporarily selecting such windows via
+ ;; `with-selected-window' seems to interfere with the implementation
+ ;; of `erc-scrolltobottom-all' in ERC 5.6, which needs improvement.
(if (fboundp 'buffer-text-pixel-size)
;; `buffer-text-pixel-size' can move point!
(save-excursion
(save-restriction
(narrow-to-region beg end)
(let* ((buffer-invisibility-spec)
- (rv (car (buffer-text-pixel-size))))
+ (rv (car (if (eq (selected-window) (get-buffer-window))
+ (window-text-pixel-size)
+ (buffer-text-pixel-size)))))
(if erc-fill-wrap-use-pixels
(if (zerop rv) 0 (list rv))
(/ rv (frame-char-width))))))
diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el
index b12cd395d24..1e69b3d4be7 100644
--- a/lisp/erc/erc-status-sidebar.el
+++ b/lisp/erc/erc-status-sidebar.el
@@ -186,13 +186,13 @@ If NO-CREATION is non-nil, the window is not created."
erc-status-sidebar--singular-p)))
(unless (or sidebar-window no-creation)
(with-current-buffer (erc-status-sidebar-get-buffer)
- (setq-local vertical-scroll-bar nil))
+ (setq vertical-scroll-bar nil
+ cursor-type nil))
(setq sidebar-window (erc-status-sidebar-display-window))
(set-window-dedicated-p sidebar-window t)
(set-window-parameter sidebar-window 'no-delete-other-windows t)
;; Don't cycle to this window with `other-window'.
(set-window-parameter sidebar-window 'no-other-window t)
- (setq cursor-type nil)
(set-window-fringes sidebar-window 0 0)
;; Set a custom display table so the window doesn't show a
;; truncation symbol when a channel name is too big.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index af7dc428e3f..6ebb137311b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -9372,8 +9372,13 @@ If BUFFER is nil, update the mode line in all ERC buffers."
(report-emacs-bug
(format "ERC %s: %s" erc-version subject))
(save-excursion
- (goto-char (point-min))
- (insert "X-Debbugs-CC: emacs-erc@gnu.org\n")))
+ (if (and (>= emacs-major-version 30)
+ (search-backward "X-Debbugs-CC: " nil t)
+ (goto-char (pos-eol))
+ (eq (char-before) ?\s))
+ (insert "emacs-erc@gnu.org")
+ (goto-char (point-min))
+ (insert "X-Debbugs-CC: emacs-erc@gnu.org\n"))))
(defconst erc--news-url
"https://git.savannah.gnu.org/cgit/emacs.git/plain/etc/ERC-NEWS")
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index 311da73a8ef..9e35f5413fb 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -500,7 +500,8 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'."
(maphash
(lambda (key _value)
(file-notify-rm-watch key))
- file-notify-descriptors))
+ file-notify-descriptors)
+ (setq file-notify-descriptors (clrhash file-notify-descriptors)))
(defun file-notify-valid-p (descriptor)
"Check a watch specified by its DESCRIPTOR.
diff --git a/lisp/files.el b/lisp/files.el
index 84e9254ca46..bd229673d8d 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -555,9 +555,13 @@ if different users access the same file, using different lock file settings;
if accessing files on a shared file system from different hosts,
using a transform that puts the lock files on a local file system."
:group 'files
- :type '(repeat (list (regexp :tag "Regexp")
+ :type `(repeat (list (regexp :tag "Regexp")
(string :tag "Replacement")
- (boolean :tag "Uniquify")))
+ (choice
+ (const :tag "Uniquify" t)
+ ,@(mapcar (lambda (algo)
+ (list 'const algo))
+ (secure-hash-algorithms)))))
:version "28.1")
(defcustom remote-file-name-inhibit-locks nil
@@ -6245,7 +6249,13 @@ Before and after saving the buffer, this function runs
;; for saving the buffer.
(setq tempname
(make-temp-file
- (expand-file-name "tmp" dir)))
+ ;; The MSDOS 8+3 restricted namespace cannot be
+ ;; relied upon to produce a different file name
+ ;; if we append ".tmp".
+ (if (and (eq system-type 'ms-dos)
+ (not (msdos-long-file-names)))
+ (expand-file-name "tmp" dir)
+ (concat buffer-file-name ".tmp"))))
;; Pass in nil&nil rather than point-min&max
;; cause we're saving the whole buffer.
;; write-region-annotate-functions may use it.
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 188f03cbb9c..0d1bd18ee23 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -207,7 +207,6 @@
;;; Code:
(require 'syntax)
-(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'subr-x))
;; Define core `font-lock' group.
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 566c3e3fba4..2eb6751a211 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -448,13 +448,14 @@ during splitting, which may be slow."
(defun nnimap-open-connection (buffer)
;; Be backwards-compatible -- the earlier value of nnimap-stream was
- ;; `ssl' when nnimap-server-port was nil. Sort of.
+ ;; `ssl' when nnimap-server-port was nil. Sort of. But it's `tls'
+ ;; now, because we're post the Great 2025 Spelling Reform.
(when (and nnimap-server-port
(eq nnimap-stream 'undecided))
- (setq nnimap-stream 'ssl))
+ (setq nnimap-stream 'tls))
(let ((stream
(if (eq nnimap-stream 'undecided)
- (cl-loop for type in '(ssl network)
+ (cl-loop for type in '(tls network)
for stream = (let ((nnimap-stream type))
(nnimap-open-connection-1 buffer))
while (eq stream 'no-connect)
@@ -493,7 +494,7 @@ during splitting, which may be slow."
(nnheader-message 7 "Opening connection to %s via shell..."
nnimap-address)
'("imap"))
- ((memq nnimap-stream '(ssl tls))
+ ((memq nnimap-stream '(tls ssl))
(nnheader-message 7 "Opening connection to %s via tls..."
nnimap-address)
'("imaps" "imap" "993" "143"))
diff --git a/lisp/help.el b/lisp/help.el
index e6c5ea54812..4ba99868c4a 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -624,6 +624,7 @@ With argument, display info only for the selected version."
(t (format "NEWS.%d" vn))))
res)
(find-file (expand-file-name file data-directory))
+ (widen) ; In case we already are visiting that NEWS file
(emacs-news-view-mode)
(goto-char (point-min))
(when (stringp version)
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index 3b89521e0fd..a7bb6ef92e9 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -334,11 +334,12 @@ undoes the expansion."
(defun he-capitalize-first (str)
(save-match-data
- (if (string-match "\\Sw*\\(\\sw\\).*" str)
- (let ((res (downcase str))
- (no (match-beginning 1)))
- (aset res no (upcase (aref str no)))
- res)
+ (if (string-match "\\Sw*\\(\\sw\\)" str)
+ (let ((b (match-beginning 1))
+ (e (match-end 1)))
+ (concat (substring str 0 b)
+ (upcase (substring str b e))
+ (downcase (substring str e))))
str)))
(defun he-ordinary-case-p (str)
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 20649082941..d015b73e955 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -2135,10 +2135,14 @@ minibuffer and the selected frame has no other windows)."
(let ((guidance (quail-guidance)))
(if (listp guidance)
;; We must replace the typed key with the specified PROMPT-KEY.
- (dotimes (i (length str))
- (let ((prompt-key (cdr (assoc (aref str i) guidance))))
- (if prompt-key
- (aset str i (aref prompt-key 0)))))))
+ (setq str (apply #'string
+ (mapcar
+ (lambda (c)
+ (let ((prompt-key (assq c guidance)))
+ (if prompt-key
+ (aref (cdr prompt-key) 0)
+ c)))
+ str)))))
;; Show followable keys.
(if (and (> (length quail-current-key) 0) (cdr map))
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 10328165450..e1f62222e9a 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -6,7 +6,8 @@
;;; Commentary:
;; This file will be copied to ldefs-boot.el and checked in
-;; periodically.
+;; periodically. Note: When checking in ldefs-boot.el, don't include
+;; changes to any other files in the commit.
;;; Code:
@@ -1563,6 +1564,8 @@ disabled.
;;; Generated autoloads from autorevert.el
+(defvar auto-revert-buffer-in-progress nil "\
+Non-nil if a `auto-revert-buffer' operation is in progress, nil otherwise.")
(autoload 'auto-revert-mode "autorevert" "\
Toggle reverting buffer when the file changes (Auto-Revert Mode).
@@ -2982,6 +2985,7 @@ 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'." t)
(make-obsolete 'c-or-c++-ts-mode 'c-or-c++-mode "30.1")
+(when (treesit-available-p) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(c-mode . c-ts-mode)) (add-to-list 'treesit-major-mode-remap-alist '(c++-mode . c++-ts-mode)) (add-to-list 'treesit-major-mode-remap-alist '(c-or-c++-mode . c-or-c++-ts-mode)))
(register-definition-prefixes "c-ts-mode" '("c-ts-"))
@@ -4699,6 +4703,11 @@ For use inside Lisp programs, see also `c-macro-expansion'.
Major mode for editing CMake files, powered by tree-sitter.
(fn)" t)
+(autoload 'cmake-ts-mode-maybe "cmake-ts-mode" "\
+Enable `cmake-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name.")
+(when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(cmake-mode . cmake-ts-mode)))
(register-definition-prefixes "cmake-ts-mode" '("cmake-ts-mode-"))
@@ -5923,6 +5932,7 @@ Key bindings:
Major mode for editing C# code.
(fn)" t)
+(when (treesit-available-p) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(csharp-mode . csharp-ts-mode)))
(register-definition-prefixes "csharp-mode" '("codedoc-font-lock-" "csharp-"))
@@ -5952,6 +5962,7 @@ can also be used to fill comments.
\\{css-mode-map}
(fn)" t)
+(when (treesit-available-p) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(css-mode . css-ts-mode)))
(autoload 'css-mode "css-mode" "\
Major mode to edit Cascading Style Sheets (CSS).
\\
@@ -8385,6 +8396,11 @@ disabled.
Major mode for editing Dockerfiles, powered by tree-sitter.
(fn)" t)
+(autoload 'dockerfile-ts-mode-maybe "dockerfile-ts-mode" "\
+Enable `dockerfile-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name.")
+(when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . dockerfile-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(dockerfile-mode . dockerfile-ts-mode)))
(register-definition-prefixes "dockerfile-ts-mode" '("dockerfile-ts-mode--"))
@@ -8534,6 +8550,7 @@ INIT-VALUE LIGHTER KEYMAP.
(fn MODE DOC [KEYWORD VAL ... &rest BODY])" nil t)
(function-put 'define-minor-mode 'doc-string-elt 2)
(function-put 'define-minor-mode 'lisp-indent-function 'defun)
+(function-put 'define-minor-mode 'autoload-macro 'expand)
(autoload 'define-globalized-minor-mode "easy-mmode" "\
Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
TURN-ON is a function that will be called with no args in every buffer
@@ -8577,6 +8594,7 @@ on if the hook has explicitly disabled it.
(fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)" nil t)
(function-put 'define-globalized-minor-mode 'doc-string-elt 2)
(function-put 'define-globalized-minor-mode 'lisp-indent-function 'defun)
+(function-put 'define-globalized-minor-mode 'autoload-macro 'expand)
(autoload 'easy-mmode-define-keymap "easy-mmode" "\
Return a keymap built from bindings BS.
BS must be a list of (KEY . BINDING) where
@@ -8925,7 +8943,7 @@ A second call of this function without changing point inserts the next match.
A call with prefix PREFIX reads the symbol to insert from the minibuffer with
completion.
-(fn PREFIX)" '("P"))
+(fn PREFIX)" t)
(autoload 'ebrowse-tags-loop-continue "ebrowse" "\
Repeat last operation on files in tree.
FIRST-TIME non-nil means this is not a repetition, but the first time.
@@ -9953,6 +9971,11 @@ mode hooks.
Major mode for editing Elixir, powered by tree-sitter.
(fn)" t)
+(autoload 'elixir-ts-mode-maybe "elixir-ts-mode" "\
+Enable `elixir-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name.")
+(when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\.elixir\\'" . elixir-ts-mode-maybe)) (add-to-list 'auto-mode-alist '("\\.ex\\'" . elixir-ts-mode-maybe)) (add-to-list 'auto-mode-alist '("\\.exs\\'" . elixir-ts-mode-maybe)) (add-to-list 'auto-mode-alist '("mix\\.lock" . elixir-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(elixir-mode . elixir-ts-mode)))
(register-definition-prefixes "elixir-ts-mode" '("elixir-ts-"))
@@ -10691,7 +10714,7 @@ ERC assigns SERVER and FULL-NAME the associated keyword values
and defers to `erc-compute-port', `erc-compute-user', and
`erc-compute-nick' for those respective parameters.
-(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" '((let ((erc--display-context `((erc-interactive-display . erc) ,@erc--display-context))) (erc-select-read-args))))
+(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" t)
(defalias 'erc-select #'erc)
(autoload 'erc-tls "erc" "\
Connect to an IRC server over a TLS-encrypted connection.
@@ -10714,7 +10737,7 @@ See the alternative entry-point command `erc' as well as Info
node `(erc) Connecting' for a fuller description of the various
parameters, like ID.
-(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" '((let ((erc-default-port erc-default-port-tls) (erc--display-context `((erc-interactive-display . erc-tls) ,@erc--display-context))) (erc-select-read-args))))
+(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" t)
(autoload 'erc-handle-irc-url "erc" "\
Use ERC to IRC on HOST:PORT in CHANNEL.
If ERC is already connected to HOST:PORT, simply /join CHANNEL.
@@ -15112,15 +15135,29 @@ Major mode for editing Go, powered by tree-sitter.
\\{go-ts-mode-map}
(fn)" t)
+(autoload 'go-ts-mode-maybe "go-ts-mode" "\
+Enable `go-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name.")
+(when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(go-mode . go-ts-mode)))
(autoload 'go-mod-ts-mode "go-ts-mode" "\
Major mode for editing go.mod files, powered by tree-sitter.
(fn)" t)
+(autoload 'go-mod-ts-mode-maybe "go-ts-mode" "\
+Enable `go-mod-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name.")
+(when (treesit-available-p) (add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(go-mod-mode . go-mod-ts-mode)))
(autoload 'go-work-ts-mode "go-ts-mode" "\
Major mode for editing go.work files, powered by tree-sitter.
(fn)" t)
-(add-to-list 'auto-mode-alist '("/go\\.work\\'" . go-work-ts-mode))
+(autoload 'go-work-ts-mode-maybe "go-ts-mode" "\
+Enable `go-work-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name.")
+(when (treesit-available-p) (add-to-list 'auto-mode-alist '("/go\\.work\\'" . go-work-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(go-work-mode . go-work-ts-mode)))
(register-definition-prefixes "go-ts-mode" '("go-"))
@@ -15793,6 +15830,11 @@ Like `hanoi-unix', but with a 64-bit clock." t)
Major mode for editing HEEx, powered by tree-sitter.
(fn)" t)
+(autoload 'heex-ts-mode-maybe "heex-ts-mode" "\
+Enable `heex-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name.")
+(when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\.[hl]?eex\\'" . heex-ts-mode-maybe)) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(heex-mode . heex-ts-mode)))
(register-definition-prefixes "heex-ts-mode" '("heex-ts-"))
@@ -18851,6 +18893,7 @@ See Info node `(elisp)Defining Functions' for more details.
(fn NAME ARGS &rest BODY)" nil t)
(function-put 'define-inline 'lisp-indent-function 'defun)
(function-put 'define-inline 'doc-string-elt 3)
+(function-put 'define-inline 'autoload-macro 'expand)
(register-definition-prefixes "inline" '("inline-"))
@@ -19295,6 +19338,7 @@ Return the string read from the minibuffer.
Major mode for editing Java, powered by tree-sitter.
(fn)" t)
+(when (treesit-available-p) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(java-mode . java-ts-mode)))
(register-definition-prefixes "java-ts-mode" '("java-ts-mode-"))
@@ -19341,6 +19385,7 @@ Major mode for editing JavaScript.
\\
(fn)" t)
+(when (treesit-available-p) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(javascript-mode . js-ts-mode)))
(autoload 'js-json-mode "js" "\
@@ -19376,6 +19421,7 @@ one of the aforementioned options instead of using this mode.
Major mode for editing JSON, powered by tree-sitter.
(fn)" t)
+(when (treesit-available-p) (defvar treesit-major-mode-remap-alist) (add-to-list 'treesit-major-mode-remap-alist '(js-json-mode . json-ts-mode)))
(register-definition-prefixes "json-ts-mode" '("json-ts-"))
@@ -19874,7 +19920,7 @@ The first element on the command line should be the (main)
loaddefs.el output file, and the rest are the directories to
use.")
(load "theme-loaddefs.el" t)
-(register-definition-prefixes "loaddefs-gen" '("autoload-" "generated-autoload-" "loaddefs-generate--" "no-update-autoloads"))
+(register-definition-prefixes "loaddefs-gen" '("autoload-" "generated-autoload-" "loaddefs-" "no-update-autoloads"))
;;; Generated autoloads from loadhist.el
@@ -20105,6 +20151,11 @@ Major mode for editing Lua files, powered by tree-sitter.
\\{lua-ts-mode-map}
(fn)" t)
+(autoload 'lua-ts-mode-maybe "lua-ts-mode" "\
+Enable `lua-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name.")
+(when (treesit-available-p) (add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-ts-mode-maybe)) (add-to-list 'interpreter-mode-alist '("\\" #'minibuffer-previous-completion
"M-" #'minibuffer-next-completion
"M-RET" #'minibuffer-choose-completion)
@@ -3215,6 +3229,17 @@ The completion method is determined by `completion-at-point-functions'."
(define-key map "\n" 'exit-minibuffer)
(define-key map "\r" 'exit-minibuffer))
+(defun minibuffer-completion-exit (&optional no-exit)
+ "Call `exit-minibuffer', inserting the selected completion first if any.
+
+If NO-EXIT is non-nil, don't `exit-minibuffer', just insert the selected
+completion."
+ (interactive "P")
+ (when (completion--selected-candidate)
+ (minibuffer-choose-completion t t))
+ (unless no-exit
+ (exit-minibuffer)))
+
(defvar-keymap minibuffer-local-completion-map
:doc "Local keymap for minibuffer input with completion."
:parent minibuffer-local-map
@@ -3224,6 +3249,7 @@ The completion method is determined by `completion-at-point-functions'."
;; another binding for it.
;; "M-TAB" #'minibuffer-force-complete
"SPC" #'minibuffer-complete-word
+ "RET" #'minibuffer-completion-exit
"?" #'minibuffer-completion-help
"" #'switch-to-completions
"M-v" #'switch-to-completions
@@ -3332,19 +3358,29 @@ and `RET' accepts the input typed into the minibuffer."
(defvar minibuffer-visible-completions--always-bind nil
"If non-nil, force the `minibuffer-visible-completions' bindings on.")
+(defun minibuffer--completions-visible ()
+ "Return the window where the current *Completions* buffer is visible, if any."
+ (when-let* ((window (get-buffer-window "*Completions*" 0)))
+ (when (eq (buffer-local-value 'completion-reference-buffer
+ (window-buffer window))
+ ;; If there's no active minibuffer, we call
+ ;; `window-buffer' on nil, assuming that completion is
+ ;; happening in the selected window.
+ (window-buffer (active-minibuffer-window)))
+ window)))
+
+(defun completion--selected-candidate ()
+ "Return the selected completion candidate if any."
+ (when-let* ((window (minibuffer--completions-visible)))
+ (with-current-buffer (window-buffer window)
+ (get-text-property (point) 'completion--string))))
+
(defun minibuffer-visible-completions--filter (cmd)
"Return CMD if `minibuffer-visible-completions' bindings should be active."
(if minibuffer-visible-completions--always-bind
cmd
- (when-let* ((window (get-buffer-window "*Completions*" 0)))
- (when (and (eq (buffer-local-value 'completion-reference-buffer
- (window-buffer window))
- (window-buffer (active-minibuffer-window)))
- (if (eq cmd #'minibuffer-choose-completion-or-exit)
- (with-current-buffer (window-buffer window)
- (get-text-property (point) 'completion--string))
- t))
- cmd))))
+ (when-let* ((window (minibuffer--completions-visible)))
+ cmd)))
(defun minibuffer-visible-completions--bind (binding)
"Use BINDING when completions are visible.
@@ -3360,7 +3396,6 @@ displaying the *Completions* buffer exists."
"" (minibuffer-visible-completions--bind #'minibuffer-next-completion)
"" (minibuffer-visible-completions--bind #'minibuffer-previous-line-completion)
"" (minibuffer-visible-completions--bind #'minibuffer-next-line-completion)
- "RET" (minibuffer-visible-completions--bind #'minibuffer-choose-completion-or-exit)
"C-g" (minibuffer-visible-completions--bind #'minibuffer-hide-completions))
;;; Completion tables.
@@ -3487,7 +3522,11 @@ same as `substitute-in-file-name'."
(unless (memq pred '(nil file-exists-p))
(let ((comp ())
(pred
- (if (eq pred 'file-directory-p)
+ (if (and (eq pred 'file-directory-p)
+ ;; File-name-handlers don't necessarily follow
+ ;; that convention (bug#79236).
+ (not (find-file-name-handler
+ realdir 'file-name-all-completions)))
;; Brute-force speed up for directory checking:
;; Discard strings which don't end in a slash.
(lambda (s)
@@ -4117,7 +4156,7 @@ style."
"Split STRING into a pattern.
A pattern is a list where each element is either a string
or a symbol, see `completion-pcm--merge-completions'."
- (if (and point (< point (length string)))
+ (if (and point (<= point (length string)))
(let ((prefix (substring string 0 point))
(suffix (substring string point)))
(append (completion-pcm--string->pattern prefix)
@@ -4178,12 +4217,6 @@ or a symbol, see `completion-pcm--merge-completions'."
(pcase p
(`(,(or 'any 'any-delim) ,(or 'any 'point) . ,_)
(setq p (cdr p)))
- ;; This is not just a performance improvement: it turns a
- ;; terminating `point' into an implicit `any', which affects
- ;; the final position of point (because `point' gets turned
- ;; into a non-greedy ".*?" regexp whereas we need it to be
- ;; greedy when it's at the end, see bug#38458).
- (`(point) (setq p nil)) ;Implicit terminating `any'.
(_ (push (pop p) n))))
(nreverse n)))
@@ -4634,10 +4667,19 @@ the same set of elements."
;; different capitalizations in different parts.
;; In practice, it doesn't seem to make any difference.
(setq ccs (nreverse ccs))
+ ;; FIXED is a prefix of all of COMPS. Try to grow that prefix.
(let* ((prefix (try-completion fixed comps))
(unique (or (and (eq prefix t) (setq prefix fixed))
(and (stringp prefix)
- (eq t (try-completion prefix comps))))))
+ ;; If PREFIX is equal to all of COMPS,
+ ;; then PREFIX is a unique completion.
+ (seq-every-p
+ ;; PREFIX is still a prefix of all of
+ ;; COMPS, so if COMP is the same length,
+ ;; they're equal.
+ (lambda (comp)
+ (= (length prefix) (length comp)))
+ comps)))))
;; If there's only one completion, `elem' is not useful
;; any more: it can only match the empty string.
;; FIXME: in some cases, it may be necessary to turn an
@@ -5113,22 +5155,22 @@ the minibuffer was activated, and execute the forms."
When used in a minibuffer window, select the window with completions,
and execute the forms."
(declare (indent 0) (debug t))
- `(let ((window (or (get-buffer-window "*Completions*" 0)
+ `(let ((window (or (minibuffer--completions-visible)
;; Make sure we have a completions window.
(progn (minibuffer-completion-help)
- (get-buffer-window "*Completions*" 0)))))
+ (minibuffer--completions-visible)))))
(when window
(with-selected-window window
(completion--lazy-insert-strings)
,@body))))
-(defcustom minibuffer-completion-auto-choose t
+(defcustom minibuffer-completion-auto-choose nil
"Non-nil means to automatically insert completions to the minibuffer.
When non-nil, then `minibuffer-next-completion' and
`minibuffer-previous-completion' will insert the completion
selected by these commands to the minibuffer."
:type 'boolean
- :version "29.1")
+ :version "31.1")
(defun minibuffer-next-completion (&optional n vertical)
"Move to the next item in its completions window from the minibuffer.
@@ -5211,7 +5253,7 @@ inputs for the prompting command, instead of the default completion table."
(user-error "No history available"))))
;; FIXME: Can we make it work for CRM?
(let ((completion-in-region-mode-predicate
- (lambda () (get-buffer-window "*Completions*" 0))))
+ (lambda () (minibuffer--completions-visible))))
(completion-in-region
(minibuffer--completion-prompt-end) (point-max)
(completion-table-with-metadata
@@ -5229,7 +5271,7 @@ provided by the prompting command, instead of the completion table."
minibuffer-default (funcall minibuffer-default-add-function)))
(let ((completions (ensure-list minibuffer-default))
(completion-in-region-mode-predicate
- (lambda () (get-buffer-window "*Completions*" 0))))
+ (lambda () (minibuffer--completions-visible))))
(completion-in-region
(minibuffer--completion-prompt-end) (point-max)
(completion-table-with-metadata
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index e0ec7d91090..6f06302cb3f 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1356,7 +1356,6 @@ This consults the entries in `eww-readable-urls' (which see)."
"" #'eww-forward-url
:menu '("Eww"
- ["Exit" quit-window t]
["Close browser" quit-window t]
["Reload" eww-reload t]
["Follow URL in new buffer" eww-open-in-new-buffer]
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 721b7be123f..4ecc804bf20 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -647,17 +647,18 @@ your laptop to different networks frequently."
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from connection history."
- (mapcar
- (lambda (key)
- (let ((tramp-verbose 0))
- (and (tramp-file-name-p key)
- (string-equal method (tramp-file-name-method key))
- (not (tramp-file-name-localname key))
- (tramp-get-method-parameter
- key 'tramp-completion-use-cache tramp-completion-use-cache)
- (list (tramp-file-name-user key)
- (tramp-file-name-host key)))))
- (hash-table-keys tramp-cache-data)))
+ (delete-dups
+ (tramp-compat-seq-keep
+ (lambda (key)
+ (let ((tramp-verbose 0))
+ (and (tramp-file-name-p key)
+ (string-equal method (tramp-file-name-method key))
+ (not (tramp-file-name-localname key))
+ (tramp-get-method-parameter
+ key 'tramp-completion-use-cache tramp-completion-use-cache)
+ (list (tramp-file-name-user key)
+ (tramp-file-name-host key)))))
+ (hash-table-keys tramp-cache-data))))
;; When "emacs -Q" has been called, both variables are nil. We do not
;; load the persistency file then, in order to have a clean test environment.
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 9787e3a6553..feda8943be5 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -29,7 +29,7 @@
;;; Code:
-(require 'tramp-loaddefs)
+(require 'tramp-loaddefs nil t) ; guard against load during autoload gen
(require 'ansi-color)
(require 'auth-source)
(require 'format-spec)
@@ -251,7 +251,7 @@ value is the default binding of the variable."
;;
;; * Use `ensure-list'.
;;
-;; * Starting with Emacs 29.1, use `buffer-match-p'.
+;; * Starting with Emacs 29.1, use `buffer-match-p' and `match-buffers'.
;;
;; * Starting with Emacs 29.1, use `string-split'.
;;
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index b5f1135a60d..7f3ac945bb6 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -2557,7 +2557,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
(shell-command-to-string (format "avahi-browse -trkp %s" service))
(rx (+ (any "\r\n"))) 'omit (rx bol "+;" (* nonl) eol)))))
(delete-dups
- (mapcar
+ (tramp-compat-seq-keep
(lambda (x)
(ignore-errors
(let* ((list (split-string x ";"))
diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el
index 7f66f7d8087..a328183e184 100644
--- a/lisp/net/tramp-message.el
+++ b/lisp/net/tramp-message.el
@@ -94,7 +94,7 @@ This increases `tramp-verbose' to 6 if necessary."
:type 'boolean
:link '(info-link :tag "Tramp manual" "(tramp) Traces and Profiles"))
-(defcustom tramp-debug-buffer-limit (* 3 1024 1024 1024) ;3GB
+(defcustom tramp-debug-buffer-limit (* 100 1024 1024) ;100MB
"The upper limit of a Tramp debug buffer.
If the size of a debug buffer exceeds this limit, a warning is raised.
Set it to 0 if there is no limit."
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 3c1f36fa8de..9d13cdc3a2d 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -5154,17 +5154,41 @@ Goes through the list `tramp-inline-compress-commands'."
;;;###tramp-autoload
(defun tramp-timeout-session (vec)
"Close the connection VEC after a session timeout.
-If there is just some editing, retry it after 5 seconds."
- (if (and (tramp-get-connection-property
- (tramp-get-connection-process vec) "locked")
- (tramp-file-name-equal-p vec (car tramp-current-connection)))
- (progn
- (tramp-message
- vec 5 "Cannot timeout session, trying it again in %s seconds." 5)
- (run-at-time 5 nil #'tramp-timeout-session vec))
+If there is just some editing, retry it after 5 seconds.
+If there is a modified buffer, retry it after 60 seconds."
+ (cond
+ ;; Tramp is locked. Try it, again.
+ ((and (tramp-get-connection-property
+ (tramp-get-connection-process vec) "locked")
+ (tramp-file-name-equal-p vec (car tramp-current-connection)))
(tramp-message
- vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc))
- (tramp-cleanup-connection vec 'keep-debug nil 'keep-processes)))
+ vec 5 "Cannot timeout session, trying it again in %s seconds." 5)
+ (run-at-time 5 nil #'tramp-timeout-session vec))
+ ;; There's a modified buffer. Try it, again.
+ ((seq-some
+ (lambda (buf)
+ (and-let* (((or (buffer-modified-p buf)
+ (with-current-buffer buf
+ ;; We don't know whether autorevert.el has
+ ;; been loaded alreaddy.
+ (tramp-compat-funcall 'auto-revert-active-p))))
+ (bfn (buffer-file-name buf))
+ (v (tramp-ensure-dissected-file-name bfn))
+ ((tramp-file-name-equal-p vec v)))))
+ (tramp-list-remote-buffers))
+ (tramp-message
+ vec 5
+ (concat
+ "Cannot timeout session (modified buffer), "
+ "trying it again in %s seconds.")
+ (tramp-get-method-parameter vec 'tramp-session-timeout))
+ (run-at-time
+ (tramp-get-method-parameter vec 'tramp-session-timeout) nil
+ #'tramp-timeout-session vec))
+ ;; Do it.
+ (t (tramp-message
+ vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc))
+ (tramp-cleanup-connection vec 'keep-debug nil 'keep-processes))))
(defun tramp-maybe-open-connection (vec)
"Maybe open a connection VEC.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 503b370cb3d..9bf1b4ae6c3 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -103,8 +103,15 @@
(put 'tramp--startup-hook 'tramp-suppress-trace t)
+ ;; TODO: Once (autoload-macro expand) is available in all supported
+ ;; Emacs versions (Emacs 31.1+), this can be eliminated:
+ ;; Backward compatibility for autoload-macro declare form.
+ (unless (assq 'autoload-macro macro-declarations-alist)
+ (push '(autoload-macro ignore) macro-declarations-alist))
+
(defmacro tramp--with-startup (&rest body)
"Schedule BODY to be executed at the end of tramp.el."
+ (declare (autoload-macro expand))
`(add-hook 'tramp--startup-hook (lambda () ,@body)))
(eval-and-compile
@@ -1040,7 +1047,7 @@ Used in `tramp-make-tramp-file-name'.")
"Regexp matching delimiter between method and user or host names.
Derived from `tramp-postfix-method-format'.")
-(defconst tramp-user-regexp (rx (+ (not (any "/:|" blank))))
+(defconst tramp-user-regexp (rx (+ (not (any "/:|[]" blank))))
"Regexp matching user names.")
(defconst tramp-prefix-domain-format "%"
@@ -1994,10 +2001,21 @@ necessary only. This function will be used in file name completion."
(concat user tramp-postfix-user-format))
(unless (tramp-string-empty-or-nil-p host)
(concat
- (if (string-match-p tramp-ipv6-regexp host)
- (concat
- tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
- host)
+ (cond
+ (;; ipv6#port -> [ipv6]#port
+ (string-match
+ (rx (group (regexp tramp-ipv6-regexp))
+ (group (regexp tramp-prefix-port-regexp)
+ (regexp tramp-port-regexp)))
+ host)
+ (concat
+ tramp-prefix-ipv6-format (match-string 1 host)
+ tramp-postfix-ipv6-format (match-string 2 host)))
+ (;; ipv6 -> [ipv6]
+ (string-match-p tramp-ipv6-regexp host)
+ (concat
+ tramp-prefix-ipv6-format host tramp-postfix-ipv6-format))
+ (t host))
tramp-postfix-host-format))
localname))
@@ -2903,31 +2921,6 @@ not in completion mode."
;; We need special handling only when a method is needed. Then we
;; regard all files "/method:" or "/[method/" as existent, if
;; "method" is a valid Tramp method.
- (or (string-equal filename "/")
- (and ;; Is it a valid method?
- (not (string-empty-p tramp-postfix-method-format))
- (string-match
- (rx
- (regexp tramp-prefix-regexp)
- (* (regexp tramp-remote-file-name-spec-regexp)
- (regexp tramp-postfix-hop-regexp))
- (group-n 9 (regexp tramp-method-regexp))
- (? (regexp tramp-postfix-method-regexp))
- eos)
- filename)
- (assoc (match-string 9 filename) tramp-methods)
- t)
-
- (tramp-run-real-handler #'file-directory-p (list filename))))
-
-(defun tramp-completion-handle-file-exists-p (filename)
- "Like `file-exists-p' for partial Tramp files."
- ;; We need special handling only when a method is needed. Then we
- ;; regard all files "/method:" or "/[method/" as existent, if
- ;; "method" is a valid Tramp method. And we regard all files
- ;; "/method:user@", "/user@" or "/[method/user@" as existent, if
- ;; "user@" is a valid file name completion. Host completion is
- ;; performed in the respective backend operation.
(or (and (cond
;; Completion styles like `flex' and `substring' check for
;; the file name "/". This does exist.
@@ -2940,28 +2933,37 @@ not in completion mode."
(* (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))
(group-n 9 (regexp tramp-method-regexp))
- (? (regexp tramp-postfix-method-regexp))
- eos)
+ (| (regexp tramp-postfix-method-regexp) eos))
filename))
(assoc (match-string 9 filename) tramp-methods))
- ;; Is it a valid user?
- ((string-match
- (rx
- (regexp tramp-prefix-regexp)
- (* (regexp tramp-remote-file-name-spec-regexp)
- (regexp tramp-postfix-hop-regexp))
- (group-n 10
- (regexp tramp-method-regexp)
- (regexp tramp-postfix-method-regexp))
- (group-n 11
- (regexp tramp-user-regexp)
- (regexp tramp-postfix-user-regexp))
- eos)
- filename)
- (member
- (match-string 11 filename)
- (file-name-all-completions
- "" (concat tramp-prefix-format (match-string 10 filename))))))
+ ;; Is it a completion file name?
+ ((string-match-p tramp-completion-file-name-regexp filename)))
+ t)
+
+ (tramp-run-real-handler #'file-directory-p (list filename))))
+
+(defun tramp-completion-handle-file-exists-p (filename)
+ "Like `file-exists-p' for partial Tramp files."
+ ;; We need special handling only when a method is needed. Then we
+ ;; regard all files "/method:" or "/[method/" as existent, if
+ ;; "method" is a valid Tramp method.
+ (or (and (cond
+ ;; Completion styles like `flex' and `substring' check for
+ ;; the file name "/". This does exist.
+ ((string-equal filename "/"))
+ ;; Is it a valid method?
+ ((and (not (string-empty-p tramp-postfix-method-format))
+ (string-match
+ (rx
+ (regexp tramp-prefix-regexp)
+ (* (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))
+ (group-n 9 (regexp tramp-method-regexp))
+ (| (regexp tramp-postfix-method-regexp) eos))
+ filename))
+ (assoc (match-string 9 filename) tramp-methods))
+ ;; Is it a completion file name?
+ ((string-match-p tramp-completion-file-name-regexp filename)))
t)
(tramp-run-real-handler #'file-exists-p (list filename))))
@@ -3076,15 +3078,14 @@ BODY is the backend specific code."
;; Method, host name and user name completion for a file.
(defun tramp-completion-handle-file-name-completion
- (filename directory &optional predicate)
- "Like `file-name-completion' for partial Tramp files."
+ (filename directory &optional _predicate)
+ "Like `file-name-completion' for partial Tramp files.
+It ignores PREDICATE, because there's no meaningful result."
;; Suppress eager completion on not connected hosts.
(let ((non-essential t))
(try-completion
filename
- (mapcar #'list (file-name-all-completions filename directory))
- (when (and predicate (tramp-connectable-p directory))
- (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))))
+ (mapcar #'list (file-name-all-completions filename directory)))))
;; I misuse a little bit the `tramp-file-name' structure in order to
;; handle completion possibilities for partial methods / user names /
@@ -3106,7 +3107,15 @@ BODY is the backend specific code."
(defun tramp-completion-dissect-file-name (name)
"Return a list of `tramp-file-name' structures for NAME.
They are collected by `tramp-completion-dissect-file-name1'."
- (let (;; "/method" "/[method"
+ ;; We don't need a special handling for "user%domain", because "%"
+ ;; is also hit by `tramp-user-regexp'. "host#port" is normalized
+ ;; for IPv6 hosts.
+ (let ((internal-name
+ (replace-regexp-in-string
+ (rx (regexp tramp-postfix-ipv6-regexp)
+ (regexp tramp-prefix-port-regexp))
+ tramp-prefix-port-format name))
+ ;; "/method" "/[method"
(tramp-completion-file-name-structure1
(list
(rx
@@ -3163,16 +3172,75 @@ They are collected by `tramp-completion-dissect-file-name1'."
(regexp tramp-postfix-user-regexp)
(regexp tramp-prefix-ipv6-regexp)
(group (? (regexp tramp-ipv6-regexp))) eol)
+ 1 2 3 nil))
+ ;; "/method:host#port" "/[method/host#port"
+ (tramp-completion-file-name-structure7
+ (list
+ (rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (regexp tramp-host-regexp)
+ (regexp tramp-prefix-port-regexp)
+ (? (regexp tramp-port-regexp)))
+ eol)
+ 1 nil 2 nil))
+ ;; "/method:[ipv6]#port" "/[method/ipv6#port"
+ (tramp-completion-file-name-structure8
+ (list
+ (rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (regexp tramp-prefix-ipv6-regexp)
+ (group (regexp tramp-ipv6-regexp)
+ (regexp tramp-prefix-port-regexp)
+ (? (regexp tramp-port-regexp)))
+ eol)
+ 1 nil 2 nil))
+ ;; "/method:user@host#port" "/[method/user@host#port"
+ (tramp-completion-file-name-structure9
+ (list
+ (rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (regexp tramp-user-regexp))
+ (regexp tramp-postfix-user-regexp)
+ (group (regexp tramp-host-regexp)
+ (regexp tramp-prefix-port-regexp)
+ (? (regexp tramp-port-regexp)))
+ eol)
+ 1 2 3 nil))
+ ;; "/method:user@[ipv6]#port" "/[method/user@ipv6#port"
+ (tramp-completion-file-name-structure10
+ (list
+ (rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (regexp tramp-user-regexp))
+ (regexp tramp-postfix-user-regexp)
+ (regexp tramp-prefix-ipv6-regexp)
+ (group (regexp tramp-ipv6-regexp)
+ (regexp tramp-prefix-port-regexp)
+ (? (regexp tramp-port-regexp)))
+ eol)
1 2 3 nil)))
(tramp-compat-seq-keep
- (lambda (structure) (tramp-completion-dissect-file-name1 structure name))
+ (lambda (structure)
+ (tramp-completion-dissect-file-name1 structure internal-name))
(list
tramp-completion-file-name-structure1
tramp-completion-file-name-structure2
tramp-completion-file-name-structure3
tramp-completion-file-name-structure4
tramp-completion-file-name-structure5
- tramp-completion-file-name-structure6))))
+ tramp-completion-file-name-structure6
+ tramp-completion-file-name-structure7
+ tramp-completion-file-name-structure8
+ tramp-completion-file-name-structure9
+ tramp-completion-file-name-structure10))))
(defun tramp-completion-dissect-file-name1 (structure name)
"Return a `tramp-file-name' structure for NAME matching STRUCTURE.
@@ -3193,7 +3261,7 @@ remote host and localname (filename on remote host)."
(defun tramp-get-completion-methods (partial-method &optional multi-hop)
"Return all method completions for PARTIAL-METHOD.
If MULTI-HOP is non-nil, return only multi-hop capable methods."
- (mapcar
+ (tramp-compat-seq-keep
(lambda (method)
(and method (string-prefix-p (or partial-method "") method)
(or (not multi-hop)
@@ -3274,7 +3342,10 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from default settings."
- `((,(tramp-find-user method nil nil) ,(tramp-find-host method nil nil))))
+ (let ((user (tramp-find-user method nil nil))
+ (host (tramp-find-host method nil nil)))
+ (when (or user host)
+ `((,user ,host)))))
;;;###tramp-autoload
(defcustom tramp-completion-multi-hop-methods nil
@@ -3296,10 +3367,11 @@ as for \"~/.authinfo.gpg\"."
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from default settings."
(and tramp-completion-use-auth-sources
- (mapcar
- (lambda (x) `(,(plist-get x :user) ,(plist-get x :host)))
- (auth-source-search
- :port method :require '(:port) :max most-positive-fixnum))))
+ (delete-dups
+ (tramp-compat-seq-keep
+ (lambda (x) `(,(plist-get x :user) ,(plist-get x :host)))
+ (auth-source-search
+ :port method :require '(:port) :max most-positive-fixnum)))))
;; Generic function.
(defun tramp-parse-group (regexp match-level skip-chars)
@@ -3324,7 +3396,8 @@ User is always nil."
(with-temp-buffer
(insert-file-contents-literally filename)
(goto-char (point-min))
- (cl-loop while (not (eobp)) collect (funcall function))))))
+ (delete-dups (delq nil
+ (cl-loop while (not (eobp)) collect (funcall function))))))))
(defun tramp-parse-rhosts (filename)
"Return a list of (user host) tuples allowed to access.
@@ -3352,7 +3425,9 @@ User is always nil."
(defun tramp-parse-shosts-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (tramp-parse-group (rx bol (group (regexp tramp-host-regexp))) 1 ","))
+ (tramp-parse-group
+ (rx bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp))))
+ 1 ","))
(defun tramp-parse-sconfig (filename)
"Return a list of (user host) tuples allowed to access.
@@ -3458,11 +3533,12 @@ Host is always \"localhost\"."
(defun tramp-parse-netrc (filename)
"Return a list of (user host) tuples allowed to access.
User may be nil."
- (mapcar
- (lambda (item)
- (and (assoc "machine" item)
- `(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item)))))
- (tramp-compat-auth-source-netrc-parse-all filename)))
+ (delete-dups
+ (tramp-compat-seq-keep
+ (lambda (item)
+ (and (assoc "machine" item)
+ `(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item)))))
+ (tramp-compat-auth-source-netrc-parse-all filename))))
(defun tramp-parse-putty (registry-or-dirname)
"Return a list of (user host) tuples allowed to access.
@@ -4263,10 +4339,18 @@ Let-bind it when necessary.")
(defun tramp-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
- ;; `file-truename' could raise an error, for example due to a cyclic
- ;; symlink.
- (ignore-errors
- (eq (file-attribute-type (file-attributes (file-truename filename))) t)))
+ (or
+ ;; `file-directory-p' is used as predicate for file name
+ ;; completion. Sometimes, when a connection is not established
+ ;; yet, it is desirable to return t immediately for "/method:foo:"
+ ;; or "/method:foo:/". It can be expected that this is always a
+ ;; directory.
+ (tramp-string-empty-or-nil-p (tramp-file-local-name filename))
+ (string-equal (tramp-file-local-name filename) "/")
+ ;; `file-truename' could raise an error, for example due to a
+ ;; cyclic symlink.
+ (ignore-errors
+ (eq (file-attribute-type (file-attributes (file-truename filename))) t))))
(defun tramp-handle-file-equal-p (filename1 filename2)
"Like `file-equal-p' for Tramp files."
diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el
index 38975682152..010c9daa00e 100644
--- a/lisp/org/org-habit.el
+++ b/lisp/org/org-habit.el
@@ -333,7 +333,8 @@ current time."
(start (time-to-days starting))
(now (time-to-days current))
(end (time-to-days ending))
- (graph (make-string (1+ (- end start)) ?\s))
+ (graph (make-vector (1+ (- end start)) ?\s))
+ (props nil)
(index 0)
last-done-date)
(while (and done-dates (< (car done-dates) start))
@@ -411,17 +412,20 @@ current time."
(not (eq face 'org-habit-overdue-face))
(not markedp))
(setq face (cdr faces)))
- (put-text-property index (1+ index) 'face face graph)
- (put-text-property index (1+ index)
- 'help-echo
- (concat (format-time-string
- (org-time-stamp-format)
- (time-add starting (days-to-time (- start (time-to-days starting)))))
- (if donep " DONE" ""))
- graph))
+ (push (list index (1+ index) 'face face) props)
+ (push (list index (1+ index)
+ 'help-echo
+ (concat (format-time-string
+ (org-time-stamp-format)
+ (time-add starting (days-to-time (- start (time-to-days starting)))))
+ (if donep " DONE" "")))
+ props))
(setq start (1+ start)
index (1+ index)))
- graph))
+ (let ((graph-str (concat graph)))
+ (dolist (p props)
+ (put-text-property (nth 0 p) (nth 1 p) (nth 2 p) (nth 3 p) graph-str))
+ graph-str)))
(defun org-habit-insert-consistency-graphs (&optional line)
"Insert consistency graph for any habitual tasks."
diff --git a/lisp/package/package-install.el b/lisp/package/package-install.el
index 06f23d162a1..8401a7769b7 100644
--- a/lisp/package/package-install.el
+++ b/lisp/package/package-install.el
@@ -607,7 +607,9 @@ directory."
(set-visited-file-name file)
(set-buffer-modified-p nil)
(when (string-match "\\.tar\\'" file) (tar-mode)))
- (package-install-from-buffer)))
+ (unwind-protect
+ (package-install-from-buffer)
+ (fundamental-mode))))
@@ -872,18 +874,22 @@ The return result is a `package-desc'."
This uses `tar-untar-buffer' from Tar mode. All files should
untar into a directory named DIR; otherwise, signal an error."
(tar-mode)
- ;; Make sure everything extracts into DIR.
- (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/"))
- (case-fold-search (file-name-case-insensitive-p dir)))
- (dolist (tar-data tar-parse-info)
- (let ((name (expand-file-name (tar-header-name tar-data))))
- (or (string-match regexp name)
- ;; Tarballs created by some utilities don't list
- ;; directories with a trailing slash (Bug#13136).
- (and (string-equal (expand-file-name dir) name)
- (eq (tar-header-link-type tar-data) 5))
- (error "Package does not untar cleanly into directory %s/" dir)))))
- (tar-untar-buffer))
+ (unwind-protect
+ (progn
+ ;; Make sure everything extracts into DIR.
+ (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/"))
+ (case-fold-search (file-name-case-insensitive-p dir)))
+ (dolist (tar-data tar-parse-info)
+ (let ((name (expand-file-name (tar-header-name tar-data))))
+ (or (string-match regexp name)
+ ;; Tarballs created by some utilities don't list
+ ;; directories with a trailing slash (Bug#13136).
+ (and (string-equal (expand-file-name dir) name)
+ (eq (tar-header-link-type tar-data) 5))
+ (error "Package does not untar cleanly into directory %s/"
+ dir)))))
+ (tar-untar-buffer))
+ (fundamental-mode)))
(declare-function dired-get-marked-files "dired")
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 43d149d5c90..c3b7f9d52d3 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -1150,7 +1150,7 @@ Typing SPC flushes the help buffer."
((or (eq event 'tab)
;; Needed on a terminal
(eq event 9))
- (let ((win (or (get-buffer-window "*Completions*" 0)
+ (let ((win (or (minibuffer--completions-visible)
(display-buffer "*Completions*"
'not-this-window))))
(with-selected-window win
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el
index b3ddabf9823..0e75bd108eb 100644
--- a/lisp/play/doctor.el
+++ b/lisp/play/doctor.el
@@ -589,6 +589,7 @@ reads the sentence before point, and prints the Doctor's answer."
(doctor-put-meaning pc 'mach)
(doctor-put-meaning gnu 'mach)
(doctor-put-meaning linux 'mach)
+(doctor-put-meaning llm 'mach)
(doctor-put-meaning bitching 'foul)
(doctor-put-meaning shit 'foul)
(doctor-put-meaning bastard 'foul)
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index 39a33f1e2a0..5f817c10371 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -433,8 +433,9 @@ run a specific program. The program must be a member of
(defsubst zone-replace-char (count del-count char-as-string new-value)
(delete-char (or del-count (- count)))
- (aset char-as-string 0 new-value)
- (dotimes (_ count) (insert char-as-string)))
+ (let ((s (apply #'propertize (string new-value)
+ (text-properties-at 0 char-as-string))))
+ (dotimes (_ count) (insert s))))
(defsubst zone-park/sit-for (pos seconds)
(let ((p (point)))
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 5c03c949049..9901d5df245 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -393,7 +393,12 @@ applicable."
(ignore-errors
(vc-call-backend backend 'repository-url
file-or-dir remote)))
- '("upstream" nil))))
+ ;; Try likely names for the remote which
+ ;; probably hosts the bug tracker. The nil
+ ;; value refers to the default remote name
+ ;; of the concrete VCS which is "origin"
+ ;; for Git or "default" for mercurial.
+ '("upstream" "origin" nil))))
(seq-some (lambda (config)
(apply #'bug-reference-maybe-setup-from-vc url config))
(append bug-reference-setup-from-vc-alist
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el
index 55240c3869a..174eb47cb3a 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -1675,6 +1675,7 @@ the code is C or C++, and based on that chooses whether to enable
;;;###autoload
(when (treesit-available-p)
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(c-mode . c-ts-mode))
(add-to-list 'treesit-major-mode-remap-alist
diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el
index 3f879e37ba2..84589b1eb73 100644
--- a/lisp/progmodes/cmake-ts-mode.el
+++ b/lisp/progmodes/cmake-ts-mode.el
@@ -257,7 +257,10 @@ Return nil if there is no name or if NODE is not a defun node."
;;;###autoload
(defun cmake-ts-mode-maybe ()
- "Enable `cmake-ts-mode' when its grammar is available."
+ "Enable `cmake-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name."
+ (declare-function treesit-language-available-p "treesit.c")
(if (or (treesit-language-available-p 'cmake)
(eq treesit-enabled-modes t)
(memq 'cmake-ts-mode treesit-enabled-modes))
@@ -269,6 +272,7 @@ Return nil if there is no name or if NODE is not a defun node."
(add-to-list 'auto-mode-alist
'("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode-maybe))
;; To be able to toggle between an external package and core ts-mode:
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(cmake-mode . cmake-ts-mode)))
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 8643b69ef83..23ff955f389 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -2726,6 +2726,7 @@ PARSE-DATA is used to save status between calls in a loop."
(if (listp indent) (setq indent (car indent)))
(cond ((and (looking-at (rx (sequence (eval cperl--label-rx)
(not (in ":")))))
+ (null (get-text-property (point) 'syntax-type))
(not (looking-at (rx (eval cperl--false-label-rx)))))
(and (> indent 0)
(setq indent (max cperl-min-label-indent
@@ -2766,7 +2767,7 @@ PARSE-DATA is used to save status between calls in a loop."
START is a good place to start parsing, or equal to
PARSE-START if preset.
STATE is what is returned by `parse-partial-sexp'.
-DEPTH is true is we are immediately after end of block
+DEPTH is true if we are immediately after end of block
which contains START.
PRESTART is the position basing on which START was found.
START-STATE should be a good guess for the start of a function."
@@ -2775,7 +2776,7 @@ START-STATE should be a good guess for the start of a function."
(if (and parse-start
(<= parse-start start-point))
(goto-char parse-start)
- (beginning-of-defun)
+ (beginning-of-defun-raw)
(when (cperl-declaration-header-p (point))
(goto-char (cperl-beginning-of-property (point) 'syntax-type))
(beginning-of-line))
@@ -5064,7 +5065,7 @@ recursive calls in starting lines of here-documents."
(cperl-postpone-fontification
(- (point) 2) (- (point) 1) 'face
(if (memq qtag
- (append "ghijkmoqvFHIJKMORTVY" nil))
+ (append "gijkmoqFIJKMOTY" nil))
'font-lock-warning-face
my-cperl-REx-0length-face))
(if (and (eq (char-after b) qtag)
@@ -6374,9 +6375,7 @@ functions (which they are not). Inherits from `default'.")
(sequence (eval cperl--signature-rx)
(eval cperl--ws*-rx))
;; ... or the start of a "sloppy" signature
- (sequence (eval cperl--sloppy-signature-rx)
- ;; arbitrarily continue "a few lines"
- (repeat 0 200 (not (in "{"))))
+ (sequence (eval cperl--sloppy-signature-rx))
;; make sure we have a reasonably
;; short match for an incomplete sub
(not (in ";{("))
@@ -6392,7 +6391,13 @@ functions (which they are not). Inherits from `default'.")
(group (eval cperl--basic-variable-rx))))
(progn
(goto-char (match-beginning 2)) ; pre-match: Back to sig
- (match-end 2))
+ ;; While typing, forward-sexp might fail with a scan error.
+ ;; If so, stop looking for declarations at (match-end 2)
+ (condition-case nil
+ (save-excursion
+ (forward-sexp)
+ (point))
+ (error (match-end 2))))
nil
(1 font-lock-variable-name-face)))
;; -------- flow control
diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el
index fb05389ba91..2ef97ccc687 100644
--- a/lisp/progmodes/csharp-mode.el
+++ b/lisp/progmodes/csharp-mode.el
@@ -1225,6 +1225,7 @@ Key bindings:
;;;###autoload
(when (treesit-available-p)
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(csharp-mode . csharp-ts-mode)))
diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el
index 79a2197c078..40259792b52 100644
--- a/lisp/progmodes/dockerfile-ts-mode.el
+++ b/lisp/progmodes/dockerfile-ts-mode.el
@@ -204,7 +204,10 @@ Return nil if there is no name or if NODE is not a stage node."
;;;###autoload
(defun dockerfile-ts-mode-maybe ()
- "Enable `dockerfile-ts-mode' when its grammar is available."
+ "Enable `dockerfile-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name."
+ (declare-function treesit-language-available-p "treesit.c")
(if (or (treesit-language-available-p 'dockerfile)
(eq treesit-enabled-modes t)
(memq 'dockerfile-ts-mode treesit-enabled-modes))
@@ -218,6 +221,7 @@ Return nil if there is no name or if NODE is not a stage node."
'("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'"
. dockerfile-ts-mode-maybe))
;; To be able to toggle between an external package and core ts-mode:
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(dockerfile-mode . dockerfile-ts-mode)))
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 4a7c525003c..475b5e13f1b 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -675,6 +675,7 @@ This can be useful when using docker to run a language server.")
(defconst eglot--uri-path-allowed-chars
(let ((vec (copy-sequence url-path-allowed-chars)))
(aset vec ?: nil) ;; see github#639
+ (aset vec ?% nil) ;; see bug#78984
vec)
"Like `url-path-allowed-chars' but more restrictive.")
@@ -2008,12 +2009,6 @@ If optional MARKER, return a marker instead"
;;; More helpers
-(defconst eglot--uri-path-allowed-chars
- (let ((vec (copy-sequence url-path-allowed-chars)))
- (aset vec ?: nil) ;; see github#639
- vec)
- "Like `url-path-allowed-chars' but more restrictive.")
-
(defun eglot--snippet-expansion-fn ()
"Compute a function to expand snippets.
Doubles as an indicator of snippet support."
@@ -2242,7 +2237,7 @@ Use `eglot-managed-p' to determine if current buffer is managed.")
(when (and eglot-autoshutdown
(null (eglot--managed-buffers server))
;; Don't shutdown if up again soon.
- (not revert-buffer-in-progress-p))
+ (with-no-warnings (not revert-buffer-in-progress-p)))
(eglot-shutdown server)))))))
(defun eglot--managed-mode-off ()
@@ -3723,7 +3718,7 @@ for which LSP on-type-formatting should be requested."
(let ((case-fold-search nil))
(and (search-forward parlabel (line-end-position) t)
(list (match-beginning 0) (match-end 0))))
- (mapcar #'1+ (append parlabel nil)))))
+ (list (aref parlabel 0) (aref parlabel 1)))))
(if (and beg end)
(add-face-text-property
beg end
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index aa2daf6820a..89b73eff552 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -2281,6 +2281,38 @@ directory of the buffer being compiled, and nothing else.")
(defvar bytecomp--inhibit-lexical-cookie-warning)
+(defcustom elisp-flymake-byte-compile-executable nil
+ "The Emacs executable to use for Flymake byte compilation.
+
+If non-nil, this should be an absolute or relative file name of an Emacs
+executable to use for byte compilation by Flymake. If it's a relative
+file name, it should be relative to the root directory of the project
+containing the file being compiled, as determined by `project-current'.
+
+If nil, or if the file named by this does not exist, Flymake will
+use the same executable as the running Emacs, as specified by the
+variables `invocation-name' and `invocation-directory'."
+ :type 'file
+ :group 'lisp
+ :version "31.1")
+
+(declare-function project-root "project" (project))
+(defun elisp-flymake-byte-compile--executable ()
+ "Return absolute file name of the Emacs executable for flymake byte-compilation."
+ (let ((filename
+ (cond
+ ((file-name-absolute-p elisp-flymake-byte-compile-executable)
+ elisp-flymake-byte-compile-executable)
+ ((stringp elisp-flymake-byte-compile-executable)
+ (when-let* ((pr (project-current)))
+ (file-name-concat (project-root pr)
+ elisp-flymake-byte-compile-executable))))))
+ (if (file-executable-p filename)
+ filename
+ (when elisp-flymake-byte-compile-executable
+ (message "No such elisp-flymake-byte-compile-executable %s" filename))
+ (expand-file-name invocation-name invocation-directory))))
+
;;;###autoload
(defun elisp-flymake-byte-compile (report-fn &rest _args)
"A Flymake backend for elisp byte compilation.
@@ -2316,7 +2348,7 @@ current buffer state and calls REPORT-FN when done."
(make-process
:name "elisp-flymake-byte-compile"
:buffer output-buffer
- :command `(,(expand-file-name invocation-name invocation-directory)
+ :command `(,(elisp-flymake-byte-compile--executable)
"-Q"
"--batch"
;; "--eval" "(setq load-prefer-newer t)" ; for testing
diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el
index 05ad76d100f..04227599630 100644
--- a/lisp/progmodes/elixir-ts-mode.el
+++ b/lisp/progmodes/elixir-ts-mode.el
@@ -808,7 +808,10 @@ Return nil if NODE is not a defun node or doesn't have a name."
;;;###autoload
(defun elixir-ts-mode-maybe ()
- "Enable `elixir-ts-mode' when its grammar is available."
+ "Enable `elixir-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name."
+ (declare-function treesit-language-available-p "treesit.c")
(if (or (treesit-language-available-p 'elixir)
(eq treesit-enabled-modes t)
(memq 'elixir-ts-mode treesit-enabled-modes))
@@ -822,6 +825,7 @@ Return nil if NODE is not a defun node or doesn't have a name."
(add-to-list 'auto-mode-alist '("\\.exs\\'" . elixir-ts-mode-maybe))
(add-to-list 'auto-mode-alist '("mix\\.lock" . elixir-ts-mode-maybe))
;; To be able to toggle between an external package and core ts-mode:
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(elixir-mode . elixir-ts-mode)))
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index bdfcf51a5ff..8b6d477c385 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -195,8 +195,6 @@ margins).
Difference between fringes and margin is that fringes support displaying
bitmaps on graphical displays and margins display text in a blank area
from current buffer that works in both graphical and text displays.
-Thus, even when `fringes' is selected, margins will still be used on
-text displays and also when fringes are disabled.
See Info node `Fringes' and Info node `(elisp)Display Margins'."
:version "31.1"
@@ -1172,6 +1170,13 @@ report applies to that region."
(flymake--state-foreign-diags state))
(clrhash (flymake--state-foreign-diags state)))
+(defun flymake--clear-state (state)
+ (cl-loop for diag in (flymake--state-diags state)
+ for ov = (flymake--diag-overlay diag)
+ when ov do (flymake--delete-overlay ov))
+ (setf (flymake--state-diags state) nil)
+ (flymake--clear-foreign-diags state))
+
(defvar-local flymake-mode nil)
(defvar-local flymake--mode-line-counter-cache nil
@@ -1189,7 +1194,7 @@ and other buffers."
;;
(cond
(;; If there is a `region' arg, only affect the diagnostics whose
- ;; overlays are in a certain region. Discard "foreign"
+ ;; overlays are in a certain region. Ignore "foreign"
;; diagnostics.
region
(cl-loop for diag in (flymake--state-diags state)
@@ -1202,16 +1207,9 @@ and other buffers."
else collect diag into surviving
finally (setf (flymake--state-diags state)
surviving)))
- (;; Else, if this is the first report, zero all lists and delete
- ;; all associated overlays.
+ (;; Else, if this is the first report, fully clear this state.
(not (flymake--state-reported-p state))
- (cl-loop for diag in (flymake--state-diags state)
- for ov = (flymake--diag-overlay diag)
- when ov do (flymake--delete-overlay ov))
- (setf (flymake--state-diags state) nil)
- ;; Also clear all overlays for `foreign-diags' in all other
- ;; buffers.
- (flymake--clear-foreign-diags state))
+ (flymake--clear-state state))
(;; If this is not the first report, do no cleanup.
t))
@@ -1415,16 +1413,7 @@ Interactively, with a prefix arg, FORCE is t."
;; See bug#78862
(maphash (lambda (backend state)
(unless (memq backend flymake-diagnostic-functions)
- ;; Delete all overlays
- (dolist (diag (flymake--state-diags state))
- (let ((ov (flymake--diag-overlay diag)))
- (flymake--delete-overlay ov)))
- ;; Set the list of diagnostics to nil to
- ;; avoid trying to delete them again.
- ;; We keep the state object itself around in
- ;; case there's still diagnostics in flight,
- ;; so we don't break things.
- (setf (flymake--state-diags state) nil)))
+ (flymake--clear-state state)))
flymake--state)
(run-hook-wrapped
'flymake-diagnostic-functions
@@ -1505,13 +1494,6 @@ special *Flymake log* buffer." :group 'flymake :lighter
(add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
(add-hook 'eldoc-documentation-functions 'flymake-eldoc-function t t)
- (when (and (eq flymake-indicator-type 'fringes)
- (not (cl-case flymake-fringe-indicator-position
- (left-fringe (< 0 (nth 0 (window-fringes))))
- (right-fringe (< 0 (nth 1 (window-fringes)))))))
- ;; There are no fringes in the buffer, fallback to margins.
- (setq-local flymake-indicator-type 'margins))
-
;; AutoResize margins.
(flymake--resize-margins)
diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el
index 40f3de0bc15..e149e9230ec 100644
--- a/lisp/progmodes/go-ts-mode.el
+++ b/lisp/progmodes/go-ts-mode.el
@@ -361,7 +361,10 @@
;;;###autoload
(defun go-ts-mode-maybe ()
- "Enable `go-ts-mode' when its grammar is available."
+ "Enable `go-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name."
+ (declare-function treesit-language-available-p "treesit.c")
(if (or (treesit-language-available-p 'go)
(eq treesit-enabled-modes t)
(memq 'go-ts-mode treesit-enabled-modes))
@@ -372,6 +375,7 @@
(when (treesit-available-p)
(add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode-maybe))
;; To be able to toggle between an external package and core ts-mode:
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(go-mode . go-ts-mode)))
@@ -635,7 +639,10 @@ what the parent of the node would be if it were a node."
;;;###autoload
(defun go-mod-ts-mode-maybe ()
- "Enable `go-mod-ts-mode' when its grammar is available."
+ "Enable `go-mod-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name."
+ (declare-function treesit-language-available-p "treesit.c")
(if (or (treesit-language-available-p 'gomod)
(eq treesit-enabled-modes t)
(memq 'go-mod-ts-mode treesit-enabled-modes))
@@ -646,6 +653,7 @@ what the parent of the node would be if it were a node."
(when (treesit-available-p)
(add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode-maybe))
;; To be able to toggle between an external package and core ts-mode:
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(go-mod-mode . go-mod-ts-mode)))
@@ -736,7 +744,10 @@ what the parent of the node would be if it were a node."
;;;###autoload
(defun go-work-ts-mode-maybe ()
- "Enable `go-work-ts-mode' when its grammar is available."
+ "Enable `go-work-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name."
+ (declare-function treesit-language-available-p "treesit.c")
(if (or (treesit-language-available-p 'gowork)
(eq treesit-enabled-modes t)
(memq 'go-work-ts-mode treesit-enabled-modes))
@@ -747,6 +758,7 @@ what the parent of the node would be if it were a node."
(when (treesit-available-p)
(add-to-list 'auto-mode-alist '("/go\\.work\\'" . go-work-ts-mode-maybe))
;; To be able to toggle between an external package and core ts-mode:
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(go-work-mode . go-work-ts-mode)))
diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el
index 41634d0e6a4..2b8b75c444e 100644
--- a/lisp/progmodes/heex-ts-mode.el
+++ b/lisp/progmodes/heex-ts-mode.el
@@ -267,7 +267,10 @@ Return nil if NODE is not a defun node or doesn't have a name."
;;;###autoload
(defun heex-ts-mode-maybe ()
- "Enable `heex-ts-mode' when its grammar is available."
+ "Enable `heex-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name."
+ (declare-function treesit-language-available-p "treesit.c")
(if (or (treesit-language-available-p 'heex)
(eq treesit-enabled-modes t)
(memq 'heex-ts-mode treesit-enabled-modes))
@@ -280,6 +283,7 @@ Return nil if NODE is not a defun node or doesn't have a name."
;; with the tree-sitter-heex grammar.
(add-to-list 'auto-mode-alist '("\\.[hl]?eex\\'" . heex-ts-mode-maybe))
;; To be able to toggle between an external package and core ts-mode:
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(heex-mode . heex-ts-mode)))
diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el
index e989d1b3f5d..979f5456c6d 100644
--- a/lisp/progmodes/java-ts-mode.el
+++ b/lisp/progmodes/java-ts-mode.el
@@ -526,6 +526,7 @@ Return nil if there is no name or if NODE is not a defun node."
;;;###autoload
(when (treesit-available-p)
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(java-mode . java-ts-mode)))
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index c44b2adf146..1e4c832254c 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -4111,6 +4111,7 @@ See `treesit-thing-settings' for more information.")
;;;###autoload
(when (treesit-available-p)
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(javascript-mode . js-ts-mode)))
diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el
index b0db0a12210..a08e9a29fe8 100644
--- a/lisp/progmodes/json-ts-mode.el
+++ b/lisp/progmodes/json-ts-mode.el
@@ -183,6 +183,7 @@ Return nil if there is no name or if NODE is not a defun node."
;;;###autoload
(when (treesit-available-p)
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(js-json-mode . json-ts-mode)))
diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el
new file mode 100644
index 00000000000..d65154a38cd
--- /dev/null
+++ b/lisp/progmodes/lua-mode.el
@@ -0,0 +1,2131 @@
+;;; lua-mode.el --- Major-mode for editing Lua files -*- lexical-binding: t -*-
+
+;; Copyright (C) 2025 Free Software Foundation, Inc.
+
+;; Author: 2011-2013 immerrr
+;; 2010-2011 Reuben Thomas
+;; 2006 Juergen Hoetzel
+;; 2004 various (support for Lua 5 and byte compilation)
+;; 2001 Christian Vogler
+;; 1997 Bret Mogilefsky starting from
+;; tcl-mode by Gregor Schmid
+;; with tons of assistance from
+;; Paul Du Bois and
+;; Aaron Smith .
+;;
+;; Keywords: languages, processes, tools
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see .
+
+;;; Commentary:
+
+;; lua-mode provides support for editing Lua, including automatic
+;; indentation, syntactical font-locking, running interactive shell,
+;; Flymake checks with luacheck, interacting with `hs-minor-mode' and
+;; online documentation lookup.
+;;
+;; The following variables are available for customization (see more via
+;; `M-x customize-group lua`):
+;;
+;; - Var `lua-indent-level':
+;; indentation offset in spaces
+;; - Var `lua-indent-string-contents':
+;; set to `t` if you like to have contents of multiline strings to be
+;; indented like comments
+;; - Var `lua-indent-nested-block-content-align':
+;; set to `nil' to stop aligning the content of nested blocks with the
+;; open parenthesis
+;; - Var `lua-indent-close-paren-align':
+;; set to `t' to align close parenthesis with the open parenthesis,
+;; rather than with the beginning of the line
+;; - Var `lua-mode-hook':
+;; list of functions to execute when lua-mode is initialized
+;; - Var `lua-documentation-url':
+;; base URL for documentation lookup
+;; - Var `lua-documentation-function': function used to
+;; show documentation (`eww` is a viable alternative for Emacs 25)
+;;
+;; These are variables/commands that operate on the Lua process:
+;;
+;; - Var `lua-default-application':
+;; command to start the Lua process (REPL)
+;; - Var `lua-default-command-switches':
+;; arguments to pass to the Lua process on startup (make sure `-i` is
+;; there if you expect working with Lua shell interactively)
+;; - Cmd `lua-start-process': start new REPL process, usually happens
+;; automatically
+;; - Cmd `lua-kill-process': kill current REPL process
+;;
+;; These are variables/commands for interaction with the Lua process:
+;;
+;; - Cmd `lua-show-process-buffer': switch to REPL buffer
+;; - Cmd `lua-hide-process-buffer': hide window showing REPL buffer
+;; - Var `lua-always-show': show REPL buffer after sending something
+;; - Cmd `lua-send-buffer': send whole buffer
+;; - Cmd `lua-send-current-line': send current line
+;; - Cmd `lua-send-defun': send current top-level function
+;; - Cmd `lua-send-region': send active region
+;; - Cmd `lua-restart-with-whole-file': restart REPL and send whole buffer
+;;
+;; To enable on-the-fly linting, make sure you have the luacheck program
+;; installed (available from luarocks) and activate `flymake-mode'.
+;;
+;; See "M-x apropos-command ^lua-" for a list of commands.
+;; See "M-x customize-group lua" for a list of customizable variables.
+
+;;; Code:
+
+(require 'comint)
+(require 'newcomment)
+(require 'rx)
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'compile))
+
+;; rx-wrappers for Lua
+
+(eval-and-compile
+ (defvar lua--rx-bindings
+ '((symbol (&rest x) (seq symbol-start (or x) symbol-end))
+ (ws (* (any " \t")))
+ (ws+ (+ (any " \t")))
+
+ (lua-name (symbol (seq (+ (any alpha "_")) (* (any alnum "_")))))
+ (lua-funcname (seq lua-name (* ws "." ws lua-name)
+ (opt ws ":" ws lua-name)))
+ (lua-funcheader
+ ;; Outer (seq ...) is here to shy-group the definition
+ (seq (or (seq (symbol "function") ws (group-n 1 lua-funcname))
+ (seq (group-n 1 lua-funcname) ws "=" ws
+ (symbol "function")))))
+ (lua-number
+ (seq (or (seq (+ digit) (opt ".") (* digit))
+ (seq (* digit) (opt ".") (+ digit)))
+ (opt (regexp "[eE][+-]?[0-9]+"))))
+ (lua-assignment-op (seq "=" (or buffer-end (not (any "=")))))
+ (lua-operator (or "+" "-" "*" "/" "%" "^" "#" "==" "~=" "<=" ">=" "<"
+ ">" "=" ";" ":" "," "." ".." "..."))
+ (lua-keyword-operator (symbol "and" "not" "or"))
+ (lua-keyword
+ (symbol "break" "do" "else" "elseif" "end" "for" "function"
+ "goto" "if" "in" "local" "repeat" "return"
+ "then" "until" "while"))
+ (lua-up-to-9-variables
+ (seq (group-n 1 lua-name) ws
+ (? "," ws (group-n 2 lua-name) ws
+ (? "," ws (group-n 3 lua-name) ws
+ (? "," ws (group-n 4 lua-name) ws
+ (? "," ws (group-n 5 lua-name) ws
+ (? "," ws (group-n 6 lua-name) ws
+ (? "," ws (group-n 7 lua-name) ws
+ (? "," ws (group-n 8 lua-name) ws
+ (? "," ws (group-n 9 lua-name) ws))))))))))))
+
+ (defmacro lua-rx (&rest regexps)
+ (eval `(rx-let ,lua--rx-bindings
+ (rx ,@regexps))))
+
+ (defun lua-rx-to-string (form &optional no-group)
+ (rx-let-eval lua--rx-bindings
+ (rx-to-string form no-group))))
+
+;; Local variables
+
+(defgroup lua nil
+ "Major mode for editing Lua code."
+ :prefix "lua-"
+ :group 'languages)
+
+(defcustom lua-indent-level 4
+ "Amount by which Lua subexpressions are indented."
+ :type 'natnum
+ :safe #'natnump
+ :version "31.1")
+
+(defcustom lua-comment-start "-- "
+ "Default value of `comment-start'."
+ :type 'string
+ :version "31.1")
+
+(defcustom lua-comment-start-skip "---*[ \t]*"
+ "Default value of `comment-start-skip'."
+ :type 'string
+ :version "31.1")
+
+(defcustom lua-default-application "lua"
+ "Default application to run in Lua process.
+
+Can be a string, where it denotes a command to be executed to start Lua
+process, or a (HOST . PORT) cons, that can be used to connect to Lua
+process running remotely."
+ :type '(choice (string)
+ (cons string integer))
+ :version "31.1")
+
+(defcustom lua-default-command-switches (list "-i")
+ "Command switches for `lua-default-application'.
+Should be a list of strings."
+ :type '(repeat string)
+ :version "31.1")
+
+(defcustom lua-always-show t
+ "Non-nil means display `lua-process-buffer' after sending a command."
+ :type 'boolean
+ :group 'lua)
+
+(defcustom lua-documentation-function 'browse-url
+ "Function used to fetch the Lua reference manual."
+ :type `(radio (function-item browse-url)
+ ,@(when (fboundp 'eww) '((function-item eww)))
+ ,@(when (fboundp 'w3m-browse-url)
+ '((function-item w3m-browse-url)))
+ (function :tag "Other function"))
+ :version "31.1")
+
+(defcustom lua-documentation-url
+ (or (and (file-readable-p "/usr/share/doc/lua/manual.html")
+ "file:///usr/share/doc/lua/manual.html")
+ "http://www.lua.org/manual/5.1/manual.html")
+ "URL pointing to the Lua reference manual."
+ :type 'string
+ :group 'lua)
+
+(defvar lua-process nil
+ "The active Lua process.")
+
+(defvar lua-process-buffer nil
+ "Buffer used for communication with the Lua process.")
+
+(defcustom lua-prefix-key "\C-c"
+ "Prefix for all `lua-mode' commands."
+ :type 'key-sequence
+ :initialize #'custom-initialize-default
+ :set #'lua--customize-set-prefix-key
+ :get (lambda (sym)
+ (let ((prefix-key (symbol-value sym)))
+ (if (eq 'ignore prefix-key) "" prefix-key)))
+ :version "31.1")
+
+(defvar-keymap lua-prefix-mode-map
+ :doc "Keymap that is used to define keys accessible by `lua-prefix-key'.
+If the latter is nil, the keymap translates into `lua-mode-map' verbatim."
+ "C-l" #'lua-send-buffer
+ "C-f" #'lua-search-documentation)
+
+(defvar lua--electric-indent-chars
+ (mapcar #'string-to-char '("}" "]" ")")))
+
+(defvar lua-mode-map
+ (let ((result-map (make-sparse-keymap)))
+ (unless (boundp 'electric-indent-chars)
+ (mapc (lambda (electric-char)
+ (define-key result-map
+ (read-kbd-macro
+ (char-to-string electric-char))
+ #'lua-electric-match))
+ lua--electric-indent-chars))
+ (define-key result-map [remap backward-up-list] 'lua-backward-up-list)
+
+ ;; Handle prefix-keyed bindings:
+ ;; * if no prefix, set prefix-map as parent, i.e. if key is not
+ ;; defined look it up in prefix-map
+ ;; * if prefix is set, bind the prefix-map to that key
+ (if lua-prefix-key
+ (define-key result-map lua-prefix-key lua-prefix-mode-map)
+ (set-keymap-parent result-map lua-prefix-mode-map))
+ result-map)
+ "Keymap used in `lua-mode' buffers.")
+
+(defun lua--customize-set-prefix-key (prefix-key-sym prefix-key-val)
+ "Set PREFIX-KEY-SYM to PREFIX-KEY-VAL."
+ (unless (eq prefix-key-sym 'lua-prefix-key)
+ (error "Prefix doesn't match lua-prefix-key"))
+ (define-key lua-mode-map lua-prefix-key nil)
+ ;; `lua-set-prefix-key' uses an empty string to remove the prefix.
+ (when (and (equal 'string (type-of prefix-key-val))
+ (string-blank-p prefix-key-val))
+ (setq prefix-key-val (vector #'ignore)))
+ (if (eq 'ignore (elt prefix-key-val 0))
+ (set-keymap-parent lua-mode-map lua-prefix-mode-map)
+ (define-key lua-mode-map prefix-key-val lua-prefix-mode-map))
+ (set-default prefix-key-sym prefix-key-val)
+ (when (fboundp 'lua-prefix-key-update-bindings)
+ (lua-prefix-key-update-bindings)))
+
+(defvar-local lua-electric-flag t
+ "Non-nil means electric actions are enabled.")
+
+(defcustom lua-prompt-regexp "[^\n]*\\(>[\t ]+\\)+$"
+ "Regexp which matches the Lua program's prompt."
+ :type 'regexp
+ :version "31.1")
+
+(defvar-local lua--repl-buffer-p nil
+ "Buffer-local flag saying if this is a Lua REPL buffer.")
+
+(defcustom lua-indent-string-contents nil
+ "If non-nil, contents of multiline string will be indented.
+Otherwise leading amount of whitespace on each line is preserved."
+ :type 'boolean
+ :safe #'booleanp
+ :version "31.1")
+
+(defcustom lua-indent-nested-block-content-align t
+ "Controls how the content of nested blocks are indented.
+If non-nil, the contents of nested blocks are indented to align with the
+column of the opening parenthesis, rather than just forward by
+`lua-indent-level'."
+ :type 'boolean
+ :safe #'booleanp
+ :version "31.1")
+
+(defcustom lua-indent-close-paren-align t
+ "Controls how closing parenthesis is aligned.
+If non-nil, close parenthesis are aligned with their open parenthesis.
+If nil, close parenthesis are aligned to the beginning of the line."
+ :type 'boolean
+ :safe #'booleanp
+ :version "31.1")
+
+(defcustom lua-jump-on-traceback t
+ "Jump to innermost traceback location in *lua* buffer.
+When this variable is non-nil and a traceback occurs when running Lua
+code in a process, jump immediately to the source code of the innermost
+traceback location."
+ :type 'boolean
+ :version "31.1")
+
+(defcustom lua-mode-hook nil
+ "Hooks called when Lua mode fires up."
+ :type 'hook
+ :options '(eglot-ensure
+ flymake-mode
+ hs-minor-mode
+ outline-minor-mode)
+ :version "31.1")
+
+(defvar lua-region-start (make-marker)
+ "Start of special region for Lua communication.")
+
+(defvar lua-region-end (make-marker)
+ "End of special region for Lua communication.")
+
+;; The whole defconst is inside eval-when-compile, because it's later
+;; referenced inside another eval-and-compile block.
+(eval-and-compile
+ (defconst lua--builtins
+ (let* ((modules
+ '("_G" "_VERSION" "assert" "collectgarbage" "dofile" "error" "getfenv"
+ "getmetatable" "ipairs" "load" "loadfile" "loadstring" "module"
+ "next" "pairs" "pcall" "print" "rawequal" "rawget" "rawlen" "rawset"
+ "require" "select" "setfenv" "setmetatable" "tonumber" "tostring"
+ "type" "unpack" "xpcall" "self" "warn"
+ ("bit32" . ("arshift" "band" "bnot" "bor" "btest" "bxor" "extract"
+ "lrotate" "lshift" "replace" "rrotate" "rshift"))
+ ("coroutine" . ("create" "isyieldable" "resume" "running" "status"
+ "wrap" "yield"))
+ ("debug" . ("debug" "getfenv" "gethook" "getinfo" "getlocal"
+ "getmetatable" "getregistry" "getupvalue" "getuservalue"
+ "setfenv" "sethook" "setlocal" "setmetatable"
+ "setupvalue" "setuservalue" "traceback" "upvalueid"
+ "upvaluejoin"))
+ ("io" . ("close" "flush" "input" "lines" "open" "output" "popen"
+ "read" "stderr" "stdin" "stdout" "tmpfile" "type" "write"))
+ ("math" . ("abs" "acos" "asin" "atan" "atan2" "ceil" "cos" "cosh"
+ "deg" "exp" "floor" "fmod" "frexp" "huge" "ldexp" "log"
+ "log10" "max" "maxinteger" "min" "mininteger" "modf" "pi"
+ "pow" "rad" "random" "randomseed" "sin" "sinh" "sqrt"
+ "tan" "tanh" "tointeger" "type" "ult"))
+ ("os" . ("clock" "date" "difftime" "execute" "exit" "getenv"
+ "remove" "rename" "setlocale" "time" "tmpname"))
+ ("package" . ("config" "cpath" "loaded" "loaders" "loadlib" "path"
+ "preload" "searchers" "searchpath" "seeall"))
+ ("string" . ("byte" "char" "dump" "find" "format" "gmatch" "gsub"
+ "len" "lower" "match" "pack" "packsize" "rep" "reverse"
+ "sub" "unpack" "upper"))
+ ("table" . ("concat" "insert" "maxn" "move" "pack" "remove" "sort"
+ "unpack"))
+ ("utf8" . ("char" "charpattern" "codepoint" "codes" "len"
+ "offset")))))
+
+ (cl-labels
+ ((module-name-re (x)
+ (concat "\\(?1:\\_<"
+ (if (listp x) (car x) x)
+ "\\_>\\)"))
+ (module-members-re (x)
+ (if (listp x)
+ (concat "\\(?:[ \t]*\\.[ \t]*"
+ "\\_<\\(?2:"
+ (regexp-opt (cdr x))
+ "\\)\\_>\\)?")
+ "")))
+
+ (concat
+ ;; Common prefix:
+ ;; - beginning-of-line
+ ;; - or neither of [ '.', ':' ] to exclude "foo.string.rep"
+ ;; - or concatenation operator ".."
+ "\\(?:^\\|[^:. \t]\\|[.][.]\\)"
+ ;; Optional whitespace
+ "[ \t]*"
+ "\\(?:"
+ ;; Any of modules/functions
+ (mapconcat (lambda (x)
+ (concat (module-name-re x) (module-members-re x)))
+ modules
+ "\\|")
+ "\\)")))
+ "A regexp that matches Lua builtin functions & variables.
+
+This is a compilation of 5.1-5.4 builtins taken from the index of
+respective Lua reference manuals."))
+
+(defvar lua-font-lock-keywords
+ `(;; Highlight the hash-bang line "#!/foo/bar/lua" as comment
+ ("^#!.*$" . font-lock-comment-face)
+
+ ;; Builtin constants
+ (,(lua-rx (symbol "true" "false" "nil"))
+ . font-lock-constant-face)
+
+ ;; Keywords
+ (,(lua-rx (or lua-keyword lua-keyword-operator))
+ . font-lock-keyword-face)
+
+ ;; Labels used by the "goto" statement
+ ;; Highlights the following syntax: ::label::
+ (,(lua-rx "::" ws lua-name ws "::")
+ . font-lock-constant-face)
+
+ ;; Highlights the name of the label in the "goto" statement like
+ ;; "goto label"
+ (,(lua-rx (symbol (seq "goto" ws+ (group-n 1 lua-name))))
+ (1 font-lock-constant-face))
+
+ ;; Highlight Lua builtin functions and variables
+ (,lua--builtins
+ (1 font-lock-builtin-face) (2 font-lock-builtin-face nil noerror))
+
+ (,(lua-rx (symbol "for") ws+ lua-up-to-9-variables)
+ (1 font-lock-variable-name-face)
+ (2 font-lock-variable-name-face nil noerror)
+ (3 font-lock-variable-name-face nil noerror)
+ (4 font-lock-variable-name-face nil noerror)
+ (5 font-lock-variable-name-face nil noerror)
+ (6 font-lock-variable-name-face nil noerror)
+ (7 font-lock-variable-name-face nil noerror)
+ (8 font-lock-variable-name-face nil noerror)
+ (9 font-lock-variable-name-face nil noerror))
+
+ (,(lua-rx (symbol "function") (? ws+ lua-funcname)
+ ws "(" ws lua-up-to-9-variables)
+ (1 font-lock-variable-name-face)
+ (2 font-lock-variable-name-face nil noerror)
+ (3 font-lock-variable-name-face nil noerror)
+ (4 font-lock-variable-name-face nil noerror)
+ (5 font-lock-variable-name-face nil noerror)
+ (6 font-lock-variable-name-face nil noerror)
+ (7 font-lock-variable-name-face nil noerror)
+ (8 font-lock-variable-name-face nil noerror)
+ (9 font-lock-variable-name-face nil noerror))
+
+ (,(lua-rx lua-funcheader)
+ (1 font-lock-function-name-face))
+
+ ;; local x, y, z
+ ;; local x = .....
+ ;;
+ ;; NOTE: this is intentionally below funcheader matcher, so that in
+ ;;
+ ;; local foo = function() ...
+ ;;
+ ;; "foo" is fontified as function-name-face, and variable-name-face
+ ;; is not applied.
+ (,(lua-rx (symbol "local") ws+ lua-up-to-9-variables)
+ (1 font-lock-variable-name-face)
+ (2 font-lock-variable-name-face nil noerror)
+ (3 font-lock-variable-name-face nil noerror)
+ (4 font-lock-variable-name-face nil noerror)
+ (5 font-lock-variable-name-face nil noerror)
+ (6 font-lock-variable-name-face nil noerror)
+ (7 font-lock-variable-name-face nil noerror)
+ (8 font-lock-variable-name-face nil noerror)
+ (9 font-lock-variable-name-face nil noerror))
+
+ (,(lua-rx (or (group-n 1
+ "@" (symbol "author" "copyright" "field" "release"
+ "return" "see" "usage" "description"))
+ (seq (group-n 1 "@" (symbol "param" "class" "name")) ws+
+ (group-n 2 lua-name))))
+ (1 font-lock-keyword-face t)
+ (2 font-lock-variable-name-face t noerror)))
+ "Default expressions to highlight in Lua mode.")
+
+(defvar lua-imenu-generic-expression
+ `(("Requires" ,(lua-rx (or bol ";") ws (opt (seq (symbol "local") ws))
+ (group-n 1 lua-name) ws "=" ws (symbol "require"))
+ 1)
+ (nil ,(lua-rx (or bol ";") ws (opt (seq (symbol "local") ws))
+ lua-funcheader)
+ 1))
+ "Imenu generic expression for `lua-mode'.
+See `imenu-generic-expression'.")
+
+(defvar lua-sexp-alist '(("then" . "end")
+ ("function" . "end")
+ ("do" . "end")
+ ("repeat" . "until")))
+
+(defvar lua-mode-abbrev-table nil
+ "Abbreviation table used in `lua-mode' buffers.")
+
+(define-abbrev-table 'lua-mode-abbrev-table
+ '(("end" "end" lua-indent-line :system t)
+ ("else" "else" lua-indent-line :system t)
+ ("elseif" "elseif" lua-indent-line :system t)))
+
+(defvar lua-mode-syntax-table
+ (with-syntax-table (copy-syntax-table)
+ ;; Main comment syntax: begins with "--", ends with "\n"
+ (modify-syntax-entry ?- ". 12")
+ (modify-syntax-entry ?\n ">")
+
+ ;; Main string syntax: bounded by ' or "
+ (modify-syntax-entry ?\' "\"")
+ (modify-syntax-entry ?\" "\"")
+
+ ;; Single-character binary operators: punctuation
+ (modify-syntax-entry ?+ ".")
+ (modify-syntax-entry ?* ".")
+ (modify-syntax-entry ?/ ".")
+ (modify-syntax-entry ?^ ".")
+ (modify-syntax-entry ?% ".")
+ (modify-syntax-entry ?> ".")
+ (modify-syntax-entry ?< ".")
+ (modify-syntax-entry ?= ".")
+ (modify-syntax-entry ?~ ".")
+
+ (syntax-table))
+ "`lua-mode' syntax table.")
+
+;;;###autoload
+(define-derived-mode lua-mode prog-mode "Lua"
+ "Major mode for editing Lua code."
+ :abbrev-table lua-mode-abbrev-table
+ :syntax-table lua-mode-syntax-table
+ (setq-local font-lock-defaults '(lua-font-lock-keywords ; keywords
+ nil ; keywords-only
+ nil ; case-fold
+ nil ; syntax-alist
+ nil)) ; syntax-begin
+
+ (setq-local syntax-propertize-function
+ 'lua--propertize-multiline-bounds)
+
+ (setq-local parse-sexp-lookup-properties t)
+ (setq-local indent-line-function 'lua-indent-line)
+ (setq-local beginning-of-defun-function 'lua-beginning-of-proc)
+ (setq-local end-of-defun-function 'lua-end-of-proc)
+ (setq-local comment-start lua-comment-start)
+ (setq-local comment-start-skip lua-comment-start-skip)
+ (setq-local comment-use-syntax t)
+ (setq-local fill-paragraph-function #'lua--fill-paragraph)
+ (with-no-warnings
+ (setq-local comment-use-global-state t))
+ (setq-local imenu-generic-expression lua-imenu-generic-expression)
+ (when (boundp 'electric-indent-chars)
+ ;; If electric-indent-chars is not defined, electric indentation is
+ ;; done via `lua-mode-map'.
+ (setq-local electric-indent-chars
+ (append electric-indent-chars lua--electric-indent-chars)))
+ (add-hook 'flymake-diagnostic-functions #'lua-flymake nil t)
+
+ ;; Hide-show setup
+ (unless (assq 'lua-mode hs-special-modes-alist)
+ (add-to-list 'hs-special-modes-alist
+ `(lua-mode
+ ,(regexp-opt (mapcar 'car lua-sexp-alist) 'words) ; Start
+ ,(regexp-opt (mapcar 'cdr lua-sexp-alist) 'words) ; End
+ nil lua-forward-sexp))))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-mode))
+
+;;;###autoload
+(add-to-list 'interpreter-mode-alist '("lua" . lua-mode))
+
+(defun lua-electric-match (arg)
+ "Insert character ARG and adjust indentation."
+ (interactive "P")
+ (let (blink-paren-function)
+ (self-insert-command (prefix-numeric-value arg)))
+ (when lua-electric-flag
+ (lua-indent-line))
+ (blink-matching-open))
+
+;; Private functions
+
+(defun lua--fill-paragraph (&optional justify region)
+ "Implementation of `forward-paragraph' for filling.
+
+This function works around a corner case in the following situations:
+
+ <>
+ -- some very long comment ....
+ some_code_right_after_the_comment
+
+If point is at the beginning of the comment line, fill paragraph code
+would have gone for comment-based filling and done the right thing, but
+it does not find a comment at the beginning of the empty line before the
+comment and falls back to text-based filling ignoring `comment-start'
+and spilling the comment into the code.
+
+The arguments JUSTIFY and REGION control `fill-paragraph' (which see)."
+ (save-excursion
+ (while (and (not (eobp))
+ (progn (move-to-left-margin)
+ (looking-at paragraph-separate)))
+ (forward-line 1))
+ (let ((fill-paragraph-handle-comment t))
+ (fill-paragraph justify region))))
+
+(defun lua-prefix-key-update-bindings ()
+ "Update prefix key bindings."
+ (if (eq lua-prefix-mode-map (keymap-parent lua-mode-map))
+ ;; If prefix-map is a parent, delete the parent
+ (set-keymap-parent lua-mode-map nil)
+ ;; Otherwise, look for it among children
+ (when-let* ((old-cons (rassoc lua-prefix-mode-map lua-mode-map)))
+ (delq old-cons lua-mode-map)))
+ (if (eq 'ignore (elt lua-prefix-key 0))
+ (set-keymap-parent lua-mode-map lua-prefix-mode-map)
+ (define-key lua-mode-map lua-prefix-key lua-prefix-mode-map)))
+
+(defun lua-set-prefix-key (new-key-str)
+ "Change `lua-prefix-key' to NEW-KEY-STR and update keymaps.
+
+This function replaces previous prefix-key binding with a new one."
+ (interactive "sNew prefix key (empty string means no key): ")
+ (lua--customize-set-prefix-key 'lua-prefix-key (kbd new-key-str))
+ (message "Prefix key set to %S" lua-prefix-key))
+
+(defun lua-string-p (&optional pos)
+ "Return non-nil if point or POS is in a string."
+ (save-excursion (elt (syntax-ppss pos) 3)))
+
+(defun lua--containing-double-hyphen-start-pos ()
+ "Return position of the beginning comment delimiter (--).
+
+Emacs syntax framework does not consider comment delimiters as
+part of the comment itself, but for this package it is useful to
+consider point as inside comment when it is between the two hyphens"
+ (and (eql (char-before) ?-)
+ (eql (char-after) ?-)
+ (1- (point))))
+
+(defun lua-comment-start-pos (&optional parsing-state)
+ "Return position of comment containing current point.
+
+If point is not inside a comment, return nil.
+
+The argument PARSING-STATE is a `syntax-ppss' state."
+ (if-let* ((parsing-state (or parsing-state (syntax-ppss)))
+ ((not (nth 3 parsing-state))) ; Not a string.
+ ((nth 4 parsing-state))) ; Syntax-based comment.
+ (nth 8 parsing-state)
+ (lua--containing-double-hyphen-start-pos)))
+
+(defun lua-comment-or-string-p (&optional pos)
+ "Return non-nil if point or POS is in a comment or string."
+ (save-excursion
+ (let ((parse-result (syntax-ppss pos)))
+ (or (elt parse-result 3) (lua-comment-start-pos parse-result)))))
+
+(defun lua-comment-or-string-start-pos (&optional pos)
+ "Return start position of string or comment containing point or POS.
+
+If point is not inside string or comment, return nil."
+ (save-excursion
+ (when pos (goto-char pos))
+ (or (elt (syntax-ppss pos) 8)
+ (lua--containing-double-hyphen-start-pos))))
+
+;; They're propertized as follows:
+;; 1. generic-comment
+;; 2. generic-string
+;; 3. equals signs
+(defconst lua-ml-begin-regexp
+ "\\(?:\\(?1:-\\)-\\[\\|\\(?2:\\[\\)\\)\\(?3:=*\\)\\[")
+
+(defun lua-try-match-multiline-end (end)
+ "Try to match close-bracket for multiline literal around point.
+
+Basically, detect form of close bracket from syntactic information
+provided at point and `re-search-forward' to it.
+
+The argument END is a buffer position that bounds the search."
+ (let ((comment-or-string-start-pos (lua-comment-or-string-start-pos)))
+ ;; Is there a literal around point?
+ (and comment-or-string-start-pos
+ ;; It is, check if the literal is a multiline open-bracket
+ (save-excursion
+ (goto-char comment-or-string-start-pos)
+ (looking-at lua-ml-begin-regexp))
+
+ ;; Yes it is, look for it matching close-bracket. Close
+ ;; bracket's match group is determined by match-group of
+ ;; open-bracket.
+ (re-search-forward
+ (format "]%s\\(?%s:]\\)"
+ (match-string-no-properties 3)
+ (if (match-beginning 1) 1 2))
+ end 'noerror))))
+
+(defun lua-try-match-multiline-begin (limit)
+ "Try to match multiline open-brackets.
+
+Find next opening long bracket outside of any string/comment. If none
+can be found before reaching LIMIT, return nil."
+ (let (last-search-matched)
+ (while
+ ;; This loop will iterate skipping all multiline-begin tokens
+ ;; that are inside strings or comments ending either at EOL or
+ ;; at valid token.
+ (and (setq last-search-matched
+ (re-search-forward lua-ml-begin-regexp limit 'noerror))
+ ;; Ensure --[[ is not inside a comment or string.
+ ;;
+ ;; This includes "---[[" sequence, in which "--" at the
+ ;; beginning creates a single-line comment, and thus "-[["
+ ;; is no longer a multi-line opener.
+ ;;
+ ;; XXX: need to ensure syntax-ppss beyond (match-beginning
+ ;; 0) is not calculated, or otherwise we'll need to flush
+ ;; the cache.
+ (lua-comment-or-string-start-pos (match-beginning 0))))
+
+ last-search-matched))
+
+(defun lua-match-multiline-literal-bounds (limit)
+ "Move point to multi-line literal bound.
+The argument LIMIT is a buffer position that bounds the search."
+ ;; First, close any multiline literal spanning from previous block.
+ ;; This will move the point accordingly so as to avoid double
+ ;; traversal.
+ (or (lua-try-match-multiline-end limit)
+ (lua-try-match-multiline-begin limit)))
+
+(defun lua--propertize-multiline-bounds (start end)
+ "Put text properties on multiline literal bounds within START and END.
+
+Intended to be used as a `syntax-propertize-function'."
+ (save-excursion
+ (goto-char start)
+ (while (lua-match-multiline-literal-bounds end)
+ (when (match-beginning 1)
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'syntax-table (string-to-syntax "!")))
+ (when (match-beginning 2)
+ (put-text-property (match-beginning 2) (match-end 2)
+ 'syntax-table (string-to-syntax "|"))))))
+
+(defun lua-indent-line ()
+ "Indent current line for Lua mode.
+Return the amount the indentation changed by."
+ (let (indent
+ (case-fold-search nil)
+ ;; Save point as a distance to eob - it's invariant w.r.t
+ ;; indentation.
+ (pos (- (point-max) (point))))
+ (back-to-indentation)
+ (setq indent (if (lua-comment-or-string-p)
+ ;; Just restore point posistion.
+ (lua-calculate-string-or-comment-indentation)
+ (max 0 (lua-calculate-indentation))))
+
+ (unless (equal indent (current-column))
+ (delete-region (line-beginning-position) (point))
+ (indent-to indent))
+
+ ;; If initial point was within line's indentation, position after
+ ;; the indentation. Else stay at same point in text.
+ (when (> (- (point-max) pos) (point))
+ (goto-char (- (point-max) pos)))
+
+ indent))
+
+(defun lua-calculate-string-or-comment-indentation ()
+ "This should be run when point at `current-indentation' is in a string."
+ (if (and (lua-string-p)
+ (not lua-indent-string-contents))
+ ;; If inside string and strings aren't to be indented, return
+ ;; current indentation.
+ (current-indentation)
+
+ ;; At this point, we know that we're inside comment, so make sure
+ ;; close-bracket is unindented like a block that starts after
+ ;; left-shifter.
+ (let ((left-shifter-p (looking-at "\\s *\\(?:--\\)?\\]\\(?1:=*\\)\\]")))
+ (save-excursion
+ (goto-char (lua-comment-or-string-start-pos))
+ (+ (current-indentation)
+ (if (and left-shifter-p
+ (looking-at (format "--\\[%s\\["
+ (match-string-no-properties 1))))
+ 0
+ lua-indent-level))))))
+
+(defun lua--signum (x)
+ "Return 1 if X is positive, -1 if negative, 0 if zero."
+ (cond ((> x 0) 1) ((< x 0) -1) (t 0)))
+
+(defun lua--ensure-point-within-limit (limit backward)
+ "Return non-nil if point is within LIMIT going forward.
+
+With BACKWARD non-nil, return non-nil if point is within LIMIT going
+backward.
+
+If point is beyond limit, move it onto limit."
+ (if (= (lua--signum (- (point) limit))
+ (if backward 1 -1))
+ t
+ (goto-char limit)
+ nil))
+
+(defun lua--escape-from-string (&optional backward)
+ "Move point outside of string if it is inside one.
+
+By default, point is placed after the string, with BACKWARD it is placed
+before the string."
+ (interactive)
+ (let ((parse-state (syntax-ppss)))
+ (when (nth 3 parse-state)
+ (if backward
+ (goto-char (nth 8 parse-state))
+ (parse-partial-sexp
+ (point) (line-end-position) nil nil (syntax-ppss) 'syntax-table))
+ t)))
+
+(defun lua-find-regexp (direction regexp &optional limit)
+ "Search for a regular expression in the direction specified.
+
+DIRECTION is one of \\='forward and \\='backward.
+
+Matches in comments and strings are ignored. If the REGEXP is found,
+returns point position, nil otherwise.
+
+The argument LIMIT is a buffer position that bounds the search."
+ (let ((search-func (if (eq direction 'forward)
+ 're-search-forward 're-search-backward))
+ (case-fold-search nil))
+ (cl-loop
+ always (or (null limit)
+ (lua--ensure-point-within-limit
+ limit (not (eq direction 'forward))))
+ always (funcall search-func regexp limit 'noerror)
+ for match-beg = (match-beginning 0)
+ for match-end = (match-end 0)
+ while (or (lua-comment-or-string-p match-beg)
+ (lua-comment-or-string-p match-end))
+ do (let ((parse-state (syntax-ppss)))
+ (cond
+ ;; Inside a string
+ ((nth 3 parse-state)
+ (lua--escape-from-string (not (eq direction 'forward))))
+ ;; Inside a comment
+ ((nth 4 parse-state)
+ (goto-char (nth 8 parse-state))
+ (when (eq direction 'forward)
+ (forward-comment 1)))))
+ finally return (point))))
+
+(defconst lua-block-regexp
+ (eval-when-compile
+ (rx (or (group symbol-start
+ (group (or "do" "function" "repeat" "then"
+ "else" "elseif" "end" "until"))
+ symbol-end)
+ (group (any "()[]{}"))))))
+
+(defconst lua-block-token-alist
+ '(("do" "\\_" "\\_" middle-or-open)
+ ("function" "\\_" nil open)
+ ("repeat" "\\_" nil open)
+ ("then"
+ "\\_<\\(e\\(lse\\(if\\)?\\|nd\\)\\)\\_>" "\\_<\\(else\\)?if\\_>" middle)
+ ("{" "}" nil open)
+ ("[" "]" nil open)
+ ("(" ")" nil open)
+ ("if" "\\_" nil open)
+ ("for" "\\_" nil open)
+ ("while" "\\_" nil open)
+ ("else" "\\_" "\\_" middle)
+ ("elseif" "\\_" "\\_" middle)
+ ("end" nil "\\_<\\(do\\|function\\|then\\|else\\)\\_>" close)
+ ("until" nil "\\_" close)
+ ("}" nil "{" close)
+ ("]" nil "\\[" close)
+ (")" nil "(" close))
+ "This is a list of block token information blocks.
+
+Each token information entry is of the form:
+ KEYWORD FORWARD-MATCH-REGEXP BACKWARDS-MATCH-REGEXP TOKEN-TYPE
+
+KEYWORD is the token.
+
+FORWARD-MATCH-REGEXP is a regexp that matches all possible tokens when
+going forward.
+
+BACKWARDS-MATCH-REGEXP is a regexp that matches all possible tokens when
+going backwards.
+
+TOKEN-TYPE determines where the token occurs on a statement. Open
+indicates that the token appears at start, close indicates that it
+appears at end, middle indicates that it is a middle type token, and
+middle-or-open indicates that it can appear both as a middle or an open
+type.")
+
+(defconst lua-indentation-modifier-regexp
+ ;; The absence of else is deliberate, since it does not modify the
+ ;; indentation level per se. It only may cause the line, in which the
+ ;; else is, to be shifted to the left.
+ (rx (or (group (or (seq symbol-start
+ (group (or "do" "function" "repeat" "then" "if"
+ "else" "elseif" "for" "while"))
+ symbol-end)
+ (any "([{")))
+ (group (or (seq symbol-start
+ (group (or "end" "until"))
+ symbol-end)
+ (any ")]}"))))))
+
+(defun lua-get-block-token-info (token)
+ "Return the block token info entry for TOKEN from `lua-block-token-alist'."
+ (assoc token lua-block-token-alist))
+
+(defun lua-get-token-match-re (token-info direction)
+ "Return the relevant match regexp from TOKEN-INFO.
+
+The argument DIRECTION controls if the search goes forward or backward."
+ (cond
+ ((eq direction 'forward) (cadr token-info))
+ ((eq direction 'backward) (nth 2 token-info))
+ (t nil)))
+
+(defun lua-get-token-type (token-info)
+ "Return the relevant match regexp from TOKEN-INFO."
+ (nth 3 token-info))
+
+(defun lua-backwards-to-block-begin-or-end ()
+ "Move backwards to nearest block begin or end.
+Return nil if unsuccessful."
+ (interactive)
+ (lua-find-regexp 'backward lua-block-regexp))
+
+(defun lua-find-matching-token-word (token &optional direction)
+ "Find matching open- or close-token for TOKEN in DIRECTION.
+Point has to be exactly at the beginning of TOKEN, e.g. with | being
+point
+
+ {{ }|} -- (lua-find-matching-token-word \"}\" \\='backward) will return
+ -- the first {
+ {{ |}} -- (lua-find-matching-token-word \"}\" \\='backward) will find
+ -- the second {.
+
+DIRECTION has to be either \\='forward or \\='backward."
+ (let* ((token-info (lua-get-block-token-info token))
+ (match-type (lua-get-token-type token-info))
+ ;; If we are on a middle token, go backwards. If it is a
+ ;; middle or open, go forwards
+ (search-direction (or direction
+ (if (or (eq match-type 'open)
+ (eq match-type 'middle-or-open))
+ 'forward
+ 'backward)
+ 'backward))
+ (match (lua-get-token-match-re token-info search-direction))
+ maybe-found-pos)
+ ;; If we are searching forward from the token at the current point
+ ;; (i.e. for a closing token), need to step one character forward
+ ;; first, or the regexp will match the opening token.
+ (when (eq search-direction 'forward) (forward-char 1))
+ (catch 'found
+ ;; If we are attempting to find a matching token for a terminating
+ ;; token (i.e. a token that starts a statement when searching
+ ;; back, or a token that ends a statement when searching forward),
+ ;; then we don't need to look any further.
+ (when (or (and (eq search-direction 'forward)
+ (eq match-type 'close))
+ (and (eq search-direction 'backward)
+ (eq match-type 'open)))
+ (throw 'found nil))
+ (while (lua-find-regexp search-direction lua-indentation-modifier-regexp)
+ ;; Have we found a valid matching token?
+ (let* ((found-token (match-string 0))
+ (found-pos (match-beginning 0))
+ (found-type (lua-get-token-type
+ (lua-get-block-token-info found-token))))
+ (if (not (and match (string-match match found-token)))
+ ;; No - then there is a nested block. If we were looking
+ ;; for a block begin token, found-token must be a block
+ ;; end token; likewise, if we were looking for a block end
+ ;; token, found-token must be a block begin token,
+ ;; otherwise there is a grammatical error in the code.
+ (unless (and (or (eq match-type 'middle)
+ (eq found-type 'middle)
+ (eq match-type 'middle-or-open)
+ (eq found-type 'middle-or-open)
+ (eq match-type found-type))
+ (progn
+ (goto-char found-pos)
+ (lua-find-matching-token-word
+ found-token search-direction)))
+ (when maybe-found-pos
+ (goto-char maybe-found-pos)
+ (throw 'found maybe-found-pos)))
+ ;; Yes.
+ ;; If it is a not a middle kind, report the location
+ (unless (or (eq found-type 'middle)
+ (eq found-type 'middle-or-open))
+ (throw 'found found-pos))
+ ;; If it is a middle-or-open type, record location, but keep
+ ;; searching. If we fail to complete the search, we'll
+ ;; report the location
+ (when (eq found-type 'middle-or-open)
+ (setq maybe-found-pos found-pos))
+ ;; Cannot use tail recursion. Too much nesting on long
+ ;; chains of if/elseif. Will reset variables instead.
+ (setq token found-token)
+ (setq token-info (lua-get-block-token-info token))
+ (setq match (lua-get-token-match-re token-info search-direction))
+ (setq match-type (lua-get-token-type token-info)))))
+ maybe-found-pos)))
+
+(defun lua-goto-matching-block-token (&optional parse-start direction)
+ "Find block begion/end token matching the one at the point.
+This function moves the point to the token that matches the one at the
+current point. Returns the point position of the first character of the
+matching token if successful, nil otherwise.
+
+Optional PARSE-START is a position to which the point should be moved
+first.
+
+DIRECTION has to be \\='forward or \\='backward (\\='forward by default)."
+ (when parse-start (goto-char parse-start))
+ (let ((case-fold-search nil))
+ (when-let* (((looking-at lua-indentation-modifier-regexp))
+ (position (lua-find-matching-token-word
+ (match-string 0) direction)))
+ (goto-char position))))
+
+(defun lua-goto-matching-block (&optional noreport)
+ "Go to the keyword balancing the one under the point.
+If the point is on a keyword/brace that starts a block, go to the
+matching keyword that ends the block, and vice versa.
+
+If optional NOREPORT is non-nil, it won't flag an error if there is no
+block open/close open."
+ (interactive)
+ ;; Search backward to the beginning of the keyword if necessary
+ (when (and (eq (char-syntax (following-char)) ?w)
+ (not (looking-at "\\_<")))
+ (re-search-backward "\\_<" nil t))
+ (if-let* ((position (lua-goto-matching-block-token)))
+ position
+ (unless noreport (error "Not on a block control keyword or brace"))))
+
+(defun lua-skip-ws-and-comments-backward (&optional limit)
+ "Move point back skipping all whitespace and comments.
+
+If LIMIT is given, stop at it or before.
+
+Return non-nil if moved point."
+ (interactive)
+ (unless (lua-string-p)
+ (let ((start-pos (point))
+ (comment-start-pos (lua-comment-start-pos))
+ (limit (min (point) (or limit (point-min)))))
+ (when comment-start-pos (goto-char (max limit comment-start-pos)))
+ (when (< limit (point)) (forward-comment (- limit (point))))
+ (when (< (point) limit) (goto-char limit))
+ (when (/= start-pos (point)) (point)))))
+
+(defun lua-skip-ws-and-comments-forward (&optional limit)
+ "Move point forward skipping all whitespace and comments.
+
+If LIMIT is given, stop at it or before.
+
+Return non-nil if moved point."
+ (interactive)
+ (unless (lua-string-p)
+ (let ((start-pos (point))
+ (comment-start-pos (lua-comment-start-pos))
+ (limit (max (point) (or limit (point-max)))))
+ ;; Escape from current comment. It is necessary to use "while"
+ ;; because luadoc parameters have non-comment face, and
+ ;; parse-partial-sexp with 'syntax-table flag will stop on them.
+ (when comment-start-pos
+ (goto-char comment-start-pos)
+ (forward-comment 1))
+ (when (< (point) limit) (forward-comment (- limit (point))))
+ (when (< limit (point)) (goto-char limit))
+ (when (/= start-pos (point)) (point)))))
+
+(defun lua-forward-line-skip-blanks (&optional back)
+ "Move 1 line forward/backward and skip insignificant ws/comment lines.
+
+Moves point 1 line forward (or backward) skipping lines that contain no
+Lua code besides comments. The point is put to the beginning of the
+line.
+
+Returns final value of point as integer or nil if operation failed.
+
+Non-nil argument BACK changes the direction to backwards."
+ (let ((start-pos (point)))
+ (if back
+ (progn
+ (beginning-of-line)
+ (lua-skip-ws-and-comments-backward))
+ (forward-line)
+ (lua-skip-ws-and-comments-forward))
+ (beginning-of-line)
+ (when (> (count-lines start-pos (point)) 0)
+ (point))))
+
+(eval-when-compile
+ (defconst lua-operator-class
+ "-+*/^.=<>~:&|"))
+
+(defconst lua-cont-eol-regexp
+ (eval-when-compile
+ (rx-to-string
+ `(seq (or (group-n 1
+ symbol-start
+ (group (or "and" "or" "not" "in" "for" "while" "local"
+ "function" "if" "until" "elseif" "return"))
+ symbol-end)
+ (seq (or bol (not (any ,lua-operator-class)))
+ (group-n 2
+ (group (or "%" "&" "*" "+" "," "-" "." ".." "/" ":"
+ "<" "<<" "<=" "=" "==" ">" ">=" ">>" "^"
+ "|" "~" "~=")))))
+ (zero-or-more (syntax whitespace))
+ point)))
+ "Regexp that matches the ending of a line that needs continuation.
+
+This regexp starts from eol and looks for a binary operator or an
+unclosed block intro (i.e. `for' without `do' or `if' without `then')
+followed by an optional whitespace till the end of the line.")
+
+(defconst lua-cont-bol-regexp
+ (eval-when-compile
+ (rx-to-string
+ `(seq point (zero-or-more (syntax whitespace))
+ (or (group-n 1
+ symbol-start
+ (group (or "and" "in" "not" "or"))
+ symbol-end)
+ (seq (group-n 2
+ (group (or "%" "&" "*" "+" "," "-" "." ".." "/" ":"
+ "<" "<<" "<=" "=" "==" ">" ">=" ">>" "^"
+ "|" "~" "~=")))
+ (or eol (not (any ,lua-operator-class))))))))
+ "Regexp that matches a line that continues previous one.
+
+This regexp means, starting from point there is an optional whitespace
+followed by Lua binary operator. Lua is very liberal when it comes to
+continuation line, so we're safe to assume that every line that starts
+with a binop continues previous one even though it looked like an
+end-of-statement.")
+
+(defun lua-last-token-continues-p ()
+ "Return non-nil if the last token on this line is a continuation token."
+ (let ((line-begin (line-beginning-position))
+ return-value)
+ (save-excursion
+ (end-of-line)
+ (lua-skip-ws-and-comments-backward line-begin)
+ (setq return-value (and (re-search-backward lua-cont-eol-regexp line-begin t)
+ (or (match-beginning 1)
+ (match-beginning 2))))
+ (when (and return-value
+ (string-equal (match-string-no-properties 0) "return"))
+ ;; "return" keyword is ambiguous and depends on next token
+ (unless (save-excursion
+ (goto-char (match-end 0))
+ (forward-comment (point-max))
+ (and
+ ;; Not continuing: at end of file
+ (not (eobp))
+ (or
+ ;; "function" keyword: it is a continuation, e.g.
+ ;;
+ ;; return
+ ;; function() return 123 end
+ ;;
+ (looking-at (lua-rx (symbol "function")))
+ ;; Looking at semicolon or any other keyword: not
+ ;; continuation
+ (not (looking-at (lua-rx (or ";" lua-keyword)))))))
+ (setq return-value nil)))
+ return-value)))
+
+(defun lua-first-token-continues-p ()
+ "Return non-nil if the first token on this line is a continuation token."
+ (let ((line-end (line-end-position)))
+ (save-excursion
+ (beginning-of-line)
+ (lua-skip-ws-and-comments-forward line-end)
+ ;; If first character of the line is inside string, it's a
+ ;; continuation if strings aren't supposed to be indented,
+ ;; `lua-calculate-indentation' won't even let the control inside
+ ;; this function
+ (and
+ (re-search-forward lua-cont-bol-regexp line-end t)
+ (or (match-beginning 1)
+ (match-beginning 2))))))
+
+(defun lua--backward-up-list-noerror ()
+ "Safe version of `lua-backward-up-list' that does not signal an error."
+ (condition-case nil
+ (lua-backward-up-list)
+ (scan-error nil)))
+
+(defun lua-backward-up-list ()
+ "Goto starter/opener of the block containing point."
+ (interactive)
+ (let ((start-pos (point))
+ end-pos)
+ (or
+ ;; Return parent block opener token if it exists.
+ (cl-loop
+ ;; Search indentation modifier backward, return nil on failure.
+ always (lua-find-regexp 'backward lua-indentation-modifier-regexp)
+ ;; Fetch info about the found token
+ for token = (match-string-no-properties 0)
+ for token-info = (lua-get-block-token-info token)
+ for token-type = (lua-get-token-type token-info)
+ ;; If the token is a close token, continue to skip its opener. If not
+ ;; close, stop and return found token.
+ while (eq token-type 'close)
+ ;; Find matching opener to skip it and continue from beginning.
+ ;;
+ ;; Return nil on failure.
+ always (let ((position (lua-find-matching-token-word token 'backward)))
+ (and position (goto-char position)))
+ finally return token-info)
+ (progn
+ (setq end-pos (point))
+ (goto-char start-pos)
+ (signal 'scan-error
+ (list "Block open token not found"
+ ;; If start-pos == end-pos, the "obstacle" is current
+ (if (eql start-pos end-pos) start-pos (match-beginning 0))
+ (if (eql start-pos end-pos) start-pos (match-end 0))))))))
+
+(defun lua--continuation-breaking-line-p ()
+ "Return non-nil if looking at token(-s) that forbid continued line."
+ (save-excursion
+ (lua-skip-ws-and-comments-forward (line-end-position))
+ (looking-at (lua-rx (or (symbol "do" "while" "repeat" "until"
+ "if" "then" "elseif" "else"
+ "for" "local")
+ lua-funcheader)))))
+
+(defun lua-is-continuing-statement-p-1 ()
+ "Return non-nil if current line continues a statement.
+
+More specifically, return the point in the line that is continued.
+The criteria for a continuing statement are:
+
+* The last token of the previous line is a continuing op,
+ OR the first token of the current line is a continuing op.
+
+* The expression is not enclosed by a parentheses/braces/brackets."
+ (let (prev-line continuation-pos parent-block-opener)
+ (save-excursion (setq prev-line (lua-forward-line-skip-blanks 'back)))
+ (and prev-line
+ (not (lua--continuation-breaking-line-p))
+ (save-excursion
+ ;; Binary operator or keyword that implies continuation.
+ (and (setq continuation-pos
+ (or (lua-first-token-continues-p)
+ (save-excursion
+ (goto-char prev-line)
+ ;; Check last token of previous nonblank line
+ (lua-last-token-continues-p))))
+ (not
+ ;; Operators/keywords does not create continuation
+ ;; inside some blocks:
+ (and (setq parent-block-opener
+ (car-safe (lua--backward-up-list-noerror)))
+ (or
+ ;; Inside parens/brackets
+ (member parent-block-opener '("(" "["))
+ ;; Inside braces if it is a comma
+ (and (eq (char-after continuation-pos) ?,)
+ (equal parent-block-opener "{")))))
+ continuation-pos)))))
+
+(defun lua-is-continuing-statement-p (&optional parse-start)
+ "Return non-nil if PARSE-START should be indented as continuation line.
+
+This true is when the line:
+
+* Is continuing a statement itself
+
+* Starts with a 1+ block-closer tokens, an top-most block opener is on a
+ continuation line."
+ (save-excursion
+ (when parse-start (goto-char parse-start))
+
+ ;; If line starts with a series of closer tokens, whether or not the
+ ;; line is a continuation line is decided by the opener line, e.g.
+ ;;
+ ;; x = foo +
+ ;; long_function_name(
+ ;; long_parameter_1,
+ ;; long_parameter_2,
+ ;; long_parameter_3,
+ ;; ) + long_function_name2({
+ ;; long_parameter_1,
+ ;; long_parameter_2,
+ ;; long_parameter_3,
+ ;; })
+ ;;
+ ;; Final line, "})" is a continuation line, but it is decided by the
+ ;; opener line, ") + long_function_name2({", which in its turn is
+ ;; decided by the "long_function_name(" line, which is a
+ ;; continuation line because the line before it ends with a binary
+ ;; operator.
+ (cl-loop
+ ;; Go to opener line
+ while (and (lua--goto-line-beginning-rightmost-closer)
+ (lua--backward-up-list-noerror))
+ ;; If opener line is continuing, repeat. If opener line is not
+ ;; Continuing, return nil.
+ always (lua-is-continuing-statement-p-1)
+ ;; We get here if there was no opener to go to: check current line.
+ finally return (lua-is-continuing-statement-p-1))))
+
+(defun lua-make-indentation-info-pair (found-token found-pos)
+ "Create a pair from FOUND-TOKEN and FOUND-POS for indentation calculation.
+
+This is a helper function to `lua-calculate-indentation-info'.
+Don't use standalone."
+ (cond
+ ;; Functions are a bit tricky to indent right. They can appear in a
+ ;; lot ot different contexts. Until I find a shortcut, I'll leave it
+ ;; with a simple relative indentation.
+ ;; The special cases are for indenting according to the location of
+ ;; the function. i.e.:
+ ;; (cons 'absolute (+ (current-column) lua-indent-level))
+ ;; TODO: Fix this. It causes really ugly indentations for in-line
+ ;; functions.
+ ((string-equal found-token "function")
+ (cons 'relative lua-indent-level))
+
+ ;; Block openers
+ ((and lua-indent-nested-block-content-align
+ (member found-token (list "{" "(" "[")))
+ (save-excursion
+ (let ((found-bol (line-beginning-position)))
+ (forward-comment (point-max))
+ ;; If the next token is on this line and it's not a block
+ ;; opener, the next line should align to that token.
+ (if (and (zerop (count-lines found-bol (line-beginning-position)))
+ (not (looking-at lua-indentation-modifier-regexp)))
+ (cons 'absolute (current-column))
+ (cons 'relative lua-indent-level)))))
+
+ ;; These are not really block starters. They should not add to
+ ;; indentation. The corresponding "then" and "do" handle the
+ ;; indentation.
+ ((member found-token (list "if" "for" "while"))
+ (cons 'relative 0))
+ ;; closing tokens follow: These are usually taken care of by
+ ;; lua-calculate-indentation-override.
+ ;; elseif is a bit of a hack. It is not handled separately, but it
+ ;; needs to nullify a previous then if on the same line.
+ ((member found-token (list "until" "elseif"))
+ (save-excursion
+ (let* ((line-beginning (line-beginning-position))
+ (same-line (and (lua-goto-matching-block-token found-pos 'backward)
+ (<= line-beginning (point)))))
+ (if same-line
+ (cons 'remove-matching 0)
+ (cons 'relative 0)))))
+
+ ;; else is a special case; if its matching block token is on the same
+ ;; line, instead of removing the matching token, it has to replace
+ ;; it, so that either the next line will be indented correctly, or
+ ;; the end on the same line will remove the effect of the else.
+ ((string-equal found-token "else")
+ (save-excursion
+ (let* ((line-beginning (line-beginning-position))
+ (same-line (and (lua-goto-matching-block-token found-pos 'backward)
+ (<= line-beginning (point)))))
+ (if same-line
+ (cons 'replace-matching (cons 'relative lua-indent-level))
+ (cons 'relative lua-indent-level)))))
+
+ ;; Block closers. If they are on the same line as their openers,
+ ;; they simply eat up the matching indentation modifier. Otherwise,
+ ;; they pull indentation back to the matching block opener.
+ ((member found-token (list ")" "}" "]" "end"))
+ (save-excursion
+ (let* ((line-beginning (line-beginning-position))
+ (same-line (and (lua-goto-matching-block-token found-pos 'backward)
+ (<= line-beginning (point))))
+ (opener-pos (point))
+ opener-continuation-offset)
+ (if same-line
+ (cons 'remove-matching 0)
+ (back-to-indentation)
+ (setq opener-continuation-offset
+ (if (lua-is-continuing-statement-p-1) lua-indent-level 0))
+
+ ;; Accumulate indentation up to opener, including indentation.
+ ;; If there were no other indentation modifiers until said
+ ;; opener, ensure there is no continuation after the closer.
+ `(multiple . ((absolute . ,(- (current-indentation)
+ opener-continuation-offset))
+ ,@(when (/= opener-continuation-offset 0)
+ (list (cons 'continued-line
+ opener-continuation-offset)))
+ ,@(delete nil (list (lua-calculate-indentation-info-1
+ nil opener-pos)))
+ (cancel-continued-line . nil)))))))
+
+ ((member found-token '("do" "then"))
+ `(multiple . ((cancel-continued-line . nil) (relative . ,lua-indent-level))))
+
+ ;; Everything else. This is from the original code: If opening a
+ ;; block (match-data 1 exists), then push indentation one level up,
+ ;; if it is closing a block, pull it one level down.
+ ('other-indentation-modifier
+ (cons 'relative (if (nth 2 (match-data))
+ ;; Beginning of a block matched
+ lua-indent-level
+ ;; End of a block matched
+ (- lua-indent-level))))))
+
+(defun lua-add-indentation-info-pair (pair info-list)
+ "Add the indentation info PAIR to the list of indentation INFO-LIST.
+This function has special case handling for two tokens: remove-matching,
+and replace-matching. These two tokens are cleanup tokens that remove
+or alter the effect of a previously recorded indentation info.
+
+When a remove-matching token is encountered, the last recorded info,
+i.e. the car of the list is removed. This is used to roll-back an
+indentation of a block opening statement when it is closed.
+
+When a replace-matching token is seen, the last recorded info is
+removed, and the cdr of the replace-matching info is added in its place.
+This is used when a middle-of the block (the only case is `else') is
+seen on the same line the block is opened."
+ (cond
+ ((eq 'multiple (car pair))
+ (let ((info-pair-elts (cdr pair)))
+ (while info-pair-elts
+ (setq info-list (lua-add-indentation-info-pair
+ (car info-pair-elts) info-list)
+ info-pair-elts (cdr info-pair-elts)))
+ info-list))
+ ((eq 'cancel-continued-line (car pair))
+ (if (eq (caar info-list) 'continued-line)
+ (cdr info-list)
+ info-list))
+ ((eq 'remove-matching (car pair))
+ ;; Remove head of list
+ (cdr info-list))
+ ((eq 'replace-matching (car pair))
+ ;; Remove head of list, and add the cdr of pair instead
+ (cons (cdr pair) (cdr info-list)))
+ ((listp (cdr-safe pair))
+ (nconc pair info-list))
+ (t
+ ;; Just add the pair
+ (cons pair info-list))))
+
+(defun lua-calculate-indentation-info-1 (indentation-info bound)
+ "Helper function for `lua-calculate-indentation-info'.
+
+Return list of indentation modifiers from point to BOUND.
+
+The argument INDENTATION-INFO is an indentation INFO-LIST."
+ (while (lua-find-regexp 'forward lua-indentation-modifier-regexp
+ bound)
+ (let ((found-token (match-string 0))
+ (found-pos (match-beginning 0)))
+ (setq indentation-info
+ (lua-add-indentation-info-pair
+ (lua-make-indentation-info-pair found-token found-pos)
+ indentation-info))))
+ indentation-info)
+
+(defun lua-calculate-indentation-info (&optional parse-end)
+ "Compute how each block token on the line affects indentation.
+The effect of each token can be either a shift relative to the current
+indentation level, or indentation to some absolute column. This
+information is collected in a list of indentation info pairs, which
+denote absolute and relative each, and the shift/column to indent to.
+
+The argument PARSE-END is a buffer position that bounds the calculation."
+ (let (indentation-info cont-stmt-pos)
+ (while (setq cont-stmt-pos (lua-is-continuing-statement-p))
+ (lua-forward-line-skip-blanks 'back)
+ (when (< cont-stmt-pos (point))
+ (goto-char cont-stmt-pos)))
+
+ ;; Calculate indentation modifiers for the line itself
+ (setq indentation-info (list (cons 'absolute (current-indentation))))
+
+ (back-to-indentation)
+ (setq indentation-info
+ (lua-calculate-indentation-info-1
+ indentation-info (min parse-end (line-end-position))))
+
+ ;; And do the following for each continuation line before PARSE-END
+ (while (and (eql (forward-line 1) 0)
+ (<= (point) parse-end))
+
+ ;; Handle continuation lines:
+ (if (lua-is-continuing-statement-p)
+ ;; If it's the first continuation line, add one level
+ (unless (eq (car (car indentation-info)) 'continued-line)
+ (push (cons 'continued-line lua-indent-level) indentation-info))
+
+ ;; If it's the first non-continued line, subtract one level
+ (when (eq (car (car indentation-info)) 'continued-line)
+ (push (cons 'stop-continued-line (- lua-indent-level)) indentation-info)))
+
+ ;; Add modifiers found in this continuation line
+ (setq indentation-info
+ (lua-calculate-indentation-info-1
+ indentation-info (min parse-end (line-end-position)))))
+
+ indentation-info))
+
+(defun lua-accumulate-indentation-info (reversed-indentation-info)
+ "Accumulate indent information from `lua-calculate-indentation-info'.
+Returns either the relative indentation shift, or the absolute column to
+indent to.
+
+The argument REVERSED-INDENTATION-INFO is an indentation INFO-LIST."
+ (let (indentation-info
+ (type 'relative)
+ (accu 0))
+ ;; Aggregate all neighbouring relative offsets, reversing the INFO list.
+ (dolist (elt reversed-indentation-info)
+ (if (and (eq (car elt) 'relative)
+ (eq (caar indentation-info) 'relative))
+ (setcdr (car indentation-info) (+ (cdar indentation-info) (cdr elt)))
+ (push elt indentation-info)))
+
+ ;; Aggregate indentation info, taking 'absolute modifiers into account.
+ (mapc (lambda (x)
+ (if-let* ((new-val (cdr x))
+ ((eq 'absolute (car x))))
+ (setq type 'absolute
+ accu new-val)
+ (setq accu (+ accu new-val))))
+ indentation-info)
+
+ (cons type accu)))
+
+(defun lua-calculate-indentation-block-modifier (&optional parse-end)
+ "Return amount by which this line modifies the indentation.
+Beginnings of blocks add `lua-indent-level' once each, and endings of
+blocks subtract `lua-indent-level' once each. This function is used to
+determine how the indentation of the following line relates to this one.
+
+The argument PARSE-END is a buffer position that bounds the calculation."
+ (let (indentation-info)
+ (save-excursion
+ ;; First go back to the line that starts it all
+ ;; lua-calculate-indentation-info will scan through the whole thing
+ (let ((case-fold-search nil))
+ (setq indentation-info
+ (lua-accumulate-indentation-info
+ (lua-calculate-indentation-info parse-end)))))
+
+ (if (eq (car indentation-info) 'absolute)
+ (- (cdr indentation-info) (current-indentation))
+ (cdr indentation-info))))
+
+(eval-when-compile
+ (defconst lua--function-name-rx
+ '(seq symbol-start
+ (+ (any alnum "_"))
+ (* "." (+ (any alnum "_")))
+ (? ":" (+ (any alnum "_")))
+ symbol-end)
+ "Lua function name regexp in `rx'-SEXP format."))
+
+(defconst lua--left-shifter-regexp
+ (eval-when-compile
+ (rx
+ ;; This regexp should answer the following questions:
+ ;; 1. Is there a left shifter regexp on that line?
+ ;; 2. Where does block-open token of that left shifter reside?
+ (or (seq (group-n 1 symbol-start "local" (+ blank)) "function" symbol-end)
+ (seq (group-n 1 (eval lua--function-name-rx) (* blank)) (any "{("))
+ (seq (group-n 1 (or
+ ;; Assignment statement prefix
+ (seq (* nonl) (not (any "<=>~")) "=" (* blank))
+ ;; Return statement prefix
+ (seq word-start "return" word-end (* blank))))
+ ;; Right hand side
+ (or "{"
+ "function"
+ "("
+ (seq (group-n 1 (eval lua--function-name-rx) (* blank))
+ (any "({")))))))
+
+ "Regular expression that matches left-shifter expression.
+
+Left-shifter expression is defined as follows. If a block follows a
+left-shifter expression, its contents & block-close token should be
+indented relative to left-shifter expression indentation rather then to
+block-open token.
+
+For example:
+ -- `local a = ' is a left-shifter expression
+ -- `function' is a block-open token
+ local a = function()
+ -- block contents is indented relative to left-shifter
+ foobarbaz()
+ -- block-end token is unindented to left-shifter indentation
+ end
+
+The following left-shifter expressions are currently handled:
+1. local function definition with function block, begin-end
+2. function call with arguments block, () or {}
+3. assignment/return statement with
+ - table constructor block, {}
+ - function call arguments block, () or {} block
+ - function expression a.k.a. lambda, begin-end block.")
+
+(defun lua-point-is-after-left-shifter-p ()
+ "Check if point is right after a left-shifter expression.
+
+See `lua--left-shifter-regexp' for description & example of left-shifter
+expression."
+ (save-excursion
+ (let ((old-point (point)))
+ (back-to-indentation)
+ (and
+ (/= (point) old-point)
+ (looking-at lua--left-shifter-regexp)
+ (= old-point (match-end 1))))))
+
+(defun lua--goto-line-beginning-rightmost-closer (&optional parse-start)
+ "Move point to the opening of the rightmost closing bracket at point.
+The argument PARSE-START is a buffer position to start from."
+ (let (case-fold-search pos line-end-pos return-val)
+ (save-excursion
+ (when parse-start (goto-char parse-start))
+ (setq line-end-pos (line-end-position))
+ (back-to-indentation)
+ (unless (lua-comment-or-string-p)
+ (cl-loop while (and (<= (point) line-end-pos)
+ (looking-at lua-indentation-modifier-regexp))
+ for token-info = (lua-get-block-token-info (match-string 0))
+ for token-type = (lua-get-token-type token-info)
+ while (not (eq token-type 'open))
+ do (progn
+ (setq pos (match-beginning 0)
+ return-val token-info)
+ (goto-char (match-end 0))
+ (forward-comment (line-end-position))))))
+ (when pos
+ (goto-char pos)
+ return-val)))
+
+(defun lua-calculate-indentation-override (&optional parse-start)
+ "Return overriding indentation amount for special cases.
+
+If there's a sequence of block-close tokens starting at the beginning of
+the line, calculate indentation according to the line containing
+block-open token for the last block-close token in the sequence.
+
+If not, return nil.
+
+Optional PARSE-START is a position to which the point should be moved
+first."
+ (let (case-fold-search rightmost-closer-info opener-info opener-pos)
+ (save-excursion
+ (when (and (setq rightmost-closer-info (lua--goto-line-beginning-rightmost-closer parse-start))
+ (setq opener-info (lua--backward-up-list-noerror))
+ ;; Ensure opener matches closer.
+ (string-match (lua-get-token-match-re rightmost-closer-info 'backward)
+ (car opener-info)))
+
+ ;; Special case: "middle" tokens like for/do, while/do, if/then,
+ ;; elseif/then: corresponding "end" or corresponding "else" must
+ ;; be unindented to the beginning of the statement, which is not
+ ;; necessarily the same as beginning of string that contains
+ ;; "do", e.g.
+ ;;
+ ;; while (
+ ;; foo and
+ ;; bar) do
+ ;; hello_world()
+ ;; end
+ (setq opener-pos (point))
+ (when (/= (- opener-pos (line-beginning-position)) (current-indentation))
+ (unless (or
+ (and (string-equal (car opener-info) "do")
+ (member (car (lua--backward-up-list-noerror))
+ '("while" "for")))
+ (and (string-equal (car opener-info) "then")
+ (member (car (lua--backward-up-list-noerror))
+ '("if" "elseif"))))
+ (goto-char opener-pos)))
+
+ ;; (let (cont-stmt-pos)
+ ;; (while (setq cont-stmt-pos (lua-is-continuing-statement-p))
+ ;; (goto-char cont-stmt-pos)))
+ ;; Exception cases: when the start of the line is an assignment,
+ ;; go to the start of the assignment instead of the matching
+ ;; item
+ (if (and lua-indent-close-paren-align
+ (member (car opener-info) '("{" "(" "["))
+ (not (lua-point-is-after-left-shifter-p)))
+ (current-column)
+ (current-indentation))))))
+
+(defun lua-calculate-indentation ()
+ "Return appropriate indentation for current line as Lua code."
+ (save-excursion
+ (let ((cur-line-begin-pos (line-beginning-position)))
+ (or
+ ;; When calculating indentation, do the following:
+ ;; 1. check, if the line starts with indentation-modifier
+ ;; (open/close brace) and if it should be indented/unindented
+ ;; in special way
+ (lua-calculate-indentation-override)
+
+ (when (lua-forward-line-skip-blanks 'back)
+ ;; The order of function calls here is important. block
+ ;; modifier call may change the point to another line
+ (let* ((modifier
+ (lua-calculate-indentation-block-modifier cur-line-begin-pos)))
+ (+ (current-indentation) modifier)))
+
+ ;; 4. if there's no previous line, indentation is 0
+ 0))))
+
+(defvar lua--beginning-of-defun-re
+ (lua-rx-to-string '(: bol (? (symbol "local") ws+) lua-funcheader))
+ "Lua top level (matches only at the beginning of line) function header regex.")
+
+(defun lua-beginning-of-proc (&optional arg)
+ "Move backward to the beginning of a Lua proc (or similar).
+
+With argument ARG, do it that many times. Negative ARG -N means move
+forward to Nth following beginning of proc.
+
+Returns t unless search stops due to beginning or end of buffer."
+ (interactive "P")
+ (or arg (setq arg 1))
+
+ (while (and (> arg 0)
+ (re-search-backward lua--beginning-of-defun-re nil t))
+ (setq arg (1- arg)))
+
+ (while (and (< arg 0)
+ (re-search-forward lua--beginning-of-defun-re nil t))
+ (beginning-of-line)
+ (setq arg (1+ arg)))
+
+ (zerop arg))
+
+(defun lua-end-of-proc (&optional arg)
+ "Move forward to next end of Lua proc (or similar).
+
+With argument ARG, do it that many times. Negative ARG -N means move
+back to Nth preceding end of proc.
+
+This function just searches for a `end' at the beginning of a line."
+ (interactive "P")
+ (or arg
+ (setq arg 1))
+ (let ((found nil)
+ (ret t))
+ (if (and (< arg 0)
+ (not (bolp))
+ (save-excursion
+ (beginning-of-line)
+ (eq (following-char) ?})))
+ (forward-char -1))
+ (while (> arg 0)
+ (if (re-search-forward "^end" nil t)
+ (setq arg (1- arg)
+ found t)
+ (setq ret nil
+ arg 0)))
+ (while (< arg 0)
+ (if (re-search-backward "^end" nil t)
+ (setq arg (1+ arg)
+ found t)
+ (setq ret nil
+ arg 0)))
+ (if found
+ (progn
+ (beginning-of-line)
+ (forward-line)))
+ ret))
+
+(defvar lua-process-init-code
+ (mapconcat
+ 'identity
+ '("local loadstring = loadstring or load"
+ "function luamode_loadstring(str, displayname, lineoffset)"
+ " if lineoffset > 1 then"
+ " str = string.rep('\\n', lineoffset - 1) .. str"
+ " end"
+ ""
+ " local x, e = loadstring(str, '@'..displayname)"
+ " if e then"
+ " error(e)"
+ " end"
+ " return x()"
+ "end")
+ " "))
+
+(defun lua-make-lua-string (str)
+ "Convert STR to Lua literal."
+ (concat "'"
+ (replace-regexp-in-string
+ (rx (or ?\" ?' ?\t ?\n ?\\))
+ (lambda (s)
+ (cdr (assq (aref s 0) '((?\" . "\\\"")
+ (?\\ . "\\\\")
+ (?\n . "\\n")
+ (?\t . "\\t")
+ (?' . "\\'")))))
+ str t t)
+ "'"))
+
+;;;###autoload
+(defalias 'run-lua #'lua-start-process)
+
+;;;###autoload
+(defun lua-start-process (&optional name program startfile &rest switches)
+ "Start a Lua process named NAME, running PROGRAM.
+PROGRAM defaults to NAME, which defaults to `lua-default-application'.
+When called interactively, switch to the process buffer.
+
+STARTFILE is the name of a file, whose contents are sent to the process
+as its initial input.
+
+SWITCHES is a list of strings passed as arguments to PROGRAM."
+ (interactive)
+ (setq name (or name (if (consp lua-default-application)
+ (car lua-default-application)
+ lua-default-application)))
+ (setq program (or program lua-default-application))
+ ;; Don't re-initialize if there already is a lua process
+ (unless (comint-check-proc (format "*%s*" name))
+ (setq lua-process-buffer (apply #'make-comint name program startfile
+ (or switches lua-default-command-switches)))
+ (setq lua-process (get-buffer-process lua-process-buffer))
+ (set-process-query-on-exit-flag lua-process nil)
+ (with-current-buffer lua-process-buffer
+ (setq lua--repl-buffer-p t)
+ (compilation-shell-minor-mode 1)
+ (setq-local comint-prompt-regexp lua-prompt-regexp)
+
+ ;; Don't send initialization code until seeing the prompt to
+ ;; ensure that the interpreter is ready.
+ (while (not (lua-prompt-line))
+ (accept-process-output (get-buffer-process (current-buffer)))
+ (goto-char (point-max)))
+ (lua-send-string lua-process-init-code)))
+
+ ;; When called interactively, switch to process buffer
+ (when (called-interactively-p 'any)
+ (switch-to-buffer lua-process-buffer)))
+
+(defun lua-get-create-process ()
+ "Return active Lua process creating one if necessary."
+ (lua-start-process)
+ lua-process)
+
+(defun lua-kill-process ()
+ "Kill Lua process and its buffer."
+ (interactive)
+ (when (buffer-live-p lua-process-buffer)
+ (kill-buffer lua-process-buffer)
+ (setq lua-process-buffer nil)))
+
+(defun lua-set-lua-region-start (&optional arg)
+ "Set start of region for `lua-send-lua-region' to point or ARG."
+ (interactive)
+ (set-marker lua-region-start (or arg (point))))
+
+(defun lua-set-lua-region-end (&optional arg)
+ "Set end of region for `lua-send-lua-region' to point or ARG."
+ (interactive)
+ (set-marker lua-region-end (or arg (point))))
+
+(defun lua-send-string (str)
+ "Send STR plus a newline to the Lua process.
+
+If `lua-process' is nil or dead, start a new process first."
+ (unless (string-equal (substring str -1) "\n")
+ (setq str (concat str "\n")))
+ (process-send-string (lua-get-create-process) str))
+
+(defun lua-send-current-line ()
+ "Send current line to the Lua process, found in `lua-process'.
+If `lua-process' is nil or dead, start a new process first."
+ (interactive)
+ (lua-send-region (line-beginning-position) (line-end-position)))
+
+(defun lua-send-defun (pos)
+ "Send the function definition around POS to the Lua process."
+ (interactive "d")
+ (save-excursion
+ (let ((start (if (save-match-data (looking-at "^function[ \t]"))
+ ;; point already at the start of "function". We
+ ;; need to handle this case explicitly since
+ ;; lua-beginning-of-proc will move to the beginning
+ ;; of the _previous_ function.
+ (point)
+ ;; point is not at the beginning of function, move
+ ;; there and bind start to that position
+ (lua-beginning-of-proc)
+ (point)))
+ (end (progn (lua-end-of-proc) (point))))
+
+ ;; Make sure point is in a function definition before sending to
+ ;; the process
+ (if (and (>= pos start) (< pos end))
+ (lua-send-region start end)
+ (error "Not on a function definition")))))
+
+(defun lua-maybe-skip-shebang-line (start)
+ "Skip interpreter line at beginning of buffer.
+
+Return a position that is after Lua-recognized shebang line (1st
+character in file must be #) if START is at its beginning. Otherwise,
+return START."
+ (save-restriction
+ (widen)
+ (if (and (eq start (point-min))
+ (eq (char-after start) ?#))
+ (save-excursion
+ (goto-char start)
+ (forward-line)
+ (point))
+ start)))
+
+(defun lua-send-region (start end)
+ "Send region between START and END to the inferior Lua process."
+ (interactive "r")
+ (setq start (lua-maybe-skip-shebang-line start))
+ (let* ((lineno (line-number-at-pos start))
+ (lua-file (or (buffer-file-name) (buffer-name)))
+ (region-str (buffer-substring-no-properties start end))
+ (command
+ ;; Print empty line before executing the code so that the
+ ;; first line of output doesn't end up on the same line as
+ ;; current prompt.
+ (format "print(''); luamode_loadstring(%s, %s, %s);\n"
+ (lua-make-lua-string region-str)
+ (lua-make-lua-string lua-file)
+ lineno)))
+ (lua-send-string command)
+ (when lua-always-show (lua-show-process-buffer))))
+
+(defun lua-prompt-line ()
+ "Return non-nil if the inferior Lua process prompt is available."
+ (save-excursion
+ (save-match-data
+ (forward-line 0)
+ (when (looking-at comint-prompt-regexp)
+ (match-end 0)))))
+
+(defun lua-send-lua-region ()
+ "Send preset Lua region to Lua process."
+ (interactive)
+ (unless (and lua-region-start lua-region-end)
+ (error "Region not set"))
+ (lua-send-region lua-region-start lua-region-end))
+
+(defalias 'lua-send-proc 'lua-send-defun)
+
+(defun lua-send-buffer ()
+ "Send whole buffer to Lua process."
+ (interactive)
+ (lua-send-region (point-min) (point-max)))
+
+(defun lua-restart-with-whole-file ()
+ "Restart Lua process and send whole file as input."
+ (interactive)
+ (lua-kill-process)
+ (lua-send-buffer))
+
+(defun lua-show-process-buffer ()
+ "Make sure `lua-process-buffer' is being displayed.
+Create a Lua process if one doesn't already exist."
+ (interactive)
+ (display-buffer (process-buffer (lua-get-create-process))))
+
+(defun lua-hide-process-buffer ()
+ "Delete all windows that display `lua-process-buffer'."
+ (interactive)
+ (when (buffer-live-p lua-process-buffer)
+ (delete-windows-on lua-process-buffer)))
+
+(defun lua--funcname-char-p (c)
+ "Check if character C is part of a function name.
+Return nil if C is nil. See `lua-funcname-at-point'."
+ (and c (string-match-p "\\`[A-Za-z_.]\\'" (string c))))
+
+(defun lua-funcname-at-point ()
+ "Get current Name { '.' Name } sequence."
+ (when (or (lua--funcname-char-p (char-before))
+ (lua--funcname-char-p (char-after)))
+ (save-excursion
+ (save-match-data
+ (re-search-backward "\\`\\|[^A-Za-z_.]")
+ ;; NOTE: `point' will be either at the start of the buffer or on
+ ;; a non-symbol character.
+ (re-search-forward "\\([A-Za-z_]+\\(?:\\.[A-Za-z_]+\\)*\\)")
+ (match-string-no-properties 1)))))
+
+(defun lua-search-documentation ()
+ "Search Lua documentation for the word at the point."
+ (interactive)
+ (let ((url (concat lua-documentation-url "#pdf-" (lua-funcname-at-point))))
+ (funcall lua-documentation-function url)))
+
+(defun lua-toggle-electric-state (&optional arg)
+ "Toggle the electric indentation feature.
+Optional numeric ARG, if supplied, turns on electric indentation when
+positive, turns it off when negative, and just toggles it when zero or
+left out."
+ (interactive "P")
+ (let ((num_arg (prefix-numeric-value arg)))
+ (setq lua-electric-flag (cond ((or (null arg)
+ (zerop num_arg))
+ (not lua-electric-flag))
+ ((< num_arg 0) nil)
+ ((> num_arg 0) t))))
+ (message "%S" lua-electric-flag))
+
+(defun lua-forward-sexp (&optional count)
+ "Forward to block end.
+A positive integer argument COUNT means to forward that many times."
+ (interactive "p")
+ (unless (or (not count) (>= count 0))
+ (error "Negative offsets not supported"))
+ (save-match-data
+ (let ((count (or count 1))
+ (block-start (mapcar 'car lua-sexp-alist)))
+ (while (> count 0)
+ ;; Skip whitespace
+ (skip-chars-forward " \t\n")
+ (if (looking-at (regexp-opt block-start 'words))
+ (let ((keyword (match-string 1)))
+ (lua-find-matching-token-word keyword 'forward))
+ ;; If the current keyword is not a "begin" keyword, then just
+ ;; perform the normal forward-sexp.
+ (forward-sexp 1))
+ (setq count (1- count))))))
+
+;; Flymake integration
+
+(defcustom lua-luacheck-program "luacheck"
+ "Name of the luacheck executable."
+ :type 'string
+ :version "31.1")
+
+(defvar-local lua--flymake-process nil)
+
+(defun lua-flymake (report-fn &rest _args)
+ "Flymake backend using the luacheck program.
+Takes a Flymake callback REPORT-FN as argument, as expected of a
+member of `flymake-diagnostic-functions'."
+ (when (process-live-p lua--flymake-process)
+ (kill-process lua--flymake-process))
+ (let ((source (current-buffer)))
+ (save-restriction
+ (widen)
+ (setq lua--flymake-process
+ (make-process
+ :name "luacheck" :noquery t :connection-type 'pipe
+ :buffer (generate-new-buffer " *flymake-luacheck*")
+ :command `(,lua-luacheck-program
+ "--codes" "--ranges" "--formatter" "plain" "-")
+ :sentinel
+ (lambda (proc _event)
+ (when (eq 'exit (process-status proc))
+ (unwind-protect
+ (if (with-current-buffer source
+ (eq proc lua--flymake-process))
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-min))
+ (cl-loop
+ while (search-forward-regexp
+ "^\\([^:]*\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\): \\(.*\\)$"
+ nil t)
+ for line = (string-to-number (match-string 2))
+ for col1 = (string-to-number (match-string 3))
+ for col2 = (1+ (string-to-number (match-string 4)))
+ for msg = (match-string 5)
+ for type = (if (string-match-p "\\`(E" msg) :error :warning)
+ collect (flymake-make-diagnostic source
+ (cons line col1)
+ (cons line col2)
+ type
+ msg)
+ into diags
+ finally (funcall report-fn diags)))
+ (flymake-log :warning "Canceling obsolete check %s" proc))
+ (kill-buffer (process-buffer proc)))))))
+ (process-send-region lua--flymake-process (point-min) (point-max))
+ (process-send-eof lua--flymake-process))))
+
+;; Menu bar
+
+(easy-menu-define lua-mode-menu lua-mode-map
+ "Menu bar entry for `lua-mode'."
+ `("Lua"
+ ["Search Documentation" lua-search-documentation]
+ ["Send Buffer" lua-send-buffer]
+ ["Send Proc" lua-send-proc]
+ ["Send Region" lua-send-region]
+ ["Send Current Line" lua-send-current-line]
+ ["Set Lua-Region Start" lua-set-lua-region-start]
+ ["Set Lua-Region End" lua-set-lua-region-end]
+ ["Send Lua-Region" lua-send-lua-region]
+ ["Beginning Of Proc" lua-beginning-of-proc]
+ ["End Of Proc" lua-end-of-proc]
+ ["Show Process Buffer" lua-show-process-buffer]
+ ["Hide Process Buffer" lua-hide-process-buffer]
+ ["Kill Process" lua-kill-process]
+ ["Restart With Whole File" lua-restart-with-whole-file]))
+
+(provide 'lua-mode)
+
+;;; lua-mode.el ends here
diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el
index 07a8f0aef55..35700255ba4 100644
--- a/lisp/progmodes/lua-ts-mode.el
+++ b/lisp/progmodes/lua-ts-mode.el
@@ -168,10 +168,13 @@ values of OVERRIDE."
(let* ((node-start (treesit-node-start node))
(node-end (treesit-node-end node))
(node-text (treesit-node-text node t))
- (delimiter-end (+ 2 node-start)))
+ (delimiter-end (progn
+ (goto-char node-start)
+ (while (looking-at-p "-") (forward-char))
+ (point))))
(when (and (>= node-start start)
(<= delimiter-end end)
- (string-match "\\`--" node-text))
+ (string-match "\\`---*" node-text))
(treesit-fontify-with-override node-start
delimiter-end
'font-lock-comment-delimiter-face
@@ -769,20 +772,9 @@ Calls REPORT-FN directly."
(derived-mode-add-parents 'lua-ts-mode '(lua-mode))
-;;;###autoload
-(defun lua-ts-mode-maybe ()
- "Enable `lua-ts-mode' when its grammar is available."
- (if (or (treesit-language-available-p 'lua)
- (eq treesit-enabled-modes t)
- (memq 'lua-ts-mode treesit-enabled-modes))
- (lua-ts-mode)
- (fundamental-mode)))
-
;;;###autoload
(when (treesit-available-p)
- (add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-ts-mode-maybe))
- (add-to-list 'interpreter-mode-alist '("\\") 'previous-buffer)
+ (keymap-set ctl-x-map "" #'tab-line-switch-to-prev-tab))
+ (when (eq (keymap-lookup ctl-x-map "C-") 'previous-buffer)
+ (keymap-set ctl-x-map "C-" #'tab-line-switch-to-prev-tab))
+ (unless (keymap-lookup ctl-x-map "M-")
+ (keymap-set ctl-x-map "M-" #'tab-line-move-tab-backward))
+ (when (eq (keymap-lookup ctl-x-map "") 'next-buffer)
+ (keymap-set ctl-x-map "" #'tab-line-switch-to-next-tab))
+ (when (eq (keymap-lookup ctl-x-map "C-") 'next-buffer)
+ (keymap-set ctl-x-map "C-" #'tab-line-switch-to-next-tab))
+ (unless (keymap-lookup ctl-x-map "M-")
+ (keymap-set ctl-x-map "M-" #'tab-line-move-tab-forward))))
+
+(defun tab-line--undefine-keys ()
+ "Uninstall key bindings previously bound by `tab-line--define-keys'."
+ (when tab-line-define-keys
+ (when (eq (keymap-lookup ctl-x-map "") 'tab-line-switch-to-prev-tab)
+ (keymap-set ctl-x-map "" #'previous-buffer))
+ (when (eq (keymap-lookup ctl-x-map "C-") 'tab-line-switch-to-prev-tab)
+ (keymap-set ctl-x-map "C-" #'previous-buffer))
+ (when (eq (keymap-lookup ctl-x-map "M-") 'tab-line-move-tab-backward)
+ (keymap-set ctl-x-map "M-" nil))
+ (when (eq (keymap-lookup ctl-x-map "") 'tab-line-switch-to-next-tab)
+ (keymap-set ctl-x-map "" #'next-buffer))
+ (when (eq (keymap-lookup ctl-x-map "C-") 'tab-line-switch-to-next-tab)
+ (keymap-set ctl-x-map "C-" #'next-buffer))
+ (when (eq (keymap-lookup ctl-x-map "M-") 'tab-line-move-tab-forward)
+ (keymap-set ctl-x-map "M-" nil))))
+
(defvar-keymap tab-line-mode-map
- :doc "Keymap for keys of `tab-line-mode'."
- "C-x " #'tab-line-switch-to-prev-tab
- "C-x C-" #'tab-line-switch-to-prev-tab
- "C-x M-" #'tab-line-move-tab-backward
- "C-x " #'tab-line-switch-to-next-tab
- "C-x C-" #'tab-line-switch-to-next-tab
- "C-x M-" #'tab-line-move-tab-forward)
+ :doc "Keymap for keys of `tab-line-mode'.")
(defvar-keymap tab-line-switch-repeat-map
:doc "Keymap to repeat tab/buffer cycling. Used in `repeat-mode'."
@@ -1374,7 +1414,10 @@ of `tab-line-exclude', are exempt from `tab-line-mode'."
(define-globalized-minor-mode global-tab-line-mode
tab-line-mode tab-line-mode--turn-on
:group 'tab-line
- :version "27.1")
+ :version "27.1"
+ (if global-tab-line-mode
+ (tab-line--define-keys)
+ (tab-line--undefine-keys)))
(global-set-key [tab-line down-mouse-3] 'tab-line-context-menu)
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 0a02aedfa4f..ffecc86cbe0 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1917,6 +1917,7 @@ can also be used to fill comments.
;;;###autoload
(when (treesit-available-p)
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(css-mode . css-ts-mode)))
diff --git a/lisp/textmodes/markdown-ts-mode.el b/lisp/textmodes/markdown-ts-mode.el
index 4af80f80b5f..4929f2d91ee 100644
--- a/lisp/textmodes/markdown-ts-mode.el
+++ b/lisp/textmodes/markdown-ts-mode.el
@@ -307,25 +307,6 @@ the same features enabled in MODE."
:range-fn #'treesit-range-fn-exclude-children
'((inline) @markdown-inline)
- :embed 'yaml
- :host 'markdown
- :local t
- '((minus_metadata) @yaml)
-
- :embed 'toml
- :host 'markdown
- :local t
- '((plus_metadata) @toml)
-
- :embed 'html
- :host 'markdown
- :local t
- '((html_block) @html)
-
- :embed 'html
- :host 'markdown-inline
- '((html_tag) @html)
-
:embed #'markdown-ts--convert-code-block-language
:host 'markdown
:local t
@@ -350,7 +331,18 @@ the same features enabled in MODE."
(setq-local treesit-font-lock-feature-list
(treesit-merge-font-lock-feature-list
treesit-font-lock-feature-list
- html-ts-mode--treesit-font-lock-feature-list)))
+ html-ts-mode--treesit-font-lock-feature-list))
+ (setq-local treesit-range-settings
+ (append treesit-range-settings
+ (treesit-range-rules
+ :embed 'html
+ :host 'markdown
+ :local t
+ '((html_block) @html)
+
+ :embed 'html
+ :host 'markdown-inline
+ '((html_tag) @html)))))
(when (treesit-ready-p 'yaml t)
(require 'yaml-ts-mode)
@@ -362,7 +354,14 @@ the same features enabled in MODE."
(setq-local treesit-font-lock-feature-list
(treesit-merge-font-lock-feature-list
treesit-font-lock-feature-list
- yaml-ts-mode--font-lock-feature-list)))
+ yaml-ts-mode--font-lock-feature-list))
+ (setq-local treesit-range-settings
+ (append treesit-range-settings
+ (treesit-range-rules
+ :embed 'yaml
+ :host 'markdown
+ :local t
+ '((minus_metadata) @yaml)))))
(when (treesit-ready-p 'toml t)
(require 'toml-ts-mode)
@@ -374,7 +373,14 @@ the same features enabled in MODE."
(setq-local treesit-font-lock-feature-list
(treesit-merge-font-lock-feature-list
treesit-font-lock-feature-list
- toml-ts-mode--font-lock-feature-list)))
+ toml-ts-mode--font-lock-feature-list))
+ (setq-local treesit-range-settings
+ (append treesit-range-settings
+ (treesit-range-rules
+ :embed 'toml
+ :host 'markdown
+ :local t
+ '((plus_metadata) @toml)))))
(treesit-major-mode-setup))
@@ -405,7 +411,10 @@ the same features enabled in MODE."
;;;###autoload
(defun markdown-ts-mode-maybe ()
- "Enable `markdown-ts-mode' when its grammar is available."
+ "Enable `markdown-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name."
+ (declare-function treesit-language-available-p "treesit.c")
(if (or (treesit-language-available-p 'markdown)
(eq treesit-enabled-modes t)
(memq 'markdown-ts-mode treesit-enabled-modes))
@@ -416,6 +425,7 @@ the same features enabled in MODE."
(when (treesit-available-p)
(add-to-list 'auto-mode-alist '("\\.md\\'" . markdown-ts-mode-maybe))
;; To be able to toggle between an external package and core ts-mode:
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(markdown-mode . markdown-ts-mode)))
diff --git a/lisp/textmodes/mhtml-ts-mode.el b/lisp/textmodes/mhtml-ts-mode.el
index be3873e848a..793e28ed0de 100644
--- a/lisp/textmodes/mhtml-ts-mode.el
+++ b/lisp/textmodes/mhtml-ts-mode.el
@@ -589,6 +589,7 @@ Powered by tree-sitter."
;;;###autoload
(when (treesit-available-p)
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(mhtml-mode . mhtml-ts-mode)))
diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el
index 511a6b5f8ed..f85ded35968 100644
--- a/lisp/textmodes/toml-ts-mode.el
+++ b/lisp/textmodes/toml-ts-mode.el
@@ -174,6 +174,7 @@ Return nil if there is no name or if NODE is not a defun node."
;;;###autoload
(when (treesit-available-p)
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(conf-toml-mode . toml-ts-mode)))
diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el
index 95c9c1abd7d..61c70340f8e 100644
--- a/lisp/textmodes/yaml-ts-mode.el
+++ b/lisp/textmodes/yaml-ts-mode.el
@@ -229,7 +229,10 @@ Return nil if there is no name or if NODE is not a defun node."
;;;###autoload
(defun yaml-ts-mode-maybe ()
- "Enable `yaml-ts-mode' when its grammar is available."
+ "Enable `yaml-ts-mode' when its grammar is available.
+Also propose to install the grammar when `treesit-enabled-modes'
+is t or contains the mode name."
+ (declare-function treesit-language-available-p "treesit.c")
(if (or (treesit-language-available-p 'yaml)
(eq treesit-enabled-modes t)
(memq 'yaml-ts-mode treesit-enabled-modes))
@@ -240,6 +243,7 @@ Return nil if there is no name or if NODE is not a defun node."
(when (treesit-available-p)
(add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode-maybe))
;; To be able to toggle between an external package and core ts-mode:
+ (defvar treesit-major-mode-remap-alist)
(add-to-list 'treesit-major-mode-remap-alist
'(yaml-mode . yaml-ts-mode)))
diff --git a/lisp/treesit-x.el b/lisp/treesit-x.el
index 65845ed0ac0..308e2c23f8c 100644
--- a/lisp/treesit-x.el
+++ b/lisp/treesit-x.el
@@ -155,16 +155,21 @@ of `define-treesit-generic-mode'.
(defvar treesit-generic-mode-font-lock-map
'(
+ ("@attribute" . "@font-lock-preprocessor-face")
("@boolean" . "@font-lock-constant-face")
("@comment" . "@font-lock-comment-face")
+ ("@constructor" . "@font-lock-type-face")
("@constant" . "@font-lock-constant-face")
+ ("@constant.builtin" . "@font-lock-builtin-face")
("@delimiter" . "@font-lock-delimiter-face")
("@error" . "@font-lock-warning-face")
("@escape" . "@font-lock-escape-face")
("@function" . "@font-lock-function-name-face")
+ ("@function.builtin" . "@font-lock-builtin-face")
("@function.call" . "@font-lock-function-call-face")
("@keyword" . "@font-lock-keyword-face")
("@keyword.operator" . "@font-lock-operator-face")
+ ("@module" . "@font-lock-keyword-face")
("@number" . "@font-lock-number-face")
("@operator" . "@font-lock-operator-face")
("@property" . "@font-lock-property-name-face")
@@ -174,9 +179,11 @@ of `define-treesit-generic-mode'.
("@string" . "@font-lock-string-face")
("@string.regexp" . "@font-lock-regexp-face")
("@string.special" . "@font-lock-string-face")
+ ("@tag" . "@font-lock-function-name-face")
("@tag.delimiter" . "@font-lock-delimiter-face")
("@text.reference" . "@font-lock-doc-face")
("@type" . "@font-lock-type-face")
+ ("@type.builtin" . "@font-lock-builtin-face")
("@variable" . "@font-lock-variable-name-face")
("@variable.builtin" . "@font-lock-builtin-face")
("@variable.parameter" . "@font-lock-variable-name-face")
diff --git a/lisp/treesit.el b/lisp/treesit.el
index ecdcf0b5551..36d6c875d45 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -5404,13 +5404,19 @@ Tree-sitter grammar for `%s' is missing; install it?"
;;;###autoload
(defcustom treesit-enabled-modes nil
- "Specify what treesit modes to enable by default.
+ "Specify which tree-sitter based major modes to enable by default.
The value can be either a list of ts-modes to enable,
-or t to enable all ts-modes."
+or t to enable all ts-modes. The value nil (the default)
+means not to enable any tree-sitter based modes.
+
+Enabling a tree-stter based mode means that visiting files in the
+corresponding programming language will automatically turn on that
+mode, instead of any non-tree-sitter based modes for the same
+language."
:type `(choice
- (const :tag "Disable all automatic associations" nil)
- (const :tag "Enable all available ts-modes" t)
- (set :tag "List of enabled ts-modes"
+ (const :tag "Disable all tree-sitter modes" nil)
+ (const :tag "Enable all available tree-sitter modes" t)
+ (set :tag "Enable specific tree-sitter modes"
,@(when (treesit-available-p)
(sort (mapcar (lambda (m) `(function-item ,m))
(seq-uniq (mapcar #'cdr treesit-major-mode-remap-alist)))))))
@@ -5419,9 +5425,9 @@ or t to enable all ts-modes."
(set-default sym val)
(when (treesit-available-p)
(dolist (m treesit-major-mode-remap-alist)
- (setq major-mode-remap-alist
- (if (or (eq val t) (memq (cdr m) val))
- (cons m major-mode-remap-alist)
+ (if (or (eq val t) (memq (cdr m) val))
+ (add-to-list 'major-mode-remap-alist m)
+ (setq major-mode-remap-alist
(delete m major-mode-remap-alist))))))
:version "31.1")
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 965ab861e05..c33263f5f4a 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -1642,6 +1642,7 @@ In read-only buffers the following bindings are also available:
(add-hook 'font-lock-mode-hook #'diff--font-lock-cleanup nil 'local)
(setq-local imenu-generic-expression
diff-imenu-generic-expression)
+ (setq-local project-find-matching-buffer-function #'diff-find-matching-buffer)
;; These are not perfect. They would be better done separately for
;; context diffs and unidiffs.
;; (setq-local paragraph-start
@@ -3358,6 +3359,28 @@ hunk text is not found in the source file."
)
str)
+(declare-function project-root "project")
+
+(defun diff-find-matching-buffer (current-project mirror-project)
+ "Change default directory to matching one under another project.
+CURRENT-PROJECT is the project instance for the current project.
+MIRROR-PROJECT is the project instance for the project to visit.
+A matching directory has the same name relative to the project root.
+If a matching directory does not exist in the other project, it is an
+error (this avoids invalidating the relative file names in Diff mode
+file headers).
+
+This function is intended to be used as the value of
+`project-find-matching-buffer-function' in Diff mode buffers."
+ (let* ((mirror-root (project-root mirror-project))
+ (relative-name (file-relative-name default-directory
+ (project-root current-project)))
+ (mirror-name (expand-file-name relative-name mirror-root)))
+ (if (file-directory-p mirror-name)
+ (message "Default directory changed to `%s'"
+ (setq default-directory mirror-name))
+ (user-error "`%s' not found in `%s'" relative-name mirror-root))))
+
;;; Support for converting a diff to diff3 markers via `wiggle'.
;; Wiggle can be found at https://neil.brown.name/wiggle/ or in your nearest
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index f345a1b2779..df8005309ce 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -817,27 +817,27 @@ If LIMIT is non-nil, show no more than this many entries."
(buffer-substring (match-end 0) (point-max)))))
;; FIXME: Implement `vc-bzr-mergebase' and then delete this.
-(defun vc-bzr-log-incoming (buffer remote-location)
+(defun vc-bzr-log-incoming (buffer upstream-location)
(apply #'vc-bzr-command "missing" buffer 'async nil
- (list "--theirs-only" (and (not (string-empty-p remote-location))
- remote-location))))
+ (list "--theirs-only" (and (not (string-empty-p upstream-location))
+ upstream-location))))
-(defun vc-bzr-incoming-revision (remote-location)
+(defun vc-bzr-incoming-revision (upstream-location &optional _refresh)
(with-temp-buffer
(vc-bzr-command "missing" t 1 nil
"--log-format=long" "--show-ids"
"--theirs-only" "-r-1.."
- (and (not (string-empty-p remote-location))
- remote-location))
+ (and (not (string-empty-p upstream-location))
+ upstream-location))
(goto-char (point-min))
(and (re-search-forward "^revision-id: " nil t)
(buffer-substring (point) (pos-eol)))))
;; FIXME: Implement `vc-bzr-mergebase' and then delete this.
-(defun vc-bzr-log-outgoing (buffer remote-location)
+(defun vc-bzr-log-outgoing (buffer upstream-location)
(apply #'vc-bzr-command "missing" buffer 'async nil
- (list "--mine-only" (and (not (string-empty-p remote-location))
- remote-location))))
+ (list "--mine-only" (and (not (string-empty-p upstream-location))
+ upstream-location))))
(defun vc-bzr-show-log-entry (revision)
"Find entry for patch name REVISION in bzr change log buffer."
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index b5da03764d1..5e2f0e5bb20 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -70,7 +70,7 @@
;; - get-change-comment (files rev) OK
;; HISTORY FUNCTIONS
;; * print-log (files buffer &optional shortlog start-revision limit) OK
-;; * incoming-revision (remote-location) OK
+;; * incoming-revision (upstream-location &optional refresh) OK
;; - log-search (buffer pattern) OK
;; - log-view-mode () OK
;; - show-log-entry (revision) OK
@@ -1605,19 +1605,20 @@ If LIMIT is a non-empty string, use it as a base revision."
start-revision))
'("--")))))))
-(defun vc-git-incoming-revision (remote-location)
- (vc-git-command nil 0 nil "fetch"
- (and (not (string-empty-p remote-location))
- ;; Extract remote from "remote/branch".
- (replace-regexp-in-string "/.*" ""
- remote-location)))
- (ignore-errors ; in order to return nil if no such branch
- (with-output-to-string
- (vc-git-command standard-output 0 nil
- "log" "--max-count=1" "--pretty=format:%H"
- (if (string-empty-p remote-location)
- "@{upstream}"
- remote-location)))))
+(defun vc-git-incoming-revision (upstream-location &optional refresh)
+ (let ((rev (if (string-empty-p upstream-location)
+ "@{upstream}"
+ upstream-location)))
+ (when (or refresh (null (vc-git--rev-parse rev)))
+ (vc-git-command nil 0 nil "fetch"
+ (and (not (string-empty-p upstream-location))
+ ;; Extract remote from "remote/branch".
+ (replace-regexp-in-string "/.*" ""
+ upstream-location))))
+ (ignore-errors ; in order to return nil if no such branch
+ (with-output-to-string
+ (vc-git-command standard-output 0 nil
+ "log" "--max-count=1" "--pretty=format:%H" rev)))))
(defun vc-git-log-search (buffer pattern)
"Search the log of changes for PATTERN and output results into BUFFER.
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index e9095b72098..32725f6b5fb 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1213,11 +1213,18 @@ It is based on `log-edit-mode', and has Hg-specific extensions.")
(defalias 'vc-hg-async-checkins #'always)
-(defun vc-hg-checkin (files comment &optional _rev)
- "Hg-specific version of `vc-BACKEND-checkin'.
-REV is ignored."
+(defun vc-hg--checkin (comment &optional files patch-string)
+ "Workhorse routine for `vc-hg-checkin' and `vc-hg-checkin-patch'.
+COMMENT is the commit message.
+For a regular checkin, FILES is the list of files to check in.
+To check in a patch, PATCH-STRING is the patch text.
+It is an error to supply both or neither."
+ (unless (xor files patch-string)
+ (error "Invalid call to `vc-hg--checkin'"))
(let* ((args (vc-hg--extract-headers comment))
- (file1 (or (car files) default-directory))
+ (temps-dir (or (file-name-directory (or (car files)
+ default-directory))
+ default-directory))
(msg-file
;; On MS-Windows, pass the commit log message through a file,
;; to work around the limitation that command-line arguments
@@ -1225,30 +1232,53 @@ REV is ignored."
;; support non-ASCII characters in the log message.
;; Also handle remote files.
(and (eq system-type 'windows-nt)
- (let ((default-directory (or (file-name-directory file1)
- default-directory)))
- (make-nearby-temp-file "hg-msg")))))
- (when msg-file
- (let ((coding-system-for-write 'utf-8))
- (write-region (car args) nil msg-file)))
+ (let ((default-directory temps-dir))
+ (make-nearby-temp-file "hg-msg"))))
+ (patch-file (and patch-string
+ (let ((default-directory temps-dir))
+ (make-nearby-temp-file "hg-patch")))))
+ (let ((coding-system-for-write 'utf-8))
+ (when msg-file
+ (write-region (car args) nil msg-file))
+ (when patch-file
+ (write-region patch-string nil patch-file)))
(let ((coding-system-for-write
;; On MS-Windows, we must encode command-line arguments in
;; the system codepage.
(if (eq system-type 'windows-nt)
locale-coding-system
coding-system-for-write))
- (args (if msg-file
- (cl-list* "commit" "-A" "-l" (file-local-name msg-file)
- (cdr args))
- (cl-list* "commit" "-A" "-m" args)))
+ (args
+ (nconc (if patch-file
+ (list "import" "--bypass" patch-file)
+ (list "commit" "-A"))
+ (if msg-file
+ (cl-list* "-l" (file-local-name msg-file) (cdr args))
+ (cl-list* "-m" args))))
(post (lambda ()
(when (and msg-file (file-exists-p msg-file))
- (delete-file msg-file)))))
+ (delete-file msg-file))
+ (when (and patch-file (file-exists-p patch-file))
+ (delete-file patch-file))
+ ;; When committing a patch we run 'hg import' and
+ ;; then 'hg update'. We have 'hg update' here in the
+ ;; always-synchronous `post' function because we
+ ;; assume that 'hg import' is the one that might be
+ ;; slow and so benefits most from `vc-async-checkin'.
+ ;; If in fact both the 'hg import' and the 'hg
+ ;; update' can be slow, then we need to make both of
+ ;; them part of the async command, possibly by
+ ;; writing out a tiny shell script (bug#79235).
+ (when patch-file
+ (vc-hg-command nil 0 nil "update" "--merge"
+ "--tool" "internal:local" "tip")))))
(if vc-async-checkin
(let ((buffer (vc-hg--async-buffer)))
(vc-wait-for-process-before-save
(apply #'vc-hg--async-command buffer (nconc args files))
- "Finishing checking in files...")
+ (if patch-file
+ "Finishing checking in patch...."
+ "Finishing checking in files..."))
(with-current-buffer buffer
(vc-run-delayed
(vc-compilation-mode 'hg)
@@ -1258,31 +1288,14 @@ REV is ignored."
(apply #'vc-hg-command nil 0 files args)
(funcall post)))))
-;; FIXME: Needs MS-Windows encoding issues handling.
-;; Possibly we want fix this by merging this function into the preceeding one.
-;; Figure out resolution of #79235 first.
+(defun vc-hg-checkin (files comment &optional _rev)
+ "Hg-specific version of `vc-BACKEND-checkin'.
+REV is ignored."
+ (vc-hg--checkin comment files nil))
+
(defun vc-hg-checkin-patch (patch-string comment)
- (let ((patch-file (make-nearby-temp-file "hg-patch")))
- (write-region patch-string nil patch-file)
- (unwind-protect
- (let ((args (list "update"
- "--merge" "--tool" "internal:local"
- "tip")))
- (apply #'vc-hg-command nil 0 nil
- (nconc (list "import" "--bypass" patch-file "-m")
- (vc-hg--extract-headers comment)))
- (if vc-async-checkin
- (let ((buffer (vc-hg--async-buffer)))
- (vc-wait-for-process-before-save
- (apply #'vc-hg--async-command buffer args)
- "Finishing checking in patch....")
- (with-current-buffer buffer
- (vc-run-delayed
- (vc-compilation-mode 'hg)))
- (vc-set-async-update buffer)
- (list 'async (get-buffer-process buffer)))
- (apply #'vc-hg-command nil 0 nil args)))
- (delete-file patch-file))))
+ "Hg-specific version of `vc-BACKEND-checkin-patch'."
+ (vc-hg--checkin comment nil patch-string))
(defun vc-hg--extract-headers (comment)
(log-edit-extract-headers `(("Author" . "--user")
@@ -1518,19 +1531,19 @@ This runs the command \"hg summary\"."
(nreverse result))
"\n"))))
-(defun vc-hg-incoming-revision (remote-location)
- (let* ((remote-location (if (string-empty-p remote-location)
+(defun vc-hg-incoming-revision (upstream-location &optional _refresh)
+ (let* ((upstream-location (if (string-empty-p upstream-location)
"default"
- remote-location))
+ upstream-location))
;; Use 'hg identify' like this, and not 'hg incoming', because
;; this will give a sensible answer regardless of whether the
;; incoming revision has been pulled yet.
(rev (with-output-to-string
(vc-hg-command standard-output 0 nil "identify" "--id"
- remote-location "--template={node}"))))
+ upstream-location "--template={node}"))))
(condition-case _ (vc-hg-command nil 0 nil "log" "-r" rev)
;; We don't have the revision locally. Pull it.
- (error (vc-hg-command nil 0 nil "pull" remote-location)))
+ (error (vc-hg-command nil 0 nil "pull" upstream-location)))
rev))
(defun vc-hg-mergebase (rev1 &optional rev2)
@@ -1738,7 +1751,10 @@ Intended for use via the `vc-hg--async-command' wrapper."
(if (file-exists-p our-sp)
(with-temp-buffer
(insert-file-contents-literally our-sp)
- (setq our-store (string-trim (buffer-string)))
+ ;; On MS-Windows, ".hg/sharedpath" gives file names with
+ ;; backslashes; expand-file-name normalizes that to forward
+ ;; slashes, needed for 'equal' comparison below.
+ (setq our-store (expand-file-name (string-trim (buffer-string))))
(push (abbreviate-file-name (file-name-directory our-store))
shares))
(setq our-store (expand-file-name ".hg" our-root)))
@@ -1748,7 +1764,9 @@ Intended for use via the `vc-hg--async-command' wrapper."
((file-exists-p sp)))
(with-temp-buffer
(insert-file-contents-literally sp)
- (when (equal our-store (buffer-string))
+ (when (equal our-store
+ ;; See above why we use expand-file-name
+ (expand-file-name (string-trim (buffer-string))))
(push root shares)))))
shares))
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 7d46f9f0ee3..999bf279fba 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -952,6 +952,8 @@ In the latter case, VC mode is deactivated for this buffer."
"O" #'vc-log-outgoing
"M L" #'vc-log-mergebase
"M D" #'vc-diff-mergebase
+ "B =" #'vc-diff-outgoing-base
+ "B D" #'vc-root-diff-outgoing-base
"m" #'vc-merge
"r" #'vc-retrieve-tag
"s" #'vc-create-tag
@@ -976,9 +978,11 @@ In the latter case, VC mode is deactivated for this buffer."
(defvar-keymap vc-incoming-prefix-map
"L" #'vc-log-incoming
+ "=" #'vc-diff-incoming
"D" #'vc-root-diff-incoming)
(defvar-keymap vc-outgoing-prefix-map
"L" #'vc-log-outgoing
+ "=" #'vc-diff-outgoing
"D" #'vc-root-diff-outgoing)
(defcustom vc-use-incoming-outgoing-prefixes nil
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 5d8c3f1eeb8..8b918654242 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -396,25 +396,28 @@
;; revision shown, rather than the working revision, which is normally
;; the case). Not all backends support this.
;;
-;; - log-outgoing (buffer remote-location) (DEPRECATED)
+;; - log-outgoing (buffer upstream-location) (DEPRECATED)
;;
;; Insert in BUFFER the revision log for the changes that will be
-;; sent when performing a push operation to REMOTE-LOCATION.
+;; sent when performing a push operation to UPSTREAM-LOCATION.
;; Deprecated: implement incoming-revision and mergebase instead.
;;
-;; - log-incoming (buffer remote-location) (DEPRECATED)
+;; - log-incoming (buffer upstream-location) (DEPRECATED)
;;
;; Insert in BUFFER the revision log for the changes that will be
-;; received when performing a pull operation from REMOTE-LOCATION.
+;; received when performing a pull operation from UPSTREAM-LOCATION.
;; Deprecated: implement incoming-revision and mergebase instead.
;;
-;; * incoming-revision (remote-location)
+;; * incoming-revision (upstream-location &optional refresh)
;;
-;; Return revision at the head of the branch at REMOTE-LOCATION.
+;; Return revision at the head of the branch at UPSTREAM-LOCATION.
;; If there is no such branch there, return nil. (Should signal an
;; error, not return nil, in the case that fetching data fails.)
;; For a distributed VCS, should also fetch that revision into local
;; storage for operating on by subsequent calls into the backend.
+;; The backend may rely on cached information from a previous fetch
+;; from UPSTREAM-LOCATION unless REFRESH is non-nil, which means that
+;; the most up-to-date information possible is required.
;;
;; - log-search (buffer pattern)
;;
@@ -2456,9 +2459,8 @@ state of each file in the fileset."
(when (and (not rev1) rev2)
(error "Not a valid revision range"))
(vc--with-backend-in-rootdir "VC root-diff"
- (let ((default-directory rootdir))
- (vc-diff-internal vc-allow-async-diff (list backend (list rootdir)) rev1 rev2
- (called-interactively-p 'interactive)))))
+ (vc-diff-internal vc-allow-async-diff (list backend (list rootdir)) rev1 rev2
+ (called-interactively-p 'interactive))))
;;;###autoload
(defun vc-diff (&optional historic not-essential fileset)
@@ -2531,37 +2533,77 @@ The merge base is a common ancestor between REV1 and REV2 revisions."
(when (and (not rev1) rev2)
(error "Not a valid revision range"))
(vc--with-backend-in-rootdir "VC root-diff"
- (let ((default-directory rootdir)
- (rev1 (vc-call-backend backend 'mergebase rev1 rev2)))
+ (let ((rev1 (vc-call-backend backend 'mergebase rev1 rev2)))
(vc-diff-internal
vc-allow-async-diff (list backend (list rootdir)) rev1 rev2
(called-interactively-p 'interactive)))))
;;;###autoload
-(defun vc-root-diff-incoming (&optional remote-location)
- "Report diff of all changes that would be pulled from REMOTE-LOCATION.
-When unspecified REMOTE-LOCATION is the place \\[vc-update] would pull from.
-When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
-In some version control systems REMOTE-LOCATION can be a remote branch name.
+(defun vc-root-diff-incoming (&optional upstream-location)
+ "Report diff of all changes that would be pulled from UPSTREAM-LOCATION.
+When unspecified UPSTREAM-LOCATION is the place \\[vc-update] would pull
+from. When called interactively with a prefix argument, prompt for
+UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION
+can be a remote branch name.
See `vc-use-incoming-outgoing-prefixes' regarding giving this command a
global binding."
- (interactive (vc--maybe-read-remote-location))
+ (interactive (list (vc--maybe-read-upstream-location)))
(vc--with-backend-in-rootdir "VC root-diff"
- (let ((default-directory rootdir)
- (incoming (vc--incoming-revision backend
- (or remote-location ""))))
- (vc-diff-internal vc-allow-async-diff (list backend (list rootdir))
- (vc-call-backend backend 'mergebase incoming)
- incoming
- (called-interactively-p 'interactive)))))
+ (vc-diff-incoming upstream-location `(,backend (,rootdir)))))
;;;###autoload
-(defun vc-root-diff-outgoing (&optional remote-location)
- "Report diff of all changes that would be pushed to REMOTE-LOCATION.
-When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to.
-When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
-In some version control systems REMOTE-LOCATION can be a remote branch name.
+(defun vc-diff-incoming (&optional upstream-location fileset)
+ "Report changes to VC fileset that would be pulled from UPSTREAM-LOCATION.
+When unspecified UPSTREAM-LOCATION is the place \\[vc-update] would pull
+from. When called interactively with a prefix argument, prompt for
+UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION
+can be a remote branch name.
+When called from Lisp optional argument FILESET overrides the VC
+fileset.
+
+See `vc-use-incoming-outgoing-prefixes' regarding giving this command a
+global binding."
+ (interactive (list (vc--maybe-read-upstream-location) nil))
+ (let* ((fileset (or fileset (vc-deduce-fileset t)))
+ (backend (car fileset))
+ (incoming (vc--incoming-revision backend
+ (or upstream-location "")
+ 'refresh)))
+ (vc-diff-internal vc-allow-async-diff fileset
+ (vc-call-backend backend 'mergebase incoming)
+ incoming
+ (called-interactively-p 'interactive))))
+
+;;;###autoload
+(defun vc-root-diff-outgoing (&optional upstream-location)
+ "Report diff of all changes that would be pushed to UPSTREAM-LOCATION.
+When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push
+to. When called interactively with a prefix argument, prompt for
+UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION
+can be a remote branch name.
+
+This command is like `vc-root-diff-outgoing-base' except that it does
+not include uncommitted changes.
+
+See `vc-use-incoming-outgoing-prefixes' regarding giving this command a
+global binding."
+ (interactive (list (vc--maybe-read-upstream-location)))
+ (vc--with-backend-in-rootdir "VC root-diff"
+ (vc-diff-outgoing upstream-location `(,backend (,rootdir)))))
+
+;;;###autoload
+(defun vc-diff-outgoing (&optional upstream-location fileset)
+ "Report changes to VC fileset that would be pushed to UPSTREAM-LOCATION.
+When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push
+to. When called interactively with a prefix argument, prompt for
+UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION
+can be a remote branch name.
+When called from Lisp optional argument FILESET overrides the VC
+fileset.
+
+This command is like `vc-diff-outgoing-base' except that it does not
+include uncommitted changes.
See `vc-use-incoming-outgoing-prefixes' regarding giving this command a
global binding."
@@ -2570,38 +2612,103 @@ global binding."
;; for those VCS is to make a comparison between locally committed
;; changes and remote committed changes.
;; (Hence why we don't call `vc-buffer-sync-fileset'.)
- (interactive (vc--maybe-read-remote-location))
+ (interactive (list (vc--maybe-read-upstream-location)))
+ (let* ((fileset (or fileset (vc-deduce-fileset t)))
+ (backend (car fileset))
+ (incoming (vc--incoming-revision backend
+ (or upstream-location ""))))
+ (vc-diff-internal vc-allow-async-diff fileset
+ (vc-call-backend backend 'mergebase incoming)
+ ;; FIXME: In order to exclude uncommitted
+ ;; changes we need to pass the most recent
+ ;; revision as REV2. Calling `working-revision'
+ ;; like this works for all the backends we have
+ ;; in core that implement `mergebase' and so can
+ ;; be used with this command (Git and Hg).
+ ;; However, it is not clearly permitted by the
+ ;; current semantics of `working-revision' to
+ ;; call it on a directory.
+ ;;
+ ;; A possible alternative would be something
+ ;; like this which effectively falls back to
+ ;; including uncommitted changes in the case of
+ ;; an older VCS or where the backend rejects our
+ ;; attempt to call `working-revision' on a
+ ;; directory:
+ ;; (and (eq (vc-call-backend backend
+ ;; 'revision-granularity)
+ ;; 'repository)
+ ;; (ignore-errors
+ ;; (vc-call-backend backend 'working-revision
+ ;; (car fileset)))
+ (vc-call-backend backend 'working-revision
+ (car fileset))
+ (called-interactively-p 'interactive))))
+
+;; For the following two commands, the default meaning for
+;; UPSTREAM-LOCATION may become dependent on whether we are on a
+;; shorter-lived or longer-lived ("trunk") branch. If we are on the
+;; trunk then it will always be the place `vc-push' would push to. If
+;; we are on a shorter-lived branch, it may instead become the remote
+;; trunk branch from which the shorter-lived branch was branched. That
+;; way you can use these commands to get a summary of all unmerged work
+;; outstanding on the short-lived branch.
+;;
+;; The obstacle to doing this is that VC lacks any distinction between
+;; shorter-lived and trunk branches. But we all work with both of
+;; these, for almost any VCS workflow. E.g. modern workflows which
+;; eschew traditional feature branches still have a long-lived trunk
+;; plus shorter-lived local branches for merge requests or patch series.
+;; --spwhitton
+
+;;;###autoload
+(defun vc-root-diff-outgoing-base (&optional upstream-location)
+ "Report diff of all changes since the merge base with UPSTREAM-LOCATION.
+The merge base with UPSTREAM-LOCATION means the common ancestor of the
+working revision and UPSTREAM-LOCATION.
+Uncommitted changes are included in the diff.
+
+When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push
+to. This default meaning for UPSTREAM-LOCATION may change in a future
+release of Emacs.
+
+When called interactively with a prefix argument, prompt for
+UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION
+can be a remote branch name.
+
+This command is like `vc-root-diff-outgoing' except that it includes
+uncommitted changes."
+ (interactive (list (vc--maybe-read-upstream-location)))
(vc--with-backend-in-rootdir "VC root-diff"
- (let ((default-directory rootdir)
- (incoming (vc--incoming-revision backend
- (or remote-location ""))))
- (vc-diff-internal vc-allow-async-diff (list backend (list rootdir))
- (vc-call-backend backend 'mergebase incoming)
- ;; FIXME: In order to exclude uncommitted
- ;; changes we need to pass the most recent
- ;; revision as REV2. Calling `working-revision'
- ;; like this works for all the backends we have
- ;; in core that implement `mergebase' and so can
- ;; be used with this command (Git and Hg).
- ;; However, it is not clearly permitted by the
- ;; current semantics of `working-revision' to
- ;; call it on a directory.
- ;;
- ;; A possible alternative would be something
- ;; like this which effectively falls back to
- ;; including uncommitted changes in the case of
- ;; an older VCS or where the backend rejects our
- ;; attempt to call `working-revision' on a
- ;; directory:
- ;; (and (eq (vc-call-backend backend
- ;; 'revision-granularity)
- ;; 'repository)
- ;; (ignore-errors
- ;; (vc-call-backend backend 'working-revision
- ;; rootdir)))
- (vc-call-backend backend 'working-revision
- rootdir)
- (called-interactively-p 'interactive)))))
+ (vc-diff-outgoing-base upstream-location `(,backend (,rootdir)))))
+
+;;;###autoload
+(defun vc-diff-outgoing-base (&optional upstream-location fileset)
+ "Report changes to VC fileset since the merge base with UPSTREAM-LOCATION.
+
+The merge base with UPSTREAM-LOCATION means the common ancestor of the
+working revision and UPSTREAM-LOCATION.
+Uncommitted changes are included in the diff.
+
+When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push
+to. This default meaning for UPSTREAM-LOCATION may change in a future
+release of Emacs.
+
+When called interactively with a prefix argument, prompt for
+UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION
+can be a remote branch name.
+
+This command is like to `vc-fileset-diff-outgoing' except that it
+includes uncommitted changes."
+ (interactive (list (vc--maybe-read-upstream-location) nil))
+ (let* ((fileset (or fileset (vc-deduce-fileset t)))
+ (backend (car fileset))
+ (incoming (vc--incoming-revision backend
+ (or upstream-location ""))))
+ (vc-diff-internal vc-allow-async-diff fileset
+ (vc-call-backend backend 'mergebase incoming)
+ nil
+ (called-interactively-p 'interactive))))
(declare-function ediff-load-version-control "ediff" (&optional silent))
(declare-function ediff-vc-internal "ediff-vers"
@@ -2674,8 +2781,7 @@ saving the buffer."
;; relative to it. Bind default-directory to the root directory
;; here, this way the *vc-diff* buffer is setup correctly, so
;; relative file names work.
- (let ((default-directory rootdir)
- (fileset `(,backend (,rootdir))))
+ (let ((fileset `(,backend (,rootdir))))
(vc-buffer-sync-fileset fileset not-essential)
(vc-diff-internal vc-allow-async-diff fileset nil nil
(called-interactively-p 'interactive))))))
@@ -3342,15 +3448,15 @@ Each function runs in the log output buffer without args.")
(set-buffer-modified-p nil)
(run-hooks 'vc-log-finish-functions)))))
-(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type)
+(defun vc-incoming-outgoing-internal (backend upstream-location buffer-name type)
(vc-log-internal-common
backend buffer-name nil type
(lambda (bk buf type-arg _files)
- (vc-call-backend bk type-arg buf remote-location))
+ (vc-call-backend bk type-arg buf upstream-location))
(lambda (_bk _files-arg _ret) nil)
nil ;; Don't move point.
(lambda (_ignore-auto _noconfirm)
- (vc-incoming-outgoing-internal backend remote-location buffer-name type))))
+ (vc-incoming-outgoing-internal backend upstream-location buffer-name type))))
;;;###autoload
(defun vc-print-log (&optional working-revision limit)
@@ -3444,50 +3550,53 @@ The command prompts for the branch whose change log to show."
(list rootdir) branch t
(when (> vc-log-show-limit 0) vc-log-show-limit))))
+;; FIXME: Consider renaming to `vc-upstream-location-history'.
(defvar vc-remote-location-history nil
- "History for remote locations for VC incoming and outgoing commands.")
+ "History of upstream locations for VC incoming and outgoing commands.")
-(defun vc--maybe-read-remote-location ()
+(defun vc--maybe-read-upstream-location ()
(and current-prefix-arg
- (list (read-string "Remote location/branch (empty for default): "
- 'vc-remote-location-history))))
+ (read-string "Upstream location/branch (empty for default): " nil
+ 'vc-remote-location-history)))
-(defun vc--incoming-revision (backend remote-location)
- (or (vc-call-backend backend 'incoming-revision remote-location)
+(defun vc--incoming-revision (backend upstream-location &optional refresh)
+ (or (vc-call-backend backend 'incoming-revision upstream-location refresh)
(user-error "No incoming revision -- local-only branch?")))
;;;###autoload
-(defun vc-log-incoming (&optional remote-location)
- "Show log of changes that will be received with pull from REMOTE-LOCATION.
-When unspecified REMOTE-LOCATION is the place \\[vc-update] would pull from.
-When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
-In some version control systems REMOTE-LOCATION can be a remote branch name."
- (interactive (vc--maybe-read-remote-location))
+(defun vc-log-incoming (&optional upstream-location)
+ "Show log of changes that will be received with pull from UPSTREAM-LOCATION.
+When unspecified UPSTREAM-LOCATION is the place \\[vc-update] would pull
+from. When called interactively with a prefix argument, prompt for
+UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION
+can be a remote branch name."
+ (interactive (list (vc--maybe-read-upstream-location)))
(vc--with-backend-in-rootdir "VC root-log"
- (vc-incoming-outgoing-internal backend (or remote-location "")
+ (vc-incoming-outgoing-internal backend (or upstream-location "")
"*vc-incoming*" 'log-incoming)))
-(defun vc-default-log-incoming (_backend buffer remote-location)
+(defun vc-default-log-incoming (_backend buffer upstream-location)
(vc--with-backend-in-rootdir ""
- (let ((incoming (vc--incoming-revision backend remote-location)))
+ (let ((incoming (vc--incoming-revision backend upstream-location 'refresh)))
(vc-call-backend backend 'print-log (list rootdir) buffer t
incoming
(vc-call-backend backend 'mergebase incoming)))))
;;;###autoload
-(defun vc-log-outgoing (&optional remote-location)
- "Show log of changes that will be sent with a push operation to REMOTE-LOCATION.
-When unspecified REMOTE-LOCATION is the place \\[vc-push] would push to.
-When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
-In some version control systems REMOTE-LOCATION can be a remote branch name."
- (interactive (vc--maybe-read-remote-location))
+(defun vc-log-outgoing (&optional upstream-location)
+ "Show log of changes that will be sent with a push to UPSTREAM-LOCATION.
+When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push
+to. When called interactively with a prefix argument, prompt for
+UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION
+can be a remote branch name."
+ (interactive (list (vc--maybe-read-upstream-location)))
(vc--with-backend-in-rootdir "VC root-log"
- (vc-incoming-outgoing-internal backend (or remote-location "")
+ (vc-incoming-outgoing-internal backend (or upstream-location "")
"*vc-outgoing*" 'log-outgoing)))
-(defun vc-default-log-outgoing (_backend buffer remote-location)
+(defun vc-default-log-outgoing (_backend buffer upstream-location)
(vc--with-backend-in-rootdir ""
- (let ((incoming (vc--incoming-revision backend remote-location)))
+ (let ((incoming (vc--incoming-revision backend upstream-location)))
(vc-call-backend backend 'print-log (list rootdir) buffer t
""
(vc-call-backend backend 'mergebase incoming)))))
@@ -3568,10 +3677,12 @@ to the working revision (except for keyword expansion)."
;; If any of the files is visited by the current buffer, make sure
;; buffer is saved. If the user says `no', abort since we cannot
;; show the changes and ask for confirmation to discard them.
- (when (or (not files) (memq (buffer-file-name) files))
+ (when-let* ((n (buffer-file-name))
+ ((or (not files) (member n files))))
(vc-buffer-sync nil))
(save-some-buffers nil (lambda ()
- (member (buffer-file-name) files)))
+ (and-let* ((n (buffer-file-name)))
+ (member n files))))
(let (needs-save)
(dolist (file files)
(let ((buf (get-file-buffer file)))
diff --git a/src/alloc.c b/src/alloc.c
index 07ca8474bf3..9ace6f01856 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1815,56 +1815,6 @@ allocate_string_data (struct Lisp_String *s,
tally_consing (needed);
}
-/* Reallocate multibyte STRING data when a single character is replaced.
- The character is at byte offset CIDX_BYTE in the string.
- The character being replaced is CLEN bytes long,
- and the character that will replace it is NEW_CLEN bytes long.
- Return the address where the caller should store the new character. */
-
-unsigned char *
-resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte,
- int clen, int new_clen)
-{
- eassume (STRING_MULTIBYTE (string));
- sdata *old_sdata = SDATA_OF_STRING (XSTRING (string));
- ptrdiff_t nchars = SCHARS (string);
- ptrdiff_t nbytes = SBYTES (string);
- ptrdiff_t new_nbytes = nbytes + (new_clen - clen);
- unsigned char *data = SDATA (string);
- unsigned char *new_charaddr;
-
- if (sdata_size (nbytes) == sdata_size (new_nbytes))
- {
- /* No need to reallocate, as the size change falls within the
- alignment slop. */
- XSTRING (string)->u.s.size_byte = new_nbytes;
-#ifdef GC_CHECK_STRING_BYTES
- SDATA_NBYTES (old_sdata) = new_nbytes;
-#endif
- new_charaddr = data + cidx_byte;
- memmove (new_charaddr + new_clen, new_charaddr + clen,
- nbytes - (cidx_byte + (clen - 1)));
- }
- else
- {
- allocate_string_data (XSTRING (string), nchars, new_nbytes, false, false);
- unsigned char *new_data = SDATA (string);
- new_charaddr = new_data + cidx_byte;
- memcpy (new_charaddr + new_clen, data + cidx_byte + clen,
- nbytes - (cidx_byte + clen));
- memcpy (new_data, data, cidx_byte);
-
- /* Mark old string data as free by setting its string back-pointer
- to null, and record the size of the data in it. */
- SDATA_NBYTES (old_sdata) = nbytes;
- old_sdata->string = NULL;
- }
-
- clear_string_char_byte_cache ();
-
- return new_charaddr;
-}
-
/* Sweep and compact strings. */
diff --git a/src/data.c b/src/data.c
index 493a8dd63fc..5b3c9792ea0 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2574,7 +2574,10 @@ or a byte-code object. IDX starts at 0. */)
DEFUN ("aset", Faset, Saset, 3, 3, 0,
doc: /* Store into the element of ARRAY at index IDX the value NEWELT.
Return NEWELT. ARRAY may be a vector, a string, a char-table or a
-bool-vector. IDX starts at 0. */)
+bool-vector. IDX starts at 0.
+If ARRAY is a unibyte string, NEWELT must be a single byte (0-255).
+If ARRAY is a multibyte string, NEWELT and the previous character at
+index IDX must both be ASCII (0-127). */)
(register Lisp_Object array, Lisp_Object idx, Lisp_Object newelt)
{
register EMACS_INT idxval;
@@ -2613,42 +2616,24 @@ bool-vector. IDX starts at 0. */)
args_out_of_range (array, idx);
CHECK_CHARACTER (newelt);
int c = XFIXNAT (newelt);
- ptrdiff_t idxval_byte;
- int prev_bytes;
- unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
if (STRING_MULTIBYTE (array))
{
- idxval_byte = string_char_to_byte (array, idxval);
- p1 = SDATA (array) + idxval_byte;
- prev_bytes = BYTES_BY_CHAR_HEAD (*p1);
- }
- else if (SINGLE_BYTE_CHAR_P (c))
- {
- SSET (array, idxval, c);
- return newelt;
+ if (c > 0x7f)
+ error ("Attempt to store non-ASCII char into multibyte string");
+ ptrdiff_t idxval_byte = string_char_to_byte (array, idxval);
+ unsigned char *p = SDATA (array) + idxval_byte;
+ if (*p > 0x7f)
+ error ("Attempt to replace non-ASCII char in multibyte string");
+ *p = c;
}
else
{
- for (ptrdiff_t i = SBYTES (array) - 1; i >= 0; i--)
- if (!ASCII_CHAR_P (SREF (array, i)))
- args_out_of_range (array, newelt);
- /* ARRAY is an ASCII string. Convert it to a multibyte string. */
- STRING_SET_MULTIBYTE (array);
- idxval_byte = idxval;
- p1 = SDATA (array) + idxval_byte;
- prev_bytes = 1;
+ if (c > 0xff)
+ error ("Attempt to store non-byte value into unibyte string");
+ SSET (array, idxval, c);
}
-
- int new_bytes = CHAR_STRING (c, p0);
- if (prev_bytes != new_bytes)
- p1 = resize_string_data (array, idxval_byte, prev_bytes, new_bytes);
-
- do
- *p1++ = *p0++;
- while (--new_bytes != 0);
}
-
return newelt;
}
@@ -3538,10 +3523,10 @@ discarding bits. */)
CHECK_INTEGER (value);
CHECK_INTEGER (count);
+ if (BASE_EQ (value, make_fixnum (0)))
+ return value;
if (! FIXNUMP (count))
{
- if (BASE_EQ (value, make_fixnum (0)))
- return value;
if (mpz_sgn (*xbignum_val (count)) < 0)
{
EMACS_INT v = (FIXNUMP (value) ? XFIXNUM (value)
@@ -3551,30 +3536,38 @@ discarding bits. */)
overflow_error ();
}
- if (XFIXNUM (count) <= 0)
+ EMACS_INT c = XFIXNUM (count);
+ if (c <= 0)
{
- if (XFIXNUM (count) == 0)
+ if (c == 0)
return value;
if ((EMACS_INT) -1 >> 1 == -1 && FIXNUMP (value))
{
- EMACS_INT shift = -XFIXNUM (count);
+ EMACS_INT shift = -c;
EMACS_INT result
= (shift < EMACS_INT_WIDTH ? XFIXNUM (value) >> shift
: XFIXNUM (value) < 0 ? -1 : 0);
return make_fixnum (result);
}
}
+ else if (FIXNUMP (value))
+ {
+ EMACS_INT v = XFIXNUM (value);
+ if (stdc_leading_zeros ((EMACS_UINT)(v < 0 ? ~v : v)) - c
+ >= EMACS_INT_WIDTH - FIXNUM_BITS + 1)
+ return make_fixnum (v << c);
+ }
mpz_t const *zval = bignum_integer (&mpz[0], value);
- if (XFIXNUM (count) < 0)
+ if (c < 0)
{
- if (TYPE_MAXIMUM (mp_bitcnt_t) < - XFIXNUM (count))
+ if (TYPE_MAXIMUM (mp_bitcnt_t) < -c)
return make_fixnum (mpz_sgn (*zval) < 0 ? -1 : 0);
- mpz_fdiv_q_2exp (mpz[0], *zval, - XFIXNUM (count));
+ mpz_fdiv_q_2exp (mpz[0], *zval, -c);
}
else
- emacs_mpz_mul_2exp (mpz[0], *zval, XFIXNUM (count));
+ emacs_mpz_mul_2exp (mpz[0], *zval, c);
return make_integer_mpz ();
}
diff --git a/src/eval.c b/src/eval.c
index 0d4ae91136e..2dc14b6d431 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1948,6 +1948,8 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable)
}
conditions = Fget (real_error_symbol, Qerror_conditions);
+ if (NILP (conditions))
+ signal_error ("Invalid error symbol", error_symbol);
/* Remember from where signal was called. Skip over the frame for
`signal' itself. If a frame for `error' follows, skip that,
diff --git a/src/fns.c b/src/fns.c
index 1cf63384218..5334c9f94a8 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1189,12 +1189,6 @@ static Lisp_Object string_char_byte_cache_string;
static ptrdiff_t string_char_byte_cache_charpos;
static ptrdiff_t string_char_byte_cache_bytepos;
-void
-clear_string_char_byte_cache (void)
-{
- string_char_byte_cache_string = Qnil;
-}
-
/* Return the byte index corresponding to CHAR_INDEX in STRING. */
ptrdiff_t
diff --git a/src/indent.c b/src/indent.c
index b4f3c349dc5..95228b26825 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -2506,6 +2506,9 @@ buffer, whether or not it is currently displayed in some window. */)
an addition to the hscroll amount. */
if (!NILP (lcols))
{
+ if (it.method == GET_FROM_STRING && !NILP (it.from_overlay))
+ reseat_at_previous_visible_line_start(&it);
+
move_it_in_display_line (&it, ZV, first_x + to_x, MOVE_TO_X);
/* If we find ourselves in the middle of an overlay string
which includes a newline after current string position,
diff --git a/src/json.c b/src/json.c
index 44eae653eb5..30a22dc8038 100644
--- a/src/json.c
+++ b/src/json.c
@@ -684,10 +684,6 @@ struct json_parser
const unsigned char *secondary_input_begin;
const unsigned char *secondary_input_end;
- ptrdiff_t current_line;
- ptrdiff_t current_column;
- ptrdiff_t point_of_current_line;
-
/* The parser has a maximum allowed depth. available_depth
decreases at each object/array begin. If reaches zero, then an
error is generated */
@@ -717,15 +713,22 @@ struct json_parser
unsigned char *byte_workspace;
unsigned char *byte_workspace_end;
unsigned char *byte_workspace_current;
+
+ Lisp_Object obj;
+ ptrdiff_t (*byte_to_pos) (Lisp_Object obj, ptrdiff_t byte);
+ ptrdiff_t (*byte_to_line) (Lisp_Object obj, ptrdiff_t byte);
};
static AVOID
-json_signal_error (struct json_parser *parser, Lisp_Object error)
+json_signal_error (struct json_parser *p, Lisp_Object error)
{
- xsignal3 (error, INT_TO_INTEGER (parser->current_line),
- INT_TO_INTEGER (parser->current_column),
- INT_TO_INTEGER (parser->point_of_current_line
- + parser->current_column));
+ ptrdiff_t byte = (p->input_current - p->input_begin
+ + p->additional_bytes_count);
+ ptrdiff_t pos = p->byte_to_pos (p->obj, byte);
+ ptrdiff_t line = p->byte_to_line (p->obj, byte) + 1;
+ /* The line number here is deprecated and provided for compatibility only.
+ It is scheduled for removal in Emacs 32. */
+ xsignal3 (error, INT_TO_INTEGER (line), Qnil, INT_TO_INTEGER (pos));
}
static void
@@ -734,7 +737,10 @@ json_parser_init (struct json_parser *parser,
const unsigned char *input,
const unsigned char *input_end,
const unsigned char *secondary_input,
- const unsigned char *secondary_input_end)
+ const unsigned char *secondary_input_end,
+ ptrdiff_t (*byte_to_pos) (Lisp_Object, ptrdiff_t),
+ ptrdiff_t (*byte_to_line) (Lisp_Object, ptrdiff_t),
+ Lisp_Object obj)
{
if (secondary_input >= secondary_input_end)
{
@@ -761,9 +767,6 @@ json_parser_init (struct json_parser *parser,
parser->input_current = parser->input_begin;
- parser->current_line = 1;
- parser->current_column = 0;
- parser->point_of_current_line = 0;
parser->available_depth = 10000;
parser->conf = conf;
@@ -777,6 +780,9 @@ json_parser_init (struct json_parser *parser,
parser->byte_workspace = parser->internal_byte_workspace;
parser->byte_workspace_end = (parser->byte_workspace
+ JSON_PARSER_INTERNAL_BYTE_WORKSPACE_SIZE);
+ parser->byte_to_pos = byte_to_pos;
+ parser->byte_to_line = byte_to_line;
+ parser->obj = obj;
}
static void
@@ -956,20 +962,9 @@ json_input_put_back (struct json_parser *parser)
}
static bool
-json_skip_whitespace_internal (struct json_parser *parser, int c)
+is_json_whitespace (int c)
{
- parser->current_column++;
- if (c == 0x20 || c == 0x09 || c == 0x0d)
- return false;
- else if (c == 0x0a)
- {
- parser->current_line++;
- parser->point_of_current_line += parser->current_column;
- parser->current_column = 0;
- return false;
- }
- else
- return true;
+ return c == 0x20 || c == 0x09 || c == 0x0d || c == 0x0a;
}
/* Skips JSON whitespace, and returns with the first non-whitespace
@@ -980,7 +975,7 @@ json_skip_whitespace (struct json_parser *parser)
for (;;)
{
int c = json_input_get (parser);
- if (json_skip_whitespace_internal (parser, c))
+ if (!is_json_whitespace (c))
return c;
}
}
@@ -994,9 +989,7 @@ json_skip_whitespace_if_possible (struct json_parser *parser)
for (;;)
{
int c = json_input_get_if_possible (parser);
- if (c < 0)
- return c;
- if (json_skip_whitespace_internal (parser, c))
+ if (!is_json_whitespace (c) || c < 0)
return c;
}
}
@@ -1022,7 +1015,6 @@ json_parse_unicode (struct json_parser *parser)
for (int i = 0; i < 4; i++)
{
int c = json_hex_value (json_input_get (parser));
- parser->current_column++;
if (c < 0)
json_signal_error (parser, Qjson_escape_sequence_error);
v[i] = c;
@@ -1068,13 +1060,11 @@ json_parse_string (struct json_parser *parser, bool intern, bool leading_colon)
json_byte_workspace_put (parser, c2);
json_byte_workspace_put (parser, c3);
parser->input_current += 4;
- parser->current_column += 4;
continue;
}
}
int c = json_input_get (parser);
- parser->current_column++;
if (json_plain_char[c])
{
json_byte_workspace_put (parser, c);
@@ -1137,7 +1127,6 @@ json_parse_string (struct json_parser *parser, bool intern, bool leading_colon)
{
/* Handle escape sequences */
c = json_input_get (parser);
- parser->current_column++;
if (c == '"')
json_byte_workspace_put (parser, '"');
else if (c == '\\')
@@ -1160,11 +1149,9 @@ json_parse_string (struct json_parser *parser, bool intern, bool leading_colon)
/* is the first half of the surrogate pair */
if (num >= 0xd800 && num < 0xdc00)
{
- parser->current_column++;
if (json_input_get (parser) != '\\')
json_signal_error (parser,
Qjson_invalid_surrogate_error);
- parser->current_column++;
if (json_input_get (parser) != 'u')
json_signal_error (parser,
Qjson_invalid_surrogate_error);
@@ -1285,7 +1272,6 @@ json_parse_number (struct json_parser *parser, int c)
negative = true;
c = json_input_get (parser);
json_byte_workspace_put (parser, c);
- parser->current_column++;
}
if (c < '0' || c > '9')
json_signal_error (parser, Qjson_parse_error);
@@ -1317,7 +1303,6 @@ json_parse_number (struct json_parser *parser, int c)
if (c < '0' || c > '9')
break;
json_byte_workspace_put (parser, c);
- parser->current_column++;
integer_overflow |= ckd_mul (&integer, integer, 10);
integer_overflow |= ckd_add (&integer, integer, c - '0');
@@ -1328,12 +1313,10 @@ json_parse_number (struct json_parser *parser, int c)
if (c == '.')
{
json_byte_workspace_put (parser, c);
- parser->current_column++;
is_float = true;
c = json_input_get (parser);
json_byte_workspace_put (parser, c);
- parser->current_column++;
if (c < '0' || c > '9')
json_signal_error (parser, Qjson_parse_error);
for (;;)
@@ -1344,23 +1327,19 @@ json_parse_number (struct json_parser *parser, int c)
if (c < '0' || c > '9')
break;
json_byte_workspace_put (parser, c);
- parser->current_column++;
}
}
if (c == 'e' || c == 'E')
{
json_byte_workspace_put (parser, c);
- parser->current_column++;
is_float = true;
c = json_input_get (parser);
json_byte_workspace_put (parser, c);
- parser->current_column++;
if (c == '-' || c == '+')
{
c = json_input_get (parser);
json_byte_workspace_put (parser, c);
- parser->current_column++;
}
if (c < '0' || c > '9')
json_signal_error (parser, Qjson_parse_error);
@@ -1372,7 +1351,6 @@ json_parse_number (struct json_parser *parser, int c)
if (c < '0' || c > '9')
break;
json_byte_workspace_put (parser, c);
- parser->current_column++;
}
}
@@ -1605,57 +1583,67 @@ json_is_token_char (int c)
|| (c >= '0' && c <= '9') || (c == '-'));
}
-/* This is the entry point to the value parser, this parses a JSON
- * value */
-Lisp_Object
+static Lisp_Object
json_parse_value (struct json_parser *parser, int c)
{
- if (c == '{')
- return json_parse_object (parser);
- else if (c == '[')
- return json_parse_array (parser);
- else if (c == '"')
- return json_parse_string (parser, false, false);
- else if ((c >= '0' && c <= '9') || (c == '-'))
- return json_parse_number (parser, c);
- else
+ switch (c)
{
- int c2 = json_input_get_if_possible (parser);
- int c3 = json_input_get_if_possible (parser);
- int c4 = json_input_get_if_possible (parser);
- int c5 = json_input_get_if_possible (parser);
-
- if (c == 't' && c2 == 'r' && c3 == 'u' && c4 == 'e'
- && (c5 < 0 || !json_is_token_char (c5)))
+ case '{':
+ return json_parse_object (parser);
+ case '[':
+ return json_parse_array (parser);
+ case '"':
+ return json_parse_string (parser, false, false);
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ case '-':
+ return json_parse_number (parser, c);
+ case 't':
+ if (json_input_get_if_possible (parser) == 'r'
+ && json_input_get_if_possible (parser) == 'u'
+ && json_input_get_if_possible (parser) == 'e')
{
- if (c5 >= 0)
- json_input_put_back (parser);
- parser->current_column += 3;
- return Qt;
- }
- if (c == 'n' && c2 == 'u' && c3 == 'l' && c4 == 'l'
- && (c5 < 0 || !json_is_token_char (c5)))
- {
- if (c5 >= 0)
- json_input_put_back (parser);
- parser->current_column += 3;
- return parser->conf.null_object;
- }
- if (c == 'f' && c2 == 'a' && c3 == 'l' && c4 == 's'
- && c5 == 'e')
- {
- int c6 = json_input_get_if_possible (parser);
- if (c6 < 0 || !json_is_token_char (c6))
+ int c2 = json_input_get_if_possible (parser);
+ if (!json_is_token_char (c2))
{
- if (c6 >= 0)
+ if (c2 >= 0)
+ json_input_put_back (parser);
+ return Qt;
+ }
+ }
+ break;
+ case 'f':
+ if (json_input_get_if_possible (parser) == 'a'
+ && json_input_get_if_possible (parser) == 'l'
+ && json_input_get_if_possible (parser) == 's'
+ && json_input_get_if_possible (parser) == 'e')
+ {
+ int c2 = json_input_get_if_possible (parser);
+ if (!json_is_token_char (c2))
+ {
+ if (c2 >= 0)
json_input_put_back (parser);
- parser->current_column += 4;
return parser->conf.false_object;
}
}
-
- json_signal_error (parser, Qjson_parse_error);
+ break;
+ case 'n':
+ if (json_input_get_if_possible (parser) == 'u'
+ && json_input_get_if_possible (parser) == 'l'
+ && json_input_get_if_possible (parser) == 'l')
+ {
+ int c2 = json_input_get_if_possible (parser);
+ if (!json_is_token_char (c2))
+ {
+ if (c2 >= 0)
+ json_input_put_back (parser);
+ return parser->conf.null_object;
+ }
+ }
+ break;
}
+
+ json_signal_error (parser, Qjson_parse_error);
}
static Lisp_Object
@@ -1664,6 +1652,42 @@ json_parse (struct json_parser *parser)
return json_parse_value (parser, json_skip_whitespace (parser));
}
+/* Count number of characters in the NBYTES bytes at S. */
+static ptrdiff_t
+count_chars (const unsigned char *s, ptrdiff_t nbytes)
+{
+ ptrdiff_t nchars = 0;
+ for (ptrdiff_t i = 0; i < nbytes; i++)
+ nchars += (s[i] & 0xc0) != 0x80;
+ return nchars;
+}
+
+/* Count number of newlines in the NBYTES bytes at S. */
+static ptrdiff_t
+count_newlines (const unsigned char *s, ptrdiff_t nbytes)
+{
+ ptrdiff_t nls = 0;
+ for (ptrdiff_t i = 0; i < nbytes; i++)
+ nls += (s[i] == '\n');
+ return nls;
+}
+
+static ptrdiff_t
+string_byte_to_pos (Lisp_Object obj, ptrdiff_t byte)
+{
+ eassert (STRINGP (obj));
+ eassert (byte <= SBYTES (obj));
+ return STRING_MULTIBYTE (obj) ? count_chars (SDATA (obj), byte) : byte;
+}
+
+static ptrdiff_t
+string_byte_to_line (Lisp_Object obj, ptrdiff_t byte)
+{
+ eassert (STRINGP (obj));
+ eassert (byte <= SBYTES (obj));
+ return count_newlines (SDATA (obj), byte);
+}
+
DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY,
NULL,
doc: /* Parse the JSON STRING into a Lisp value.
@@ -1703,7 +1727,8 @@ usage: (json-parse-string STRING &rest ARGS) */)
struct json_parser p;
const unsigned char *begin = SDATA (string);
- json_parser_init (&p, conf, begin, begin + SBYTES (string), NULL, NULL);
+ json_parser_init (&p, conf, begin, begin + SBYTES (string), NULL, NULL,
+ string_byte_to_pos, string_byte_to_line, string);
record_unwind_protect_ptr (json_parser_done, &p);
Lisp_Object result = json_parse (&p);
@@ -1713,6 +1738,24 @@ usage: (json-parse-string STRING &rest ARGS) */)
return unbind_to (count, result);
}
+static ptrdiff_t
+buffer_byte_to_pos (Lisp_Object obj, ptrdiff_t byte)
+{
+ /* The position from the start of the parse (for compatibility). */
+ return BYTE_TO_CHAR (PT_BYTE + byte) - PT;
+}
+
+static ptrdiff_t
+buffer_byte_to_line (Lisp_Object obj, ptrdiff_t byte)
+{
+ /* Line from start of the parse (for compatibility). */
+ ptrdiff_t to_gap = GPT_BYTE - PT_BYTE;
+ return (to_gap > 0 && to_gap < byte
+ ? (count_newlines (PT_ADDR, to_gap)
+ + count_newlines (GAP_END_ADDR, byte - to_gap))
+ : count_newlines (PT_ADDR, byte));
+}
+
DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer,
0, MANY, NULL,
doc: /* Read a JSON value from current buffer starting at point.
@@ -1766,8 +1809,8 @@ usage: (json-parse-buffer &rest args) */)
secondary_end = ZV_ADDR;
}
- json_parser_init (&p, conf, begin, end, secondary_begin,
- secondary_end);
+ json_parser_init (&p, conf, begin, end, secondary_begin, secondary_end,
+ buffer_byte_to_pos, buffer_byte_to_line, Qnil);
record_unwind_protect_ptr (json_parser_done, &p);
Lisp_Object result = json_parse (&p);
@@ -1776,7 +1819,7 @@ usage: (json-parse-buffer &rest args) */)
ptrdiff_t position = (NILP (BVAR (current_buffer,
enable_multibyte_characters))
? byte
- : PT + p.point_of_current_line + p.current_column);
+ : BYTE_TO_CHAR (byte));
SET_PT_BOTH (position, byte);
return unbind_to (count, result);
diff --git a/src/lisp.h b/src/lisp.h
index 64b5c227583..fe942c917f0 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4289,7 +4289,6 @@ extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object);
extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object);
extern Lisp_Object assq_no_signal (Lisp_Object, Lisp_Object);
extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object);
-extern void clear_string_char_byte_cache (void);
extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t);
extern ptrdiff_t string_byte_to_char (Lisp_Object, ptrdiff_t);
extern Lisp_Object string_to_multibyte (Lisp_Object);
@@ -4444,7 +4443,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t,
/* Defined in alloc.c. */
extern intptr_t garbage_collection_inhibited;
-unsigned char *resize_string_data (Lisp_Object, ptrdiff_t, int, int);
extern void malloc_warning (const char *);
extern AVOID memory_full (size_t);
extern AVOID buffer_memory_full (ptrdiff_t);
diff --git a/src/lread.c b/src/lread.c
index 57d3239e283..1a667ce163a 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -522,6 +522,12 @@ from_file_p (source_t *source)
return source->get == source_file_get;
}
+static bool
+from_buffer_p (source_t *source)
+{
+ return source->get == source_buffer_get;
+}
+
static void
skip_dyn_bytes (source_t *source, ptrdiff_t n)
{
@@ -630,7 +636,7 @@ unreadbyte_from_file (unsigned char c)
static AVOID
invalid_syntax_lisp (Lisp_Object s, source_t *source)
{
- if (source->get == source_buffer_get)
+ if (from_buffer_p (source))
{
Lisp_Object buffer = source->object;
/* Get the line/column in the buffer. */
@@ -2114,12 +2120,16 @@ build_load_history (Lisp_Object filename, bool entire)
information. */
static AVOID
-end_of_file_error (void)
+end_of_file_error (source_t *source)
{
- if (STRINGP (Vload_true_file_name))
+ if (from_file_p (source))
+ /* Only Fload calls read on a file, and Fload always binds
+ load-true-file-name around the call. */
xsignal1 (Qend_of_file, Vload_true_file_name);
-
- xsignal0 (Qend_of_file);
+ else if (from_buffer_p (source))
+ xsignal1 (Qend_of_file, source->object);
+ else
+ xsignal0 (Qend_of_file);
}
static Lisp_Object
@@ -2604,7 +2614,7 @@ read_char_escape (source_t *source, int next_char)
switch (c)
{
case -1:
- end_of_file_error ();
+ end_of_file_error (source);
case 'a': chr = '\a'; break;
case 'b': chr = '\b'; break;
@@ -2777,7 +2787,7 @@ read_char_escape (source_t *source, int next_char)
{
int c = readchar (source);
if (c < 0)
- end_of_file_error ();
+ end_of_file_error (source);
if (c == '}')
break;
if (c >= 0x80)
@@ -2819,7 +2829,7 @@ read_char_escape (source_t *source, int next_char)
break;
}
if (chr < 0)
- end_of_file_error ();
+ end_of_file_error (source);
eassert (chr >= 0 && chr < (1 << CHARACTERBITS));
/* Apply Control modifiers, using the rules:
@@ -2982,7 +2992,7 @@ read_char_literal (source_t *source)
{
int ch = readchar (source);
if (ch < 0)
- end_of_file_error ();
+ end_of_file_error (source);
/* Accept `single space' syntax like (list ? x) where the
whitespace character is SPC or TAB.
@@ -3118,7 +3128,7 @@ read_string_literal (source_t *source)
}
if (ch < 0)
- end_of_file_error ();
+ end_of_file_error (source);
if (!force_multibyte && force_singlebyte)
{
@@ -3548,7 +3558,7 @@ skip_space_and_comments (source_t *source)
c = readchar (source);
while (c >= 0 && c != '\n');
if (c < 0)
- end_of_file_error ();
+ end_of_file_error (source);
}
while (c <= 32 || c == NO_BREAK_SPACE);
unreadchar (source, c);
@@ -3734,7 +3744,7 @@ read0 (source_t *source, bool locate_syms)
Lisp_Object obj;
int c = readchar (source);
if (c < 0)
- end_of_file_error ();
+ end_of_file_error (source);
switch (c)
{
@@ -4151,7 +4161,7 @@ read0 (source_t *source, bool locate_syms)
{
c = readchar (source);
if (c < 0)
- end_of_file_error ();
+ end_of_file_error (source);
quoted = true;
}
diff --git a/src/process.c b/src/process.c
index c8b70a4174c..d6efac5479d 100644
--- a/src/process.c
+++ b/src/process.c
@@ -467,7 +467,7 @@ static struct fd_callback_data
} fd_callback_info[FD_SETSIZE];
static void
-clear_fd_callback_data(struct fd_callback_data* elem)
+clear_fd_callback_data (struct fd_callback_data* elem)
{
elem->func = NULL;
elem->data = NULL;
@@ -577,7 +577,7 @@ delete_write_fd (int fd)
fd_callback_info[fd].flags &= ~(FOR_WRITE | NON_BLOCKING_CONNECT_FD);
if (fd_callback_info[fd].flags == 0)
{
- clear_fd_callback_data(&fd_callback_info[fd]);
+ clear_fd_callback_data (&fd_callback_info[fd]);
if (fd == max_desc)
recompute_max_desc ();
@@ -8322,7 +8322,7 @@ delete_keyboard_wait_descriptor (int desc)
#ifdef subprocesses
eassert (desc >= 0 && desc < FD_SETSIZE);
- clear_fd_callback_data(&fd_callback_info[desc]);
+ clear_fd_callback_data (&fd_callback_info[desc]);
if (desc == max_desc)
recompute_max_desc ();
diff --git a/src/xdisp.c b/src/xdisp.c
index 2691296b282..89561d750b6 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -9156,6 +9156,16 @@ next_element_from_display_vector (struct it *it)
it->c = GLYPH_CODE_CHAR (gc);
it->len = CHAR_BYTES (it->c);
+ /* The character code in the display vector could be non-ASCII, in
+ which case we must make the iterator multibyte, so that a
+ suitable font for the character is looked up. But don't do
+ that if the original character came from a unibyte buffer. */
+ if (!ASCII_CHAR_P (it->c)
+ && !it->multibyte_p
+ && !(((it->sp == 0 && BUFFERP (it->object))
+ || (it->sp > 1 && !NILP (it->stack[0].string)))
+ && NILP (BVAR (current_buffer, enable_multibyte_characters))))
+ it->multibyte_p = 1;
/* The entry may contain a face id to use. Such a face id is
the id of a Lisp face, not a realized face. A face id of
@@ -22657,8 +22667,23 @@ try_window_id (struct window *w)
/* Give up if the row starts with a display property that draws
on the fringes, since that could prevent correct display of
line-prefix and wrap-prefix. */
- if (it.sp > 1
+ if ((it.sp > 1
&& it.method == GET_FROM_IMAGE && it.image_id == -1)
+ /* Give up if there's a line/wrap-prefix property on buffer
+ text, and the row begins with a display or overlay string.
+ This is because in that case the iterator state produced by
+ init_to_row_end is already set to the display/overlay
+ string, and thus cannot be used to display the prefix
+ before the display/overlay string. */
+ || (it.sp == 1
+ && it.method == GET_FROM_STRING
+ && !it.string_from_prefix_prop_p
+ && (!NILP (Fget_char_property (make_fixnum (IT_CHARPOS (it)),
+ Qline_prefix,
+ it.w->contents))
+ || !NILP (Fget_char_property (make_fixnum (IT_CHARPOS (it)),
+ Qwrap_prefix,
+ it.w->contents)))))
GIVE_UP (26);
start_pos = it.current.pos;
@@ -24710,15 +24735,19 @@ cursor_row_p (struct glyph_row *row)
/* Push the property PROP so that it will be rendered at the current
- position in IT. Return true if PROP was successfully pushed, false
- otherwise. Called from handle_line_prefix to handle the
- `line-prefix' and `wrap-prefix' properties. */
+ position in IT. FROM_BUFFER non-zero means the property was found on
+ buffer text, even though IT is set to iterate a string.
+ Return true if PROP was successfully pushed, false otherwise.
+ Called from handle_line_prefix to handle the `line-prefix' and
+ `wrap-prefix' properties. */
static bool
-push_prefix_prop (struct it *it, Lisp_Object prop)
+push_prefix_prop (struct it *it, Lisp_Object prop, int from_buffer)
{
struct text_pos pos =
STRINGP (it->string) ? it->current.string_pos : it->current.pos;
+ bool phoney_display_string =
+ from_buffer && STRINGP (it->string) && it->string_from_display_prop_p;
eassert (it->method == GET_FROM_BUFFER
|| it->method == GET_FROM_DISPLAY_VECTOR
@@ -24737,6 +24766,13 @@ push_prefix_prop (struct it *it, Lisp_Object prop)
it->position not yet set when this function is called. */
push_it (it, &pos);
+ /* Reset this flag, since it is not relevant (comes from a display
+ string that follows iterator position). If we don't do that, any
+ display properties on the prefix string will be ignored. The call
+ to pop_it when we are done with the prefix will restore the flag. */
+ if (phoney_display_string)
+ it->string_from_display_prop_p = false;
+
if (STRINGP (prop))
{
if (SCHARS (prop) == 0)
@@ -24794,7 +24830,7 @@ push_prefix_prop (struct it *it, Lisp_Object prop)
#endif /* HAVE_WINDOW_SYSTEM */
else
{
- pop_it (it); /* bogus display property, give up */
+ pop_it (it); /* bogus prefix property, give up */
return false;
}
@@ -24825,15 +24861,21 @@ get_it_property (struct it *it, Lisp_Object prop)
current IT->OBJECT and the underlying buffer text. */
static Lisp_Object
-get_line_prefix_it_property (struct it *it, Lisp_Object prop)
+get_line_prefix_it_property (struct it *it, Lisp_Object prop,
+ int *from_buffer)
{
Lisp_Object prefix = get_it_property (it, prop);
+ *from_buffer = BUFFERP (it->object);
+
/* If we are looking at a display or overlay string, check also the
underlying buffer text. */
if (NILP (prefix) && it->sp > 0 && STRINGP (it->object))
- return Fget_char_property (make_fixnum (IT_CHARPOS (*it)), prop,
- it->w->contents);
+ {
+ *from_buffer = true;
+ return Fget_char_property (make_fixnum (IT_CHARPOS (*it)), prop,
+ it->w->contents);
+ }
return prefix;
}
@@ -24844,21 +24886,22 @@ handle_line_prefix (struct it *it)
{
Lisp_Object prefix;
bool wrap_prop = false;
+ int from_buffer;
if (it->continuation_lines_width > 0)
{
- prefix = get_line_prefix_it_property (it, Qwrap_prefix);
+ prefix = get_line_prefix_it_property (it, Qwrap_prefix, &from_buffer);
if (NILP (prefix))
prefix = Vwrap_prefix;
wrap_prop = true;
}
else
{
- prefix = get_line_prefix_it_property (it, Qline_prefix);
+ prefix = get_line_prefix_it_property (it, Qline_prefix, &from_buffer);
if (NILP (prefix))
prefix = Vline_prefix;
}
- if (! NILP (prefix) && push_prefix_prop (it, prefix))
+ if (! NILP (prefix) && push_prefix_prop (it, prefix, from_buffer))
{
/* If the prefix is wider than the window, and we try to wrap
it, it would acquire its own wrap prefix, and so on till the
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index 2fd6a6be45e..49762e146a5 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -26,6 +26,7 @@
(require 'cl-lib)
(require 'ert)
+(require 'ert-x)
(require 'calc)
(require 'calc-ext)
(require 'calc-units)
@@ -946,5 +947,19 @@ an error in the comparison."
(should-error (math-vector-is-string cplx-vec)
:type 'wrong-type-argument))))
+(ert-deftest calc-inhibit-startup-message ()
+ "Test user option `calc-inhibit-startup-message'."
+ (let ((welcome-message "Welcome to the GNU Emacs Calculator!"))
+ (ert-with-message-capture messages
+ (let ((calc-inhibit-startup-message t))
+ (calc))
+ (should-not (string-match-p welcome-message messages))
+ (calc-quit))
+ (ert-with-message-capture messages
+ (let ((calc-inhibit-startup-message nil))
+ (calc))
+ (should (string-match-p welcome-message messages))
+ (calc-quit))))
+
(provide 'calc-tests)
;;; calc-tests.el ends here
diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
index 24981bb63cf..4e63732554f 100644
--- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
+++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
@@ -126,6 +126,16 @@
!start!(with-current-buffer (get-buffer-create "*edebug-test-code-buffer*")
!body!(format "current-buffer: %s" (current-buffer))))
+(defun edebug-test-code-bounce-point ()
+ !start!(with-current-buffer (get-buffer-create "*edebug-test-code-buffer*")
+ (erase-buffer)
+ (insert "123\n567\n9ab\n")
+ (narrow-to-region 5 9)
+ (goto-char 6)!goto-char!
+ (push-mark 1)!push-mark!
+ (set-mark nil)!clear-mark!
+ (+ 1)!1! (+ 6)!6! (+ 10)!10!))
+
(defun edebug-test-code-use-destructuring-bind ()
(let ((two 2) (three 3))
(cl-destructuring-bind (x . y) (cons two three) (+ x!x! y!y!))))
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 7daacea7925..4550f25f798 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -302,6 +302,29 @@ Then clear edebug-tests' saved messages."
edebug-tests-messages))
(setq edebug-tests-messages ""))
+(defvar edebug-tests-bounce-outside-buffer nil
+ "Outside buffer observed while bouncing.")
+(defvar edebug-tests-bounce-outside-point nil
+ "Outside point observed while bouncing.")
+(defvar edebug-tests-bounce-outside-mark nil
+ "Outside mark observed while bouncing.")
+
+(defun edebug-tests-bounce-record-outside-environment (&rest _)
+ "Record outside buffer, point, and mark while bouncing."
+ (setq edebug-tests-bounce-outside-buffer (current-buffer)
+ edebug-tests-bounce-outside-point (point)
+ edebug-tests-bounce-outside-mark (mark)))
+
+(defun edebug-tests-should-have-bounced-to (buffer-or-name point mark message)
+ "Require that a previous bounce bounced to BUFFER-OR-NAME, POINT, and MARK.
+Ensure that the message generated by that bounce equals MESSAGE."
+ (should (equal edebug-tests-bounce-outside-buffer
+ (get-buffer buffer-or-name)))
+ (should (equal edebug-tests-bounce-outside-point point))
+ (should (equal edebug-tests-bounce-outside-mark mark))
+ (should (string-match-p (concat (regexp-quote message) "$")
+ edebug-tests-messages)))
+
(defun edebug-tests-locate-def (def-name)
"Search for a definition of DEF-NAME from the start of the current buffer.
Place point at the end of DEF-NAME in the buffer."
@@ -419,9 +442,9 @@ test and possibly others should be updated."
(verify-keybinding "\C-x\C-e" 'edebug-eval-last-sexp)
(verify-keybinding "E" 'edebug-visit-eval-list)
(verify-keybinding "w" 'edebug-where)
- (verify-keybinding "v" 'edebug-view-outside) ;; maybe obsolete??
+ (verify-keybinding "v" 'edebug-view-outside)
(verify-keybinding "p" 'edebug-bounce-point)
- (verify-keybinding "P" 'edebug-view-outside) ;; same as v
+ (verify-keybinding "P" 'edebug-bounce-to-previous-value)
(verify-keybinding "W" 'edebug-toggle-save-windows)
(verify-keybinding "?" 'edebug-help)
(verify-keybinding "d" 'edebug-pop-to-backtrace)
@@ -703,6 +726,95 @@ test and possibly others should be updated."
edebug-tests-messages))
"g" (should (equal edebug-tests-@-result '(0 1))))))
+(ert-deftest edebug-tests-bounce-point ()
+ "Edebug can bounce point."
+ (unwind-protect
+ (cl-letf* (((symbol-function 'sit-for)
+ #'edebug-tests-bounce-record-outside-environment))
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "bounce-point" nil t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at
+ "bounce-point" "start")
+ (goto-char (edebug-tests-get-stop-point "bounce-point" "goto-char"))
+ "h" (edebug-tests-should-be-at
+ "bounce-point" "goto-char")
+ "p" (edebug-tests-should-have-bounced-to
+ "*edebug-test-code-buffer*" 6 nil
+ "Current buffer: *edebug-test-code-buffer* Point: 6 Mark: ")
+ "SPC SPC" (edebug-tests-should-be-at
+ "bounce-point" "push-mark")
+ "p" (edebug-tests-should-have-bounced-to
+ "*edebug-test-code-buffer*" 6 1
+ "Current buffer: *edebug-test-code-buffer* Point: 6 Mark: 1")
+ "g")))
+ (when (get-buffer "*edebug-test-code-buffer*")
+ (kill-buffer "*edebug-test-code-buffer*"))))
+
+(ert-deftest edebug-tests-bounce-to-previous-value ()
+ "Edebug can bounce to previous value."
+ (unwind-protect
+ (cl-letf* (((symbol-function 'sit-for)
+ #'edebug-tests-bounce-record-outside-environment))
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "bounce-point" nil t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at
+ "bounce-point" "start")
+ (goto-char (edebug-tests-get-stop-point "bounce-point" "clear-mark"))
+ "h" (edebug-tests-should-be-at
+ "bounce-point" "clear-mark")
+ ;; Bounce to previous values seen while single-stepping.
+ "SPC SPC" (edebug-tests-should-be-at "bounce-point" "1")
+ "P" (edebug-tests-should-have-bounced-to
+ "*edebug-test-code-buffer*" 5 nil
+ "Current buffer: *edebug-test-code-buffer* Point: 1 (< Point min: 5)")
+ "SPC SPC" (edebug-tests-should-be-at "bounce-point" "6")
+ "P" (edebug-tests-should-have-bounced-to
+ "*edebug-test-code-buffer*" 6 nil
+ "Current buffer: *edebug-test-code-buffer* Point: 6")
+ "SPC SPC" (edebug-tests-should-be-at "bounce-point" "10")
+ "P" (edebug-tests-should-have-bounced-to
+ "*edebug-test-code-buffer*" 9 nil
+ "Current buffer: *edebug-test-code-buffer* Point: 10 (> Point max: 9)")
+ ;; Bounce to previous value obtained through evaluation.
+ "e 7 RET"
+ "P" (edebug-tests-should-have-bounced-to
+ "*edebug-test-code-buffer*" 7 nil
+ "Current buffer: *edebug-test-code-buffer* Point: 7")
+ "g")))
+ (when (get-buffer "*edebug-test-code-buffer*")
+ (kill-buffer "*edebug-test-code-buffer*"))))
+
+(ert-deftest edebug-tests-bounce-to-previous-non-position ()
+ "Edebug does not bounce to previous non-position."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "fac" '(1) t)
+ (let* ((debug-on-error nil)
+ (edebug-on-error nil)
+ error-message
+ (command-error-function (lambda (&rest args)
+ (setq error-message (cadar args)))))
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "fac" "start")
+ ;; Bounce to previous non-position seen while single-stepping.
+ "SPC SPC SPC"
+ (edebug-tests-should-match-result-in-messages "t")
+ "P" (should (string-match-p "Previous value not a number or marker"
+ error-message))
+ ;; The error stopped the keyboard macro. Start it again.
+ (should-not executing-kbd-macro)
+ (setq executing-kbd-macro t
+ error-message nil)
+ ;; Bounce to previous non-position obtained through evaluation.
+ "e nil RET"
+ "P" (should (string-match-p "Previous value not a number or marker"
+ error-message))
+ (should-not executing-kbd-macro)
+ (setq executing-kbd-macro t
+ error-message nil)
+ "g"))))
+
(ert-deftest edebug-tests-step-into-function ()
"Edebug can step into a function."
(edebug-tests-with-normal-env
@@ -838,20 +950,23 @@ test and possibly others should be updated."
(ert-deftest edebug-tests-evaluation-of-current-buffer-bug-19611 ()
"Edebug can evaluate `current-buffer' in correct context. (Bug#19611)."
- (edebug-tests-with-normal-env
- (edebug-tests-setup-@ "current-buffer" nil t)
- (edebug-tests-run-kbd-macro
- "@" (edebug-tests-should-be-at
- "current-buffer" "start")
- "SPC SPC SPC" (edebug-tests-should-be-at
- "current-buffer" "body")
- "e (current-buffer) RET"
- ;; Edebug just prints the result without "Result:"
- (should (string-match-p
- (regexp-quote "*edebug-test-code-buffer*")
- edebug-tests-messages))
- "g" (should (equal edebug-tests-@-result
- "current-buffer: *edebug-test-code-buffer*")))))
+ (unwind-protect
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "current-buffer" nil t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at
+ "current-buffer" "start")
+ "SPC SPC SPC" (edebug-tests-should-be-at
+ "current-buffer" "body")
+ "e (current-buffer) RET"
+ ;; Edebug just prints the result without "Result:"
+ (should (string-match-p
+ (regexp-quote "*edebug-test-code-buffer*")
+ edebug-tests-messages))
+ "g" (should (equal edebug-tests-@-result
+ "current-buffer: *edebug-test-code-buffer*"))))
+ (when (get-buffer "*edebug-test-code-buffer*")
+ (kill-buffer "*edebug-test-code-buffer*"))))
(ert-deftest edebug-tests-trivial-backquote ()
"Edebug can instrument a trivial backquote expression (Bug#23651)."
diff --git a/test/lisp/emacs-lisp/let-alist-tests.el b/test/lisp/emacs-lisp/let-alist-tests.el
index 988b05b488c..b23178f5467 100644
--- a/test/lisp/emacs-lisp/let-alist-tests.el
+++ b/test/lisp/emacs-lisp/let-alist-tests.el
@@ -100,4 +100,15 @@ See Bug#24641."
`[,(+ .a) ,(+ .a .b .b)])
[1 5])))
+(ert-deftest let-alist-numbers ()
+ "Check that .num indexes into lists."
+ (should (equal
+ (let-alist
+ '(((a . val1) (b . (nil val2)))
+ (c . (val3)))
+ (list .0 .0.a .0.b.1 .c.0))
+ ;; .0 is interpreted as a number, so we can't use `let-alist'
+ ;; to do indexing alone. Everything else works though.
+ '(0.0 val1 val2 val3))))
+
;;; let-alist-tests.el ends here
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index bfc12d919c0..13a3e107d38 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -52,7 +52,6 @@
(defun erc-fill-tests--wrap-populate (test)
(let ((original-window-buffer (window-buffer (selected-window)))
- (erc-fill--wrap-scrolltobottom-exempt-p t)
(erc-stamp--tz t)
(erc-fill-function 'erc-fill-wrap)
(pre-command-hook pre-command-hook)
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el
index f193f3fb070..ce7595363c9 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -150,7 +150,6 @@
(timer-list (copy-sequence timer-list))
(timer-idle-list (copy-sequence timer-idle-list))
(erc-auth-source-parameters-join-function nil)
- (erc-fill--wrap-scrolltobottom-exempt-p t)
(erc-autojoin-channels-alist nil)
(erc-server-auto-reconnect nil)
(erc-after-connect nil)
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index e4cd3a27c2d..d1e1ac25007 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -519,8 +519,9 @@ When returning, they are deleted."
We cannot pass arguments, so we assume that `file-notify--test-event'
and `file-notify--test-file' are bound somewhere."
;; Check the descriptor.
- (should (equal (file-notify--test-event-desc file-notify--test-event)
- file-notify--test-desc))
+ (unless (eq (file-notify--test-event-action file-notify--test-event) 'stopped)
+ (should (equal (file-notify--test-event-desc file-notify--test-event)
+ file-notify--test-desc)))
;; Check the file name.
(should
(string-prefix-p
@@ -1439,7 +1440,8 @@ the file watch."
(:random deleted deleted deleted stopped))
(delete-file file-notify--test-tmpfile))
(should (file-notify-valid-p file-notify--test-desc1))
- (should-not (file-notify-valid-p file-notify--test-desc2))
+ (unless (string-equal (file-notify--test-library) "w32notify")
+ (should-not (file-notify-valid-p file-notify--test-desc2)))
;; Now we delete the directory.
(file-notify--test-with-actions
diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el
index 718e4712e4e..f7e42978b80 100644
--- a/test/lisp/info-xref-tests.el
+++ b/test/lisp/info-xref-tests.el
@@ -165,11 +165,11 @@ text.
(skip-unless (file-readable-p "emacs.info"))
(info-xref-check-all)
(with-current-buffer info-xref-output-buffer
+ (message "%s" (buffer-substring-no-properties (point-min) (point-max)))
(goto-char (point-max))
(should (search-backward "done" nil t))
(should (string-match-p
" [0-9]\\{3,\\} good, 0 bad"
(buffer-substring-no-properties (pos-bol) (pos-eol)))))))
-
;;; info-xref-tests.el ends here
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index f9a26d17e58..de1a98c8189 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -100,10 +100,10 @@
;; Test that $$ in input is properly unquoted.
("data/m-cttq$$t" "data/minibuffer-test-cttq$$tion")
;; Test that env-vars are preserved.
- ("lisp/c${CTTQ1}et/se-u" "lisp/c${CTTQ1}et/semantic-utest")
- ("lisp/ced${CTTQ2}se-u" "lisp/ced${CTTQ2}semantic-utest")
+ ("lisp/c${CTTQ1}et/se-u-c" "lisp/c${CTTQ1}et/semantic-utest-c.test")
+ ("lisp/ced${CTTQ2}se-u-c" "lisp/ced${CTTQ2}semantic-utest-c.test")
;; Test that env-vars don't prevent partial-completion.
- ("lis/c${CTTQ1}/se-u" "lisp/c${CTTQ1}et/semantic-utest")
+ ("lis/c${CTTQ1}/se-u-c" "lisp/c${CTTQ1}et/semantic-utest-c.test")
))
(should (equal (completion-try-completion input
#'completion--file-name-table
@@ -118,11 +118,11 @@
;; When an env var is in the completion bounds, try-completion
;; won't change letter case.
("lisp/c${CTTQ1}E" "lisp/c${CTTQ1}Et/")
- ("lisp/ced${CTTQ2}SE-U" "lisp/ced${CTTQ2}SEmantic-utest")
+ ("lisp/ced${CTTQ2}SE-U-c" "lisp/ced${CTTQ2}SEmantic-utest-c.test")
;; If the env var is before the completion bounds, try-completion
;; *will* change letter case.
- ("lisp/c${CTTQ1}et/SE-U" "lisp/c${CTTQ1}et/semantic-utest")
- ("lis/c${CTTQ1}/SE-U" "lisp/c${CTTQ1}et/semantic-utest")
+ ("lisp/c${CTTQ1}et/SE-U-c" "lisp/c${CTTQ1}et/semantic-utest-c.test")
+ ("lis/c${CTTQ1}/SE-U-c" "lisp/c${CTTQ1}et/semantic-utest-c.test")
))
(should (equal (car (completion-try-completion input
#'completion--file-name-table
@@ -224,7 +224,11 @@
(completion-pcm--merge-try '("tes" point "ing")
'("Testing" "testing")
"" ""))
- '("testing" . 4))))
+ '("testing" . 7)))
+ (should (equal
+ (let ((completion-ignore-case t))
+ (completion-pcm-try-completion "tes" '("Testing" "testing") nil 3))
+ '("testing" . 7))))
(ert-deftest completion-pcm-test-1 ()
;; Point is at end, this does not match anything
@@ -318,6 +322,31 @@
'(prefix any "bar" any) '("xbarxfoo" "ybaryfoo") "" "")
'("bar" . 3))))
+(ert-deftest completion-pcm-test-8 ()
+ ;; try-completion inserts the common prefix and suffix at point.
+ (should (equal (completion-pcm-try-completion
+ "r" '("fooxbar" "fooybar") nil 0)
+ '("foobar" . 3)))
+ ;; Even if point is at the end of the minibuffer.
+ (should (equal (completion-pcm-try-completion
+ "" '("fooxbar" "fooybar") nil 0)
+ '("foobar" . 3))))
+
+(ert-deftest completion-pcm-test-anydelim ()
+ ;; After each delimiter is a special wildcard which matches any
+ ;; sequence of delimiters.
+ (should (equal (completion-pcm-try-completion
+ "-x" '("-_.x" "-__x") nil 2)
+ '("-_x" . 3))))
+
+(ert-deftest completion-pcm-bug4219 ()
+ ;; With `completion-ignore-case', try-completion should change the
+ ;; case of existing text when the completions have different casing.
+ (should (equal
+ (let ((completion-ignore-case t))
+ (completion-pcm-try-completion "a" '("ABC" "ABD") nil 1))
+ '("AB" . 2))))
+
(ert-deftest completion-substring-test-1 ()
;; One third of a match!
(should (equal
@@ -419,6 +448,17 @@
15)))
+(defmacro with-minibuffer-setup (completing-read &rest body)
+ (declare (indent 1) (debug (collection body)))
+ `(catch 'result
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (let ((redisplay-skip-initial-frame nil)
+ (executing-kbd-macro nil)) ; Don't skip redisplay
+ (throw 'result (progn . ,body))))
+ (let ((executing-kbd-macro t)) ; Force the real minibuffer
+ ,completing-read))))
+
(defmacro completing-read-with-minibuffer-setup (collection &rest body)
(declare (indent 1) (debug (collection body)))
`(catch 'result
@@ -440,21 +480,21 @@
'("a" "ab" "ac")
(execute-kbd-macro (kbd "a TAB TAB"))
(should (equal (car messages) "Complete, but not unique"))
- (should-not (get-buffer-window "*Completions*" 0))
+ (should-not (minibuffer--completions-visible))
(execute-kbd-macro (kbd "b TAB"))
(should (equal (car messages) "Sole completion"))))
(let ((completion-auto-help t))
(completing-read-with-minibuffer-setup
'("a" "ab" "ac")
(execute-kbd-macro (kbd "a TAB TAB"))
- (should (get-buffer-window "*Completions*" 0))
+ (should (minibuffer--completions-visible))
(execute-kbd-macro (kbd "b TAB"))
(should (equal (car messages) "Sole completion"))))
(let ((completion-auto-help 'visible))
(completing-read-with-minibuffer-setup
'("a" "ab" "ac" "achoo")
(execute-kbd-macro (kbd "a TAB TAB"))
- (should (get-buffer-window "*Completions*" 0))
+ (should (minibuffer--completions-visible))
(execute-kbd-macro (kbd "ch TAB"))
(should (equal (car messages) "Sole completion")))))))
@@ -463,19 +503,19 @@
(completing-read-with-minibuffer-setup
'("aa" "ab" "ac")
(execute-kbd-macro (kbd "a TAB"))
- (should (and (get-buffer-window "*Completions*" 0)
+ (should (and (minibuffer--completions-visible)
(eq (current-buffer) (get-buffer "*Completions*"))))
(execute-kbd-macro (kbd "TAB TAB TAB"))
- (should (and (get-buffer-window "*Completions*" 0)
+ (should (and (minibuffer--completions-visible)
(eq (current-buffer) (get-buffer " *Minibuf-1*"))))
(execute-kbd-macro (kbd "S-TAB"))
- (should (and (get-buffer-window "*Completions*" 0)
+ (should (and (minibuffer--completions-visible)
(eq (current-buffer) (get-buffer "*Completions*"))))))
(let ((completion-auto-select 'second-tab))
(completing-read-with-minibuffer-setup
'("aa" "ab" "ac")
(execute-kbd-macro (kbd "a TAB"))
- (should (and (get-buffer-window "*Completions*" 0)
+ (should (and (minibuffer--completions-visible)
(not (eq (current-buffer) (get-buffer "*Completions*")))))
(execute-kbd-macro (kbd "TAB TAB"))
(should (eq (current-buffer) (get-buffer "*Completions*"))))))
@@ -555,6 +595,7 @@
(ert-deftest completions-header-format-test ()
(let ((completion-show-help nil)
+ (minibuffer-completion-auto-choose t)
(completions-header-format nil))
(completing-read-with-minibuffer-setup
'("aa" "ab" "ac")
@@ -704,11 +745,50 @@
(should (equal (minibuffer-contents) "ccc")))))
(ert-deftest minibuffer-next-completion ()
- (let ((default-directory (ert-resource-directory)))
+ (let ((default-directory (ert-resource-directory))
+ (minibuffer-completion-auto-choose t))
(completing-read-with-minibuffer-setup #'read-file-name-internal
(insert "d/")
(execute-kbd-macro (kbd "M- M- M-"))
(should (equal "data/minibuffer-test-cttq$$tion" (minibuffer-contents))))))
+(ert-deftest minibuffer-completion-RET-prefix ()
+ ;; REQUIRE-MATCH=nil
+ (with-minibuffer-setup
+ (completing-read ":" '("aaa" "bbb" "ccc") nil nil)
+ (execute-kbd-macro (kbd "M- M- C-u RET"))
+ (should (equal "bbb" (minibuffer-contents))))
+ ;; REQUIRE-MATCH=t
+ (with-minibuffer-setup
+ (completing-read ":" '("aaa" "bbb" "ccc") nil t)
+ (execute-kbd-macro (kbd "M- M- C-u RET"))
+ (should (equal "bbb" (minibuffer-contents)))))
+
+(defun test/completion-at-point ()
+ (list (point-min) (point) '("test:a" "test:b")))
+
+(ert-deftest completion-in-region-next-completion ()
+ (with-current-buffer (get-buffer-create "*test*")
+ ;; Put this buffer in the selected window so
+ ;; `minibuffer--completions-visible' works.
+ (pop-to-buffer (current-buffer))
+ (setq-local completion-at-point-functions (list #'test/completion-at-point))
+ (insert "test:")
+ (completion-help-at-point)
+ (should (minibuffer--completions-visible))
+ ;; C-u RET and RET have basically the same behavior for
+ ;; completion-in-region-mode, since they both dismiss *Completions*
+ ;; while leaving completion-in-region-mode still active.
+ (execute-kbd-macro (kbd "M-"))
+ (should (equal (completion--selected-candidate) "test:a"))
+ (execute-kbd-macro (kbd "C-u RET"))
+ (should (equal (buffer-string) "test:a"))
+ (delete-char -1)
+ (completion-help-at-point)
+ (execute-kbd-macro (kbd "M- M-"))
+ (should (equal (completion--selected-candidate) "test:b"))
+ (execute-kbd-macro (kbd "RET"))
+ (should (equal (buffer-string) "test:b"))))
+
(provide 'minibuffer-tests)
;;; minibuffer-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 4438e0090d4..8c230f43cf3 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -68,6 +68,7 @@
(require 'vc-git)
(require 'vc-hg)
+(declare-function edebug-mode "edebug")
(declare-function project-mode-line-format "project")
(declare-function tramp-check-remote-uname "tramp-sh")
(declare-function tramp-find-executable "tramp-sh")
@@ -90,6 +91,9 @@
(defvar tramp-remote-process-environment)
(defvar tramp-use-connection-share)
+;; Declared in Emacs 29.1.
+(defvar completions-max-height)
+
;; Declared in Emacs 30.1.
(defvar project-mode-line)
(defvar remote-file-name-access-timeout)
@@ -215,7 +219,10 @@ is greater than 10.
(kill-buffer buf))))))
(defsubst tramp--test-message (fmt-string &rest arguments)
- "Emit a message into ERT *Messages*."
+ "Emit a message into \"ERT *Messages*\" and the trace buffer."
+ (declare (tramp-suppress-trace t))
+ (when (get-buffer trace-buffer)
+ (trace-values (apply #'format fmt-string arguments)))
(tramp--test-instrument-test-case 0
(apply #'tramp-message tramp-test-vec 0 fmt-string arguments)))
@@ -4857,6 +4864,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(host (file-remote-p ert-remote-temporary-file-directory 'host))
(orig-syntax tramp-syntax)
(minibuffer-completing-file-name t))
+ ;; `file-remote-p' returns as host the string "host#port", which
+ ;; isn't useful.
(when (and (stringp host)
(string-match
(rx (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp))
@@ -4868,7 +4877,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(tramp-syntax-values) `(,orig-syntax)))
(tramp-change-syntax syntax)
;; This has cleaned up all connection data, which are used
- ;; for completion. We must refill the cache.
+ ;; for completion. We must refill the cache in order to get
+ ;; at least one completion candidate.
(tramp-set-connection-property tramp-test-vec "completion-use-cache" t)
(let (;; This is needed for the `separate' syntax.
@@ -4883,6 +4893,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Complete method name.
(unless (or (tramp-string-empty-or-nil-p method)
(string-empty-p tramp-method-regexp))
+ ;; `read-directory-name' uses `file-directory-p'.
+ ;; `file-directory-p' works since Emacs 31.
+ ;; (Bug#79236)
+ (when (tramp--test-emacs31-p)
+ (should
+ (file-name-completion
+ (concat prefix-format (substring method 0 1))
+ "/" #'file-directory-p)))
(should
(member
(concat prefix-format method tramp-postfix-method-format)
@@ -4892,6 +4910,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(unless (or (tramp-string-empty-or-nil-p method)
(string-empty-p tramp-method-regexp)
(tramp-string-empty-or-nil-p host))
+ ;; `read-directory-name' uses `file-directory-p'.
+ ;; `file-directory-p' works since Emacs 31.
+ ;; (Bug#79236)
+ (when (tramp--test-emacs31-p)
+ (should
+ (file-name-completion
+ (concat prefix-format method tramp-postfix-method-format)
+ "/" #'file-directory-p)))
(should
(member
(concat
@@ -4979,51 +5005,91 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(tramp--test-deftest-with-ls tramp-test26-file-name-completion)
-;; This test is inspired by Bug#51386, Bug#52758, Bug#53513, Bug#54042
-;; and Bug#60505.
+;; This test is inspired by Bug#51386, Bug#52758, Bug#53513,
+;; Bug#54042, Bug#60505 and Bug#79236.
(ert-deftest tramp-test26-interactive-file-name-completion ()
"Check interactive completion with different `completion-styles'."
+ :tags '(:expensive-test)
+ (skip-unless (tramp--test-enabled))
;; Method, user and host name in completion mode.
- (let ((method (file-remote-p ert-remote-temporary-file-directory 'method))
- (user (file-remote-p ert-remote-temporary-file-directory 'user))
- (host (file-remote-p ert-remote-temporary-file-directory 'host))
- (hop (file-remote-p ert-remote-temporary-file-directory 'hop))
- (orig-syntax tramp-syntax)
- (non-essential t)
- (inhibit-message t))
+ (let* (;; Set this to `t' if you want to run all tests.
+ (expensive nil) ;(tramp--test-expensive-test-p))
+ ;; Set this to `t' if you want to see the traces.
+ (tramp-trace nil)
+ (method (file-remote-p ert-remote-temporary-file-directory 'method))
+ (user (file-remote-p ert-remote-temporary-file-directory 'user))
+ (host (file-remote-p ert-remote-temporary-file-directory 'host))
+ (hop (and expensive
+ (file-remote-p ert-remote-temporary-file-directory 'hop)))
+ ;; All multi-hop capable methods.
+ (method-list
+ (and hop (sort (mapcar
+ (lambda (x)
+ (substring x (length tramp-prefix-format)))
+ (tramp-get-completion-methods "" t)))))
+ (orig-syntax tramp-syntax)
+ (non-essential t)
+ (inhibit-message
+ (and (not tramp-trace) (not (ignore-errors (edebug-mode))))))
+ ;; `file-remote-p' returns as host the string "host#port", which
+ ;; isn't useful.
(when (and (stringp host)
(string-match
(rx (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp))
host))
(setq host (replace-match "" nil nil host)))
- ;; (trace-function #'tramp-completion-file-name-handler)
- ;; (trace-function #'completion-file-name-table)
+ (when tramp-trace
+ (when (get-buffer trace-buffer) (kill-buffer trace-buffer))
+ (dolist
+ (elt (mapcar #'intern (all-completions "tramp-" obarray #'functionp)))
+ (unless (get elt 'tramp-suppress-trace)
+ (trace-function-background elt)))
+ (trace-function-background #'completion-file-name-table)
+ (trace-function-background #'read-file-name))
+
(unwind-protect
(dolist (syntax (if (tramp--test-expensive-test-p)
(tramp-syntax-values) `(,orig-syntax)))
(tramp-change-syntax syntax)
;; This has cleaned up all connection data, which are used
- ;; for completion. We must refill the cache.
+ ;; for completion. We must refill the cache in order to get
+ ;; at least one completion candidate.
(tramp-set-connection-property tramp-test-vec "completion-use-cache" t)
(dolist
(style
- (if (tramp--test-expensive-test-p)
- ;; It doesn't work for `initials' and `shorthand'
- ;; completion styles. Should it?
- ;; `orderless' passes the tests, but it is an ELPA package.
- '(emacs21 emacs22 basic partial-completion substring flex)
+ (if expensive
+ ;; `initials' uses "/" as separator, it doesn't apply here.
+ ;; `shorthand' is about symbols, it doesn't apply here.
+ `(emacs21 emacs22 basic partial-completion substring
+ ;; FIXME: `flex' is not compatible with IPv6 hosts.
+ ,@(unless (string-match-p tramp-ipv6-regexp host) '(flex))
+ ;; `orderless' is an ELPA package.
+ ;; What about `company' backends, `consult',
+ ;; `cider', `helm'?
+ orderless)
'(basic)))
(when (assoc style completion-styles-alist)
(let* (;; Force the real minibuffer in batch mode.
(executing-kbd-macro noninteractive)
+ (confirm-nonexistent-file-or-buffer nil)
(completion-styles `(,style))
completion-category-defaults
completion-category-overrides
- ;; This is needed for the `simplified' syntax,
+ ;; FIXME: Is this TRT for test?
+ (completion-pcm--delim-wild-regex
+ ;; "::1" is a complete word. ":" isn't a
+ ;; delimiter, therefore.
+ (rx-to-string
+ `(any
+ ,(string-replace
+ ":" "" completion-pcm-word-delimiters))))
+ ;; Don't truncate in *Completions* buffer.
+ (completions-max-height most-positive-fixnum)
+ ;; This is needed for the `simplified' syntax.
(tramp-default-method method)
(method-string
(unless (string-empty-p tramp-method-regexp)
@@ -5048,7 +5114,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Needed for host name completion.
(default-user
(file-remote-p
- (concat tramp-prefix-format hop method-string host-string)
+ (concat
+ tramp-prefix-format hop method-string host-string)
'user))
(default-user-string
(unless (tramp-string-empty-or-nil-p default-user)
@@ -5058,8 +5125,18 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(dolist
(test-and-result
;; These are triples of strings (TEST-STRING
- ;; RESULT-CHECK COMPLETION-CHECK).
+ ;; RESULT-CHECK COMPLETION-CHECK). If
+ ;; COMPLETION-CHECK is a list, it is the complete
+ ;; result the contents of *Completions* shall be
+ ;; checked with.
(append
+ ;; Complete hop.
+ (unless (tramp-string-empty-or-nil-p hop)
+ `((,(concat tramp-prefix-format hop)
+ ,(concat tramp-prefix-format hop)
+ ,(if (string-empty-p tramp-method-regexp)
+ (or default-user-string host-string)
+ method-list))))
;; Complete method name.
(unless (string-empty-p tramp-method-regexp)
`((,(concat
@@ -5078,7 +5155,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
tramp-prefix-format hop method-string user-string)
,user-string)))
;; Complete host name.
- (unless (tramp-string-empty-or-nil-p host)
+ (unless (tramp-string-empty-or-nil-p host-string)
`((,(concat
tramp-prefix-format hop method-string
ipv6-prefix
@@ -5089,8 +5166,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
default-user-string host-string)
,host-string)))
;; Complete user and host name.
- (unless (or (tramp-string-empty-or-nil-p user)
- (tramp-string-empty-or-nil-p host))
+ (unless (or (tramp-string-empty-or-nil-p user-string)
+ (tramp-string-empty-or-nil-p host-string))
`((,(concat
tramp-prefix-format hop method-string user-string
ipv6-prefix
@@ -5101,60 +5178,85 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
user-string host-string)
,host-string)))))
- (ignore-errors (kill-buffer "*Completions*"))
- ;; (and (bufferp trace-buffer) (kill-buffer trace-buffer))
- (discard-input)
- (setq test (car test-and-result)
- unread-command-events
- (mapcar #'identity (concat test "\t\t\n"))
- completions nil
- result (read-file-name "Prompt: "))
+ (dolist
+ (predicate
+ (if (and expensive (tramp--test-emacs31-p))
+ ;; `nil' will be expanded to `file-exists-p'.
+ ;; `read-directory-name' uses `file-directory-p'.
+ ;; `file-directory-p' works since Emacs 31.
+ ;; (Bug#79236)
+ '(file-exists-p file-directory-p) '(nil)))
- (if (or (not (get-buffer "*Completions*"))
- (string-match-p
- (if (string-empty-p tramp-method-regexp)
+ (ignore-errors (kill-buffer "*Completions*"))
+ (when tramp-trace
+ (when (get-buffer trace-buffer)
+ (kill-buffer trace-buffer)))
+ (discard-input)
+ (setq test (car test-and-result)
+ unread-command-events
+ (append test '(tab tab return return))
+ completions nil
+ result
+ (read-file-name
+ "Prompt: " nil nil 'confirm nil predicate))
+
+ (if (or (not (get-buffer "*Completions*"))
+ (string-match-p
+ (if (string-empty-p tramp-method-regexp)
+ (rx
+ (| (regexp tramp-postfix-user-regexp)
+ (regexp tramp-postfix-host-regexp))
+ eos)
(rx
- (| (regexp tramp-postfix-user-regexp)
+ (| (regexp tramp-postfix-method-regexp)
+ (regexp tramp-postfix-user-regexp)
(regexp tramp-postfix-host-regexp))
- eos)
- (rx
- (| (regexp tramp-postfix-method-regexp)
- (regexp tramp-postfix-user-regexp)
- (regexp tramp-postfix-host-regexp))
- eos))
- result))
- (progn
- ;; (tramp--test-message
- ;; "syntax: %s style: %s test: %s result: %s"
- ;; syntax style test result)
- (should (string-prefix-p (cadr test-and-result) result)))
+ eos))
+ result))
+ (progn
+ (when tramp-trace
+ (tramp--test-message
+ (concat
+ "syntax: %s style: %s predicate: %s "
+ "test: %s result: %s")
+ syntax style predicate test result))
+ (should
+ (string-prefix-p (cadr test-and-result) result)))
- (with-current-buffer "*Completions*"
- ;; We must remove leading `default-directory'.
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (while (search-forward-regexp "//" nil 'noerror)
- (delete-region (line-beginning-position) (point))))
- (goto-char (point-min))
- (search-forward-regexp
- (rx bol (0+ nonl)
- (any "Pp") "ossible completions"
- (0+ nonl) eol))
- (forward-line 1)
- (setq completions
- (split-string
- (buffer-substring-no-properties (point) (point-max))
- (rx (any "\r\n\t ")) 'omit)))
+ (with-current-buffer "*Completions*"
+ ;; We must remove leading `default-directory'.
+ (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ (while (search-forward-regexp "//" nil 'noerror)
+ (delete-region (line-beginning-position) (point))))
+ (goto-char (point-min))
+ (search-forward-regexp
+ (rx bol (0+ nonl)
+ (any "Pp") "ossible completions"
+ (0+ nonl) eol))
+ (forward-line 1)
+ (setq completions
+ (split-string
+ (buffer-substring-no-properties
+ (point) (point-max))
+ (rx (any "\r\n\t ")) 'omit)))
- ;; (tramp--test-message
- ;; "syntax: %s style: %s test: %s result: %s completions: %S"
- ;; syntax style test result completions)
- (should (member (caddr test-and-result) completions))))))))
+ (when tramp-trace
+ (tramp--test-message
+ (concat
+ "syntax: %s style: %s predicate: %s test: %s "
+ "result: %s completions: %S")
+ syntax style predicate test result completions))
+ (if (stringp (caddr test-and-result))
+ (should
+ (member (caddr test-and-result) completions))
+ (should
+ (equal
+ (caddr test-and-result) (sort completions)))))))))))
;; Cleanup.
- ;; (tramp--test-message "%s" (tramp-get-buffer-string trace-buffer))
- ;; (untrace-function #'tramp-completion-file-name-handler)
- ;; (untrace-function #'completion-file-name-table)
+ (when tramp-trace
+ (untrace-all))
(tramp-change-syntax orig-syntax)
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))
@@ -8471,7 +8573,37 @@ process sentinels. They shall not disturb each other."
(cl-letf (((symbol-function #'ask-user-about-lock) #'always))
(save-buffer)))
(should-not
- (string-match-p "File is missing:" captured-messages))))))
+ (string-match-p "File is missing:" captured-messages)))))
+
+ ;; A modified buffer suppresses session timeout.
+ (with-temp-buffer
+ (set-visited-file-name tmp-name)
+ (insert "foo")
+ (should (buffer-modified-p))
+ (tramp-timeout-session tramp-test-vec)
+ (should
+ (process-live-p (tramp-get-connection-process tramp-test-vec)))
+ ;; Steal the file lock.
+ (cl-letf (((symbol-function #'ask-user-about-lock) #'always))
+ (save-buffer))
+ (tramp-timeout-session tramp-test-vec)
+ (should-not
+ (process-live-p (tramp-get-connection-process tramp-test-vec))))
+
+ ;; An auto-reverted buffer suppresses session timeout.
+ (with-temp-buffer
+ (set-visited-file-name tmp-name)
+ (auto-revert-mode 1)
+ ;; Steal the file lock.
+ (cl-letf (((symbol-function #'ask-user-about-lock) #'always))
+ (save-buffer))
+ (tramp-timeout-session tramp-test-vec)
+ (should
+ (process-live-p (tramp-get-connection-process tramp-test-vec)))
+ (auto-revert-mode -1)
+ (tramp-timeout-session tramp-test-vec)
+ (should-not
+ (process-live-p (tramp-get-connection-process tramp-test-vec)))))
;; Cleanup.
(ignore-errors (delete-file tmp-name))))))
@@ -8782,9 +8914,12 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * tramp-set-file-uid-gid
;; * Work on skipped tests. Make a comment, when it is impossible.
-;; * Use `skip-when' starting with Emacs 30.1.
;; * Revisit expensive tests, once problems in `tramp-error' are solved.
;; * Fix `tramp-test06-directory-file-name' for "ftp".
+;; * In `tramp-test26-file-name-completion', check also user, domain,
+;; port and hop.
+;; * In `tramp-test26-interactive-file-name-completion', should
+;; `completion-pcm--delim-wild-regex' be bound? Check also domain and port.
;; * Check, why a process filter t doesn't work in
;; `tramp-test29-start-file-process' and
;; `tramp-test30-make-process'.
@@ -8796,6 +8931,8 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * Check, why direct async processes do not work for
;; `tramp-test45-asynchronous-requests'.
+;; Use `skip-when' starting with Emacs 30.1.
+
;; Starting with Emacs 29, use `ert-with-temp-file' and
;; `ert-with-temp-directory'.
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts
index ab00e9ce6d4..65ce757d048 100644
--- a/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts
@@ -98,3 +98,50 @@ Name: cperl-keyword-without-space
my %h = map{$_=>1}
@ARGV;
=-=-=
+
+Name: cperl-subroutine-signatures
+
+=-=
+# -*- mode: cperl -*-
+# John Ciolfi reported as Bug#79269
+use strict;
+use warnings;
+use experimental 'signatures';
+
+foo(1);
+
+sub foo (
+ $in1,
+ $optionsHPtr = {},
+ $otherOption1 = 1, # Bug: wrong face for this option
+ ) {
+
+ my $a = 1; # Bug: should be indented by 2 spaces
+
+ # Bug: following are not indented due to use of signatures
+ my $b = 2;
+ return $a + $b + $in1;
+}
+=-=-=
+
+Name: cperl-false-label-in-regex
+
+=-=
+# -*- mode: cperl -*-
+# John Ciolfi reported as Bug#79271
+my $str =~ s/^
+ (Field1: [^\n]+) \s*
+ Field2: \s* (\S+) \s*
+ //xsm;
+=-=-=
+
+Name: cperl-false-label-in-qw
+
+=-=
+# Related to cperl-false-label-in-regex / Bug#79271
+my @chunks = qw(
+ sub
+ LABEL:
+ more words
+ );
+=-=-=
diff --git a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl
index 1f898250252..d95b3d0a453 100644
--- a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl
+++ b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl
@@ -41,6 +41,13 @@ sub sub_6
{
}
+# Braces in initializers (Bug79269)
+sub sub_7
+ ($foo = { },
+ $bar //= "baz")
+{
+}
+
# Part 2: Same constructs for anonymous subs
# A plain named subroutine without any optional stuff
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index 00116986b4b..424e89604b3 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -173,7 +173,7 @@ attributes, prototypes and signatures."
(should (equal (get-text-property (match-beginning 0) 'face)
'font-lock-function-name-face))
(let ((start-of-sub (match-beginning 0))
- (end-of-sub (save-excursion (search-forward "}") (point))))
+ (end-of-sub (save-excursion (search-forward "}\n") (point))))
;; Prototypes are shown as strings
(when (search-forward-regexp " ([$%@*]*) " end-of-sub t)
@@ -1605,6 +1605,9 @@ It must not be mistaken for \"$)\"."
(forward-line 1))))
(ert-deftest test-indentation ()
+ ;; The erts file explicitly invokes cperl-mode, so skip in perl-mode.
+ ;; Indentation defaults are different, so it won't pass in perl-mode
+ (skip-unless (eq cperl-test-mode #'cperl-mode))
(ert-test-erts-file (ert-resource-file "cperl-indents.erts")))
;;; cperl-mode-tests.el ends here
diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el
index 2b98da4134b..b01b7d269ec 100644
--- a/test/lisp/progmodes/eglot-tests.el
+++ b/test/lisp/progmodes/eglot-tests.el
@@ -710,6 +710,7 @@ directory hierarchy."
;; This originally appeared in github#1339
(skip-unless (executable-find "rust-analyzer"))
(skip-unless (executable-find "cargo"))
+ (skip-when (getenv "EMACS_EMBA_CI"))
(eglot--with-fixture
'(("cmpl-project" .
(("main.rs" .
@@ -1468,6 +1469,10 @@ GUESSED-MAJOR-MODES-SYM are bound to the useful return values of
(should (string-suffix-p "c%3A/Users/Foo/bar.lisp"
(eglot-path-to-uri "c:/Users/Foo/bar.lisp"))))
+(ert-deftest eglot-test-path-to-uri-escape ()
+ (should (equal "file:///path/with%20%25%20funny%20%3F%20characters"
+ (eglot-path-to-uri "/path/with % funny ? characters"))))
+
(ert-deftest eglot-test-same-server-multi-mode ()
"Check single LSP instance manages multiple modes in same project."
(skip-unless (executable-find "clangd"))
diff --git a/test/lisp/progmodes/lua-mode-resources/font-lock.lua b/test/lisp/progmodes/lua-mode-resources/font-lock.lua
new file mode 100644
index 00000000000..bcf77b632c2
--- /dev/null
+++ b/test/lisp/progmodes/lua-mode-resources/font-lock.lua
@@ -0,0 +1,184 @@
+#!/usr/bin/env lua
+-- ^ font-lock-comment-face
+-- Comment
+-- <- font-lock-comment-delimiter-face
+-- ^ font-lock-comment-face
+--[[
+-- ^ font-lock-comment-face
+Multi-line comment
+-- ^ font-lock-comment-face
+]]
+-- <- font-lock-comment-face
+local line_comment = "comment" -- comment
+-- ^ font-lock-comment-face
+
+-- Definition
+local function f1() end
+-- ^ font-lock-function-name-face
+local f2 = function() end
+-- ^ font-lock-function-name-face
+local tb = { f1 = function() end }
+-- ^ font-lock-function-name-face
+function tb.f2() end
+-- ^ font-lock-function-name-face
+function tb:f3() end
+-- ^ font-lock-function-name-face
+tbl.f4 = function() end
+-- ^ font-lock-function-name-face
+function x.y:z() end
+-- ^ font-lock-function-name-face
+
+-- Keyword
+if true then
+-- <- font-lock-keyword-face
+-- ^ font-lock-keyword-face
+elseif true then
+-- <- font-lock-keyword-face
+else end
+-- <- font-lock-keyword-face
+-- ^ font-lock-keyword-face
+local p = {}
+-- ^ font-lock-keyword-face
+for k,v in pairs({}) do end
+-- <- font-lock-keyword-face
+-- ^ font-lock-keyword-face
+repeat if true then break end until false
+-- <- font-lock-keyword-face
+-- ^ font-lock-keyword-face
+-- ^ font-lock-keyword-face
+while true do end
+-- <- font-lock-keyword-face
+-- ^ font-lock-keyword-face
+function fn() return true end
+-- <- font-lock-keyword-face
+-- ^ font-lock-keyword-face
+goto label1
+-- ^ font-lock-keyword-face
+::label1::
+if true and not false or nil then
+-- ^ font-lock-keyword-face
+-- ^ font-lock-keyword-face
+-- ^ font-lock-keyword-face
+end
+
+-- String
+local _
+_ = "x"
+-- ^ font-lock-string-face
+_ = 'x'
+-- ^ font-lock-string-face
+_ = "x\ty"
+-- ^ font-lock-string-face
+-- ^ font-lock-string-face
+_ = "x\"y"
+-- ^ font-lock-string-face
+-- ^ font-lock-string-face
+_ = 'x\'y'
+-- ^ font-lock-string-face
+-- ^ font-lock-string-face
+_ = "x\z
+ y"
+-- ^ font-lock-string-face
+_ = "x\0900y"
+-- ^ font-lock-string-face
+_ = "x\09y"
+-- ^ font-lock-string-face
+_ = "x\0y"
+-- ^ font-lock-string-face
+_ = "x\u{1f602}y"
+-- ^ font-lock-string-face
+_ = [[x]]
+-- ^ font-lock-string-face
+_ = [=[x]=]
+-- ^ font-lock-string-face
+
+-- Assignment
+local n = 0
+-- ^ font-lock-variable-name-face
+for i=0,9 do end
+-- ^ font-lock-variable-name-face
+
+-- Constant
+::label2::
+-- ^ font-lock-constant-face
+goto label2
+-- ^ font-lock-constant-face
+
+-- Builtin
+assert()
+-- <- font-lock-builtin-face
+bit32()
+-- <- font-lock-builtin-face
+collectgarbage()
+-- <- font-lock-builtin-face
+coroutine()
+-- <- font-lock-builtin-face
+debug()
+-- <- font-lock-builtin-face
+dofile()
+-- <- font-lock-builtin-face
+error()
+-- <- font-lock-builtin-face
+getmetatable()
+-- <- font-lock-builtin-face
+io()
+-- <- font-lock-builtin-face
+ipairs()
+-- <- font-lock-builtin-face
+load()
+-- <- font-lock-builtin-face
+loadfile()
+-- <- font-lock-builtin-face
+math()
+-- <- font-lock-builtin-face
+next()
+-- <- font-lock-builtin-face
+os()
+-- <- font-lock-builtin-face
+package()
+-- <- font-lock-builtin-face
+pairs()
+-- <- font-lock-builtin-face
+pcall()
+-- <- font-lock-builtin-face
+print()
+-- <- font-lock-builtin-face
+rawequal()
+-- <- font-lock-builtin-face
+rawget()
+-- <- font-lock-builtin-face
+rawlen()
+-- <- font-lock-builtin-face
+rawset()
+-- <- font-lock-builtin-face
+require()
+-- <- font-lock-builtin-face
+select()
+-- <- font-lock-builtin-face
+setmetatable()
+-- <- font-lock-builtin-face
+string()
+-- <- font-lock-builtin-face
+table()
+-- <- font-lock-builtin-face
+tonumber()
+-- <- font-lock-builtin-face
+tostring()
+-- <- font-lock-builtin-face
+type()
+-- <- font-lock-builtin-face
+utf8()
+-- <- font-lock-builtin-face
+warn()
+-- <- font-lock-builtin-face
+xpcall()
+-- <- font-lock-builtin-face
+print(_G)
+-- ^ font-lock-builtin-face
+print(_VERSION)
+-- ^ font-lock-builtin-face
+
+-- Variable
+function fn(x, y) end
+-- ^ font-lock-variable-name-face
+-- ^ font-lock-variable-name-face
diff --git a/test/lisp/progmodes/lua-mode-resources/hide-show.lua b/test/lisp/progmodes/lua-mode-resources/hide-show.lua
new file mode 100644
index 00000000000..a23b46437bf
--- /dev/null
+++ b/test/lisp/progmodes/lua-mode-resources/hide-show.lua
@@ -0,0 +1,35 @@
+--[[
+This is a
+comment block.
+]]
+local function fun ()
+ print("fun")
+end
+local f = (function ()
+ print(1)
+end)
+for i = 1, 10 do
+ print(i)
+end
+repeat
+ print("repeat")
+until false
+while true do
+ print("while")
+end
+do
+ print(1)
+end
+if true then
+ print(1)
+elseif false then
+ print(0)
+else
+ print(0)
+end
+function f1 (has,
+ lots,
+ of,
+ parameters)
+ print("ok")
+end
diff --git a/test/lisp/progmodes/lua-mode-resources/indent.erts b/test/lisp/progmodes/lua-mode-resources/indent.erts
new file mode 100644
index 00000000000..8b4d8dd0921
--- /dev/null
+++ b/test/lisp/progmodes/lua-mode-resources/indent.erts
@@ -0,0 +1,1061 @@
+Code:
+ (lambda ()
+ (lua-mode)
+ (setq-local indent-tabs-mode nil)
+ (setq-local lua-indent-level 2)
+ (indent-region (point-min) (point-max)))
+
+Name: Function Indent 1
+
+=-=
+function f1(n)
+print(n)
+return n + 1
+end
+=-=
+function f1(n)
+ print(n)
+ return n + 1
+end
+=-=-=
+
+Name: Function Indent 2
+
+=-=
+local function f2(n)
+print(n)
+return n * 2
+end
+=-=
+local function f2(n)
+ print(n)
+ return n * 2
+end
+=-=-=
+
+Name: Function Indent 3
+
+=-=
+local f3 = function(n)
+print(n)
+return n / 3
+end
+=-=
+local f3 = function(n)
+ print(n)
+ return n / 3
+end
+=-=-=
+
+Name: Function Indent 4
+
+=-=
+function f4(...)
+local f = function (...)
+if ok
+then print(1)
+else print(0)
+end
+end
+return f
+end
+=-=
+function f4(...)
+ local f = function (...)
+ if ok
+ then print(1)
+ else print(0)
+ end
+ end
+ return f
+end
+=-=-=
+
+Name: Function Indent 5
+
+=-=
+function f5(...)
+local f = function (...)
+if ok
+then
+print(1)
+else
+print(0)
+end
+end
+return f
+end
+=-=
+function f5(...)
+ local f = function (...)
+ if ok
+ then
+ print(1)
+ else
+ print(0)
+ end
+ end
+ return f
+end
+=-=-=
+
+Name: Function Indent 6
+
+=-=
+function f6(...)
+local f = function (...)
+if ok then
+print(1)
+else
+print(0)
+end
+end
+return f
+end
+=-=
+function f6(...)
+ local f = function (...)
+ if ok then
+ print(1)
+ else
+ print(0)
+ end
+ end
+ return f
+end
+=-=-=
+
+Name: Function Indent 7
+
+=-=
+f7(function()
+print'ok'
+end)
+=-=
+f7(function()
+ print'ok'
+end)
+=-=-=
+
+Name: Function Indent 8
+
+=-=
+;(function ()
+ return true
+ end)()
+=-=
+;(function ()
+ return true
+ end)()
+=-=-=
+
+Name: Conditional Indent 1
+
+=-=
+if true then
+print(true)
+return 1
+elseif false then
+print(false)
+return -1
+else
+print(nil)
+return 0
+end
+=-=
+if true then
+ print(true)
+ return 1
+elseif false then
+ print(false)
+ return -1
+else
+ print(nil)
+ return 0
+end
+=-=-=
+
+Name: Conditional Indent 2
+
+=-=
+if true
+ then
+ print(true)
+ return 1
+ elseif false
+ then
+ print(false)
+ return -1
+ else
+ print(nil)
+ return 0
+end
+=-=
+if true
+then
+ print(true)
+ return 1
+elseif false
+then
+ print(false)
+ return -1
+else
+ print(nil)
+ return 0
+end
+=-=-=
+
+Name: Conditional Indent 3
+
+=-=
+if true
+ then return 1
+ elseif false
+ then return -1
+ else return 0
+end
+=-=
+if true
+then return 1
+elseif false
+then return -1
+else return 0
+end
+=-=-=
+
+Name: Loop Indent 1
+
+=-=
+for k,v in pairs({}) do
+ print(k)
+ print(v)
+end
+=-=
+for k,v in pairs({}) do
+ print(k)
+ print(v)
+end
+=-=-=
+
+Name: Loop Indent 2
+
+=-=
+for i=1,10
+ do print(i)
+end
+=-=
+for i=1,10
+do print(i)
+end
+=-=-=
+
+Name: Loop Indent 3
+
+=-=
+while n < 10 do
+ n = n + 1
+ print(n)
+end
+=-=
+while n < 10 do
+ n = n + 1
+ print(n)
+end
+=-=-=
+
+Name: Loop Indent 4
+
+=-=
+while n < 10
+ do
+ n = n + 1
+ print(n)
+end
+=-=
+while n < 10
+do
+ n = n + 1
+ print(n)
+end
+=-=-=
+
+Name: Loop Indent 5
+
+=-=
+for i=0,9 do
+repeat n = n+1
+ until n > 99
+end
+=-=
+for i=0,9 do
+ repeat n = n+1
+ until n > 99
+end
+=-=-=
+
+Name: Loop Indent 6
+
+=-=
+repeat
+z = z * 2
+print(z)
+until z > 12
+=-=
+repeat
+ z = z * 2
+ print(z)
+until z > 12
+=-=-=
+
+Name: Loop Indent 7
+
+=-=
+for i,x in ipairs(t) do
+while i < 9
+do
+local n = t[x]
+repeat n = n + 1
+until n > #t
+while n < 99
+do
+print(n)
+end
+end
+print(t[i])
+end
+=-=
+for i,x in ipairs(t) do
+ while i < 9
+ do
+ local n = t[x]
+ repeat n = n + 1
+ until n > #t
+ while n < 99
+ do
+ print(n)
+ end
+ end
+ print(t[i])
+end
+=-=-=
+
+Name: Loop Indent 8
+
+=-=
+do
+local a = b
+print(a + 1)
+end
+=-=
+do
+ local a = b
+ print(a + 1)
+end
+=-=-=
+
+Name: Bracket Indent 1
+
+=-=
+fn(
+ )
+=-=
+fn(
+)
+=-=-=
+
+Name: Bracket Indent 2
+
+=-=
+tb={
+ }
+=-=
+tb={
+}
+=-=-=
+
+Name: Multi-line String Indent 1
+
+=-=
+local s = [[
+ Multi-line
+ string content
+ ]]
+=-=-=
+
+Name: Multi-line String Indent 2
+
+=-=
+function f()
+ local str = [[
+ multi-line
+ string
+ ]]
+return true
+end
+=-=
+function f()
+ local str = [[
+ multi-line
+ string
+ ]]
+ return true
+end
+=-=-=
+
+Name: Multi-line Comment Indent 1
+
+=-=
+--[[
+ Multi-line
+ comment content
+]]
+=-=-=
+
+Name: Multi-line Comment Indent 2
+
+=-=
+function f()
+ --[[
+ multi-line
+ comment
+ ]]
+ return true
+end
+=-=-=
+
+Name: Multi-line Comment Indent 3
+
+=-=
+ --[[
+ Long comment.
+ ]]
+=-=-=
+
+Name: Comment Indent 1
+
+=-=
+local fn1 = function (a, b)
+-- comment
+return a + b
+end
+=-=
+local fn1 = function (a, b)
+ -- comment
+ return a + b
+end
+=-=-=
+
+Name: Comment Indent 2
+
+=-=
+local tb1 = {
+ first = 1,
+-- comment
+ second = 2,
+}
+=-=
+local tb1 = {
+ first = 1,
+ -- comment
+ second = 2,
+}
+=-=-=
+
+Name: Comment Indent 3
+
+=-=
+local tb9 = { one = 1,
+-- comment
+ two = 2 }
+=-=
+local tb9 = { one = 1,
+ -- comment
+ two = 2 }
+=-=-=
+
+Name: Argument Indent 1
+
+=-=
+h(
+"string",
+1000
+)
+=-=
+h(
+ "string",
+ 1000
+)
+=-=-=
+
+Name: Argument Indent 2
+
+=-=
+local p = h(
+"string",
+ 1000
+)
+=-=
+local p = h(
+ "string",
+ 1000
+)
+=-=-=
+
+Name: Argument Indent 3
+
+=-=
+fn(1,
+2,
+ 3)
+=-=
+fn(1,
+ 2,
+ 3)
+=-=-=
+
+Name: Argument Indent 4
+
+=-=
+fn( 1, 2,
+3, 4 )
+=-=
+fn( 1, 2,
+ 3, 4 )
+=-=-=
+
+Name: Argument Indent 5
+
+=-=
+f({
+x = 1,
+y = 2,
+z = 3,
+})
+=-=
+f({
+ x = 1,
+ y = 2,
+ z = 3,
+})
+=-=-=
+
+Name: Argument Indent 6
+
+=-=
+f({ x = 1,
+y = 2,
+z = 3, })
+=-=
+f({ x = 1,
+ y = 2,
+ z = 3, })
+=-=-=
+
+Name: Argument Indent 7
+
+=-=
+Test({
+a=1
+})
+=-=
+Test({
+ a=1
+})
+=-=-=
+
+Name: Argument Indent 8
+
+=-=
+Test({
+a = 1,
+b = 2,
+},
+nil)
+=-=
+Test({
+ a = 1,
+ b = 2,
+ },
+ nil)
+=-=-=
+
+Name: Argument Indent 9
+
+=-=
+Test(nil, {
+ a = 1,
+ b = 2,
+ })
+=-=
+Test(nil, {
+ a = 1,
+ b = 2,
+})
+=-=-=
+
+Name: Argument Indent 10
+
+=-=
+fn( -- comment
+ 1,
+ 2)
+=-=
+fn( -- comment
+ 1,
+ 2)
+=-=-=
+
+Name: Parameter Indent 1
+
+=-=
+function f1(
+a,
+b
+)
+print(a,b)
+end
+=-=
+function f1(
+ a,
+ b
+ )
+ print(a,b)
+end
+=-=-=
+
+Name: Parameter Indent 2
+
+=-=
+local function f2(a,
+ b)
+print(a,b)
+end
+=-=
+local function f2(a,
+ b)
+ print(a,b)
+end
+=-=-=
+
+Name: Parameter Indent 3
+
+=-=
+local f3 = function( a, b,
+ c, d )
+print(a,b,c,d)
+end
+=-=
+local f3 = function( a, b,
+ c, d )
+ print(a,b,c,d)
+end
+=-=-=
+
+Name: Parameter Indent 4
+
+=-=
+local f4 = function(-- comment
+a, b, c)
+=-=
+local f4 = function(-- comment
+ a, b, c)
+=-=-=
+
+Name: Table Indent 1
+
+=-=
+local Other = {
+ First={up={Step=true,Jump=true},
+ down={Step=true,Jump=true},
+ left={Step=true,Jump=true},
+ right={Step=true,Jump=true}},
+ Second={up={Step=true,Jump=true},
+ down={Step=true,Jump=true},
+ left={Step=true,Jump=true},
+ right={Step=true,Jump=true}},
+ Third={up={Goto=true},
+ down={Goto=true},
+ left={Goto=true},
+ right={Goto=true}}
+}
+=-=
+local Other = {
+ First={up={Step=true,Jump=true},
+ down={Step=true,Jump=true},
+ left={Step=true,Jump=true},
+ right={Step=true,Jump=true}},
+ Second={up={Step=true,Jump=true},
+ down={Step=true,Jump=true},
+ left={Step=true,Jump=true},
+ right={Step=true,Jump=true}},
+ Third={up={Goto=true},
+ down={Goto=true},
+ left={Goto=true},
+ right={Goto=true}}
+}
+=-=-=
+
+Name: Table Indent 2
+
+=-=
+local Other = {
+a = 1,
+ b = 2,
+ c = 3,
+}
+=-=
+local Other = {
+ a = 1,
+ b = 2,
+ c = 3,
+}
+=-=-=
+
+Name: Table Indent 3
+
+=-=
+local a = { -- hello world!
+ b = 10
+}
+=-=
+local a = { -- hello world!
+ b = 10
+}
+=-=-=
+
+Name: Continuation Indent 1
+
+=-=
+local very_long_variable_name =
+"ok"..
+ "ok"
+=-=
+local very_long_variable_name =
+ "ok"..
+ "ok"
+=-=-=
+
+Name: Continuation Indent 2
+
+=-=
+local n = a +
+b *
+c /
+1
+=-=
+local n = a +
+ b *
+ c /
+ 1
+=-=-=
+
+Name: Continuation Indent 3
+
+=-=
+local x = "A"..
+"B"
+.."C"
+=-=
+local x = "A"..
+ "B"
+ .."C"
+=-=-=
+
+Name: Continuation Indent 4
+
+=-=
+if a
+ and b
+ and c then
+ if x
+ and y then
+ local x = 1 +
+2 *
+ 3
+ end
+elseif a
+ or b
+ or c then
+end
+=-=
+if a
+ and b
+ and c then
+ if x
+ and y then
+ local x = 1 +
+ 2 *
+ 3
+ end
+elseif a
+ or b
+ or c then
+end
+=-=-=
+
+Code:
+ (lambda ()
+ (lua-mode)
+ (setq-local lua-indent-level 4)
+ (setq-local indent-tabs-mode nil)
+ (indent-region (point-min) (point-max)))
+
+Name: End Indent 1
+
+=-=
+function f(x)
+ for y=1,x.y do
+ for x=1,x.z do
+ if x.y and x.z then
+ if y <= x then
+ y = y + 1
+ end end end end
+ return {x,y} or {math.random(),math.random()}
+ end
+=-=
+function f(x)
+ for y=1,x.y do
+ for x=1,x.z do
+ if x.y and x.z then
+ if y <= x then
+ y = y + 1
+ end end end end
+ return {x,y} or {math.random(),math.random()}
+end
+=-=-=
+
+Name: End Indent 2
+
+=-=
+for y=1,x.y do
+ for x=1,x.z do
+ if x.y and x.z then
+ if y <= x then
+ y = y + 1
+ end
+ end end end
+=-=
+for y=1,x.y do
+ for x=1,x.z do
+ if x.y and x.z then
+ if y <= x then
+ y = y + 1
+ end
+end end end
+=-=-=
+
+Name: Nested Function Indent 1
+
+=-=
+function a(...)
+return (function (x)
+return x
+end)(foo(...))
+end
+=-=
+function a(...)
+ return (function (x)
+ return x
+ end)(foo(...))
+end
+=-=-=
+
+Name: Nested Function Indent 2
+
+=-=
+function b(n)
+local x = 1
+return function (i)
+return function (...)
+return (function (n, ...)
+return function (f, ...)
+return (function (...)
+if ... and x < 9 then
+x = x + 1
+return ...
+end end)(n(f, ...))
+end, ...
+end)(i(...))
+end end end
+=-=
+function b(n)
+ local x = 1
+ return function (i)
+ return function (...)
+ return (function (n, ...)
+ return function (f, ...)
+ return (function (...)
+ if ... and x < 9 then
+ x = x + 1
+ return ...
+ end end)(n(f, ...))
+ end, ...
+ end)(i(...))
+end end end
+=-=-=
+
+Name: Nested Function Indent 3
+
+=-=
+function c(f)
+local f1 = function (...)
+if nil ~= ... then
+return f(...)
+end
+end
+return function (i)
+return function (...)
+local fn = function (n, ...)
+local x = function (f, ...)
+return f1(n(f, ...))
+end
+return x
+end
+return fn(i(...))
+end
+end
+end
+=-=
+function c(f)
+ local f1 = function (...)
+ if nil ~= ... then
+ return f(...)
+ end
+ end
+ return function (i)
+ return function (...)
+ local fn = function (n, ...)
+ local x = function (f, ...)
+ return f1(n(f, ...))
+ end
+ return x
+ end
+ return fn(i(...))
+ end
+ end
+end
+=-=-=
+
+Name: Nested Function Indent 4
+
+=-=
+function d(f)
+local f1 = function (c, f, ...)
+if ... then
+if f(...) then
+return ...
+else
+return c(f, ...)
+end end end
+return function (i)
+return function (...)
+return (function (n, ...)
+local function j (f, ...)
+return f1(j, f, n(f, ...))
+end
+return j, ...
+end)(i(...))
+end end end
+=-=
+function d(f)
+ local f1 = function (c, f, ...)
+ if ... then
+ if f(...) then
+ return ...
+ else
+ return c(f, ...)
+ end end end
+ return function (i)
+ return function (...)
+ return (function (n, ...)
+ local function j (f, ...)
+ return f1(j, f, n(f, ...))
+ end
+ return j, ...
+ end)(i(...))
+end end end
+=-=-=
+
+Name: Nested Function Indent 5
+
+=-=
+function e (n, t)
+return function (i)
+return function (...)
+return (
+function (n, ...)
+local x, y, z = 0, {}
+return (function (f, ...)
+return (function (i, ...) return i(i, ...) end)(
+function (i, ...)
+return f(function (x, ...)
+return i(i, ...)(x, ...)
+end, ...)
+end)
+end)(function (j)
+return function(f, ...)
+return (function (c, f, ...)
+if ... then
+if n+1 == x then
+local y1, x1 = y, x
+y, x = {}, 0
+return (function (...)
+z = ...
+return ...
+end)(t(y1-1, x1-1, ...))
+else
+x = x - 1
+return c(f,
+(function (...)
+z = ...
+return ...
+end)(t(y, x, ...)))
+end
+elseif x ~= 0 then
+x = 0
+return z, y
+end end)(j, f, n(f, ...))
+end end), ...
+end)(i(...))
+end end end
+=-=
+function e (n, t)
+ return function (i)
+ return function (...)
+ return (
+ function (n, ...)
+ local x, y, z = 0, {}
+ return (function (f, ...)
+ return (function (i, ...) return i(i, ...) end)(
+ function (i, ...)
+ return f(function (x, ...)
+ return i(i, ...)(x, ...)
+ end, ...)
+ end)
+ end)(function (j)
+ return function(f, ...)
+ return (function (c, f, ...)
+ if ... then
+ if n+1 == x then
+ local y1, x1 = y, x
+ y, x = {}, 0
+ return (function (...)
+ z = ...
+ return ...
+ end)(t(y1-1, x1-1, ...))
+ else
+ x = x - 1
+ return c(f,
+ (function (...)
+ z = ...
+ return ...
+ end)(t(y, x, ...)))
+ end
+ elseif x ~= 0 then
+ x = 0
+ return z, y
+ end end)(j, f, n(f, ...))
+ end end), ...
+ end)(i(...))
+end end end
+=-=-=
diff --git a/test/lisp/progmodes/lua-mode-resources/movement.erts b/test/lisp/progmodes/lua-mode-resources/movement.erts
new file mode 100644
index 00000000000..04a52e6bd01
--- /dev/null
+++ b/test/lisp/progmodes/lua-mode-resources/movement.erts
@@ -0,0 +1,637 @@
+Code:
+ (lambda ()
+ (lua-mode)
+ (beginning-of-defun 1))
+
+Point-Char: |
+
+Name: beginning-of-defun moves to start of function declaration
+
+=-=
+local function Test()
+ if true then
+ print(1)
+ else
+ print(0)
+ end|
+end
+=-=
+|local function Test()
+ if true then
+ print(1)
+ else
+ print(0)
+ end
+end
+=-=-=
+
+Code:
+ (lambda ()
+ (lua-mode)
+ (end-of-defun 1))
+
+Point-Char: |
+
+Name: end-of-defun moves to end of function declaration
+
+=-=
+local function Test()
+ if true then
+ pr|int(1)
+ else
+ print(0)
+ end
+end
+
+local t = Test()
+=-=
+local function Test()
+ if true then
+ print(1)
+ else
+ print(0)
+ end
+end
+|
+local t = Test()
+=-=-=
+
+Name: end-of-defun moves to end of function definition
+
+=-=
+local t = {
+ f = function()
+ re|turn true
+ end,
+}
+=-=
+local t = {
+ f = function()
+ return true
+| end,
+}
+=-=-=
+
+Code:
+ (lambda ()
+ (lua-mode)
+ (forward-sentence 1))
+
+Point-Char: |
+
+Name: forward-sentence moves over if statements
+
+=-=
+function f()
+ |if true then
+ print(1)
+ elseif false then
+ print(0)
+ else
+ print(2)
+ end
+end
+=-=
+function f()
+ if true then
+ print(1)
+ elseif false then
+ print(0)
+ else
+ print(2)
+ end
+end|
+=-=-=
+
+Name: forward-sentence moves over variable declaration
+
+=-=
+|local n = 1
+
+print(n)
+=-=
+local n = 1|
+
+print(n)
+=-=-=
+
+Name: forward-sentence moves over for statements
+
+=-=
+|for k, v in pairs({}) do
+ print(k, v)
+end
+
+print(1)
+=-=
+for k, v in pairs({}) do
+ print(k, v)
+end|
+
+print(1)
+=-=-=
+
+Name: forward-sentence moves over do statements
+
+=-=
+|do
+ local x = 1
+ local y = 2
+
+ print(x, y)
+end
+
+print(1)
+=-=
+do
+ local x = 1
+ local y = 2|
+
+ print(x, y)
+end
+
+print(1)
+=-=-=
+
+Name: forward-sentence moves over while statements
+
+=-=
+local i = 0
+|while i < 9 do
+ print(i)
+ i = i + 1
+end
+
+print(1)
+=-=
+local i = 0
+while i < 9 do
+ print(i)
+ i = i + 1
+end|
+
+print(1)
+=-=-=
+
+Name: forward-sentence moves over repeat statements
+
+=-=
+local i = 0
+|repeat
+ print(i)
+ i = i + 1
+until i > 9
+
+print(1)
+=-=
+local i = 0
+repeat
+ print(i)
+ i = i + 1
+until i > 9|
+
+print(1)
+=-=-=
+
+Name: forward-sentence moves over function calls
+
+=-=
+|print(1)
+=-=
+print(1)|
+=-=-=
+
+Name: forward-sentence moves over return statements
+
+=-=
+function f()
+ |return math.random()
+end
+=-=
+function f()
+ return math.random()
+end|
+=-=-=
+
+Code:
+ (lambda ()
+ (lua-mode)
+ (forward-sentence 1))
+
+Name: forward-sentence moves over table fields
+
+=-=
+local t = {
+ |a = 1,
+ b = 2,
+}
+=-=
+local t = {
+ a = 1,
+ b = 2,
+}|
+=-=-=
+
+Code:
+ (lambda ()
+ (lua-mode)
+ (backward-sentence 1))
+
+Point-Char: |
+
+Name: backward-sentence moves over if statements
+
+=-=
+function f()
+ if true then
+ print(1)
+ elseif false then
+ print(0)
+ else
+ print(2)
+ end|
+end
+=-=
+|function f()
+ if true then
+ print(1)
+ elseif false then
+ print(0)
+ else
+ print(2)
+ end
+end
+=-=-=
+
+Name: backward-sentence moves over variable declaration
+
+=-=
+local n = 1|
+
+print(n)
+=-=
+|local n = 1
+
+print(n)
+=-=-=
+
+Name: backward-sentence moves over for statements
+
+=-=
+for k, v in pairs({}) do
+ print(k, v)
+end|
+
+print(1)
+=-=
+|for k, v in pairs({}) do
+ print(k, v)
+end
+
+print(1)
+=-=-=
+
+Name: backward-sentence moves over do statements
+
+=-=
+do
+ local x = 1
+ local y = 2
+
+ print(x, y)
+end|
+
+print(1)
+=-=
+do
+ local x = 1
+ local y = 2
+
+ |print(x, y)
+end
+
+print(1)
+=-=-=
+
+Name: backward-sentence moves over while statements
+
+=-=
+local i = 0
+while i < 9 do
+ print(i)
+ i = i + 1
+end|
+
+print(1)
+=-=
+|local i = 0
+while i < 9 do
+ print(i)
+ i = i + 1
+end
+
+print(1)
+=-=-=
+
+Name: backward-sentence moves over repeat statements
+
+=-=
+local i = 0
+repeat
+ print(i)
+ i = i + 1
+until i > 9|
+
+print(1)
+=-=
+|local i = 0
+repeat
+ print(i)
+ i = i + 1
+until i > 9
+
+print(1)
+=-=-=
+
+Name: backward-sentence moves over function calls
+
+=-=
+print(1)|
+=-=
+|print(1)
+=-=-=
+
+Name: backward-sentence moves over return statements
+
+=-=
+function f()
+ return math.random()|
+end
+=-=
+|function f()
+ return math.random()
+end
+=-=-=
+
+Code:
+ (lambda ()
+ (lua-mode)
+ (backward-sentence 2))
+
+Point-Char: |
+
+Name: backward-sentence moves over table fields
+
+=-=
+local t = {
+ a = 1,
+ b = 2|,
+}
+=-=
+|local t = {
+ a = 1,
+ b = 2,
+}
+=-=-=
+
+Code:
+ (lambda ()
+ (lua-mode)
+ (forward-sexp 1))
+
+Point-Char: |
+
+Name: forward-sexp moves over arguments
+
+=-=
+print|(1, 2, 3)
+=-=
+print(1, 2, 3)|
+=-=-=
+
+Name: forward-sexp moves over parameters
+
+=-=
+function f|(a, b) end
+=-=
+function f(a, b)| end
+=-=-=
+
+Name: forward-sexp moves over strings
+
+=-=
+print(|"1, 2, 3")
+=-=
+print("1, 2, 3"|)
+=-=-=
+
+Name: forward-sexp moves over tables
+
+=-=
+local t = |{ 1,
+ 2,
+ 3 }
+=-=
+local t = { 1,
+ 2,
+ 3 }|
+=-=-=
+
+Name: forward-sexp moves over parenthesized expressions
+
+=-=
+|(function (x) return x + 1 end)(41)
+=-=
+(function (x) return x + 1 end)|(41)
+=-=-=
+
+Name: forward-sexp moves over function declarations
+
+=-=
+|function foo (x)
+ if false then
+ print "foo"
+ elseif true then
+ print "bar"
+ end
+end
+=-=
+function| foo (x)
+ if false then
+ print "foo"
+ elseif true then
+ print "bar"
+ end
+end
+=-=-=
+
+Name: forward-sexp moves over do statements
+
+=-=
+|do
+ print(a + 1)
+end
+=-=
+do|
+ print(a + 1)
+end
+=-=-=
+
+Name: forward-sexp moves over for statements
+
+=-=
+|for k,v in pairs({}) do
+ print(k, v)
+end
+=-=
+for| k,v in pairs({}) do
+ print(k, v)
+end
+=-=-=
+
+Name: forward-sexp moves over repeat statements
+
+=-=
+|repeat
+ n = n + 1
+until n > 10
+=-=
+repeat|
+ n = n + 1
+until n > 10
+=-=-=
+
+Name: forward-sexp moves over while statements
+
+=-=
+|while n < 99
+do
+ n = n+1
+end
+=-=
+while| n < 99
+do
+ n = n+1
+end
+=-=-=
+
+Code:
+ (lambda ()
+ (lua-mode)
+ (backward-sexp 1))
+
+Point-Char: |
+
+Name: backward-sexp moves over arguments
+
+=-=
+print(1, 2, 3)|
+=-=
+print|(1, 2, 3)
+=-=-=
+
+Name: backward-sexp moves over parameters
+
+=-=
+function f(a, b)| end
+=-=
+function f|(a, b) end
+=-=-=
+
+Name: backward-sexp moves over strings
+
+=-=
+print("1, 2, 3"|)
+=-=
+print(|"1, 2, 3")
+=-=-=
+
+Name: backward-sexp moves over tables
+
+=-=
+local t = { 1,
+ 2,
+ 3 }|
+=-=
+local t = |{ 1,
+ 2,
+ 3 }
+=-=-=
+
+Name: backward-sexp moves over parenthesized expressions
+
+=-=
+(function (x) return x + 1 end)|(41)
+=-=
+|(function (x) return x + 1 end)(41)
+=-=-=
+
+Name: backward-sexp moves over function declarations
+
+=-=
+function foo (x)
+ if false then
+ print "foo"
+ elseif true then
+ print "bar"
+ end
+end|
+=-=
+function foo (x)
+ if false then
+ print "foo"
+ elseif true then
+ print "bar"
+ end
+|end
+=-=-=
+
+Name: backward-sexp moves over do statements
+
+=-=
+do
+ print(a + 1)
+end|
+=-=
+do
+ print(a + 1)
+|end
+=-=-=
+
+Name: backward-sexp moves over for statements
+
+=-=
+for k,v in pairs({}) do
+ print(k, v)
+end|
+=-=
+for k,v in pairs({}) do
+ print(k, v)
+|end
+=-=-=
+
+Name: backward-sexp moves over repeat statements
+
+=-=
+repeat
+ n = n + 1
+until n > 10|
+=-=
+repeat
+ n = n + 1
+until n > |10
+=-=-=
+
+Name: backward-sexp moves over while statements
+
+=-=
+while n < 99
+do
+ n = n+1
+end|
+=-=
+while n < 99
+do
+ n = n+1
+|end
+=-=-=
diff --git a/test/lisp/progmodes/lua-mode-resources/which-function.lua b/test/lisp/progmodes/lua-mode-resources/which-function.lua
new file mode 100644
index 00000000000..621d818461c
--- /dev/null
+++ b/test/lisp/progmodes/lua-mode-resources/which-function.lua
@@ -0,0 +1,3 @@
+local function f(x)
+ print(x)
+end
diff --git a/test/lisp/progmodes/lua-mode-tests.el b/test/lisp/progmodes/lua-mode-tests.el
new file mode 100644
index 00000000000..aee3a5f47cb
--- /dev/null
+++ b/test/lisp/progmodes/lua-mode-tests.el
@@ -0,0 +1,60 @@
+;;; lua-mode-tests.el --- Tests for lua-mode -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see .
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-font-lock)
+(require 'ert-x)
+(require 'hideshow)
+(require 'which-func)
+
+(ert-deftest lua-test-indentation ()
+ (ert-test-erts-file (ert-resource-file "indent.erts")))
+
+(ert-deftest lua-test-movement ()
+ (ert-test-erts-file (ert-resource-file "movement.erts")))
+
+(ert-deftest lua-test-font-lock ()
+ (let ((font-lock-maximum-decoration t))
+ (ert-font-lock-test-file (ert-resource-file "font-lock.lua") 'lua-mode)))
+
+(ert-deftest lua-test-which-function ()
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "which-function.lua"))
+ (lua-mode)
+ (which-function-mode)
+ (goto-char (point-min))
+ (should (equal "f" (which-function)))
+ (which-function-mode -1)))
+
+(ert-deftest lua-test-hideshow ()
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "hide-show.lua"))
+ (lua-mode)
+ (hs-minor-mode)
+ (hs-hide-all)
+ (should (= 9 (length (overlays-in (point-min) (point-max)))))
+ (hs-show-all)
+ (should (= 0 (length (overlays-in (point-min) (point-max)))))
+ (hs-minor-mode -1)))
+
+(provide 'lua-mode-tests)
+
+;;; lua-mode-tests.el ends here
diff --git a/test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua b/test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua
index 93d589e3825..5a36bcad10b 100644
--- a/test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua
+++ b/test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua
@@ -11,6 +11,11 @@ Multi-line comment
-- <- font-lock-comment-face
local line_comment = "comment" -- comment
-- ^ font-lock-comment-face
+---@alias MyNumber integer
+-- <- font-lock-comment-delimiter-face
+------Calculate new number
+-- ^ font-lock-comment-delimiter-face
+function calc() end
-- Definition
local function f1() end
diff --git a/test/lisp/progmodes/rust-ts-mode-resources/font-lock-no-parent.rs b/test/lisp/progmodes/rust-ts-mode-resources/font-lock-no-parent.rs
new file mode 100644
index 00000000000..85d0ccc9bf3
--- /dev/null
+++ b/test/lisp/progmodes/rust-ts-mode-resources/font-lock-no-parent.rs
@@ -0,0 +1,7 @@
++// intentionally invalid syntax
++const THING: [u8; 48] = [];
+
+// should recover here and highlight the text below
+trait Foo() {
+// ^ font-lock-keyword-face
+}
diff --git a/test/lisp/progmodes/rust-ts-mode-tests.el b/test/lisp/progmodes/rust-ts-mode-tests.el
index d2e28dcfbd7..32d64260a87 100644
--- a/test/lisp/progmodes/rust-ts-mode-tests.el
+++ b/test/lisp/progmodes/rust-ts-mode-tests.el
@@ -39,6 +39,13 @@
(ert-font-lock-test-file (ert-resource-file "font-lock-number.rs")
'rust-ts-mode)))
+(ert-deftest rust-ts-test-no-parent ()
+ (skip-unless (treesit-ready-p 'rust))
+ (let ((treesit-font-lock-level 4)
+ (rust-ts-mode-fontify-number-suffix-as-type t))
+ (ert-font-lock-test-file (ert-resource-file "font-lock-no-parent.rs")
+ 'rust-ts-mode)))
+
(provide 'rust-ts-mode-tests)
;;; rust-ts-mode-tests.el ends here
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index de2c59b9c25..a4059a7d290 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1454,9 +1454,16 @@ final or penultimate step during initialization."))
(dolist (inplace '(nil t))
(dolist (from '(?a ?é ?Ω #x80 #x3fff80))
(dolist (to '(?o ?á ?ƒ ?☃ #x1313f #xff #x3fffc9))
- ;; Can't put a non-byte value in a non-ASCII unibyte string.
- (unless (and (not mb) (> to #xff)
- (not (string-match-p (rx bos (* ascii) eos) str)))
+ (unless (or
+ ;; Can't put non-byte in a non-ASCII unibyte string.
+ (and (not mb) (> to #xff)
+ (not (string-match-p
+ (rx bos (* ascii) eos) str)))
+ ;; Skip illegal mutation.
+ (and inplace (not (if mb
+ (and (<= 0 from 127)
+ (<= 0 to 127))
+ (<= 0 to 255)))))
(let* ((in (copy-sequence str))
(ref (if (and (not mb) (> from #xff))
in ; nothing to replace
diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el
index 02be0e722e4..c9e2a4cac09 100644
--- a/test/lisp/vc/vc-tests/vc-tests.el
+++ b/test/lisp/vc/vc-tests/vc-tests.el
@@ -73,8 +73,8 @@
;; HISTORY FUNCTIONS
;;
;; * print-log (files buffer &optional shortlog start-revision limit)
-;; - log-outgoing (backend remote-location)
-;; - log-incoming (backend remote-location)
+;; - log-outgoing (backend upstream-location)
+;; - log-incoming (backend upstream-location)
;; - log-view-mode ()
;; - show-log-entry (revision)
;; - comment-history (file)
diff --git a/test/src/alloc-tests.el b/test/src/alloc-tests.el
index cba69023044..cf7d1ca1cd3 100644
--- a/test/src/alloc-tests.el
+++ b/test/src/alloc-tests.el
@@ -52,11 +52,4 @@
(dotimes (i 4)
(should (eql (aref x i) (aref y i))))))
-;; Bug#39207
-(ert-deftest aset-nbytes-change ()
- (let ((s (make-string 1 ?a)))
- (dolist (c (list 10003 ?b 128 ?c ?d (max-char) ?e))
- (aset s 0 c)
- (should (equal s (make-string 1 c))))))
-
;;; alloc-tests.el ends here
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 1eaf1759c17..e93cc3831f9 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -929,4 +929,24 @@ comparing the subr with a much slower Lisp implementation."
((eq subtype 'function) (cl-functionp val))
(t (should-not (cl-typep val subtype))))))))))
+(ert-deftest data-aset-string ()
+ ;; unibyte
+ (let ((s (copy-sequence "abcdef")))
+ (cl-assert (not (multibyte-string-p s)))
+ (aset s 4 ?E)
+ (should (equal s "abcdEf"))
+ (aset s 2 255)
+ (should (equal s "ab\377dEf"))
+ (should-error (aset s 3 256)) ; not a byte value
+ (should-error (aset s 3 #x3fff80))) ; not a byte value
+ ;; multibyte
+ (let ((s (copy-sequence "abçdef")))
+ (cl-assert (multibyte-string-p s))
+ (aset s 4 ?E)
+ (should (equal s "abçdEf"))
+ (should-error (aset s 2 ?c)) ; previous char not ASCII
+ (should-error (aset s 2 #xe9)) ; new char not ASCII
+ (should-error (aset s 3 #x3fff80))) ; new char not ASCII
+ )
+
;;; data-tests.el ends here
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 1cb667ddeac..30cf32039f9 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -424,5 +424,34 @@ See also `with-temp-buffer'."
(puthash 1 2 table)
(should-error (json-serialize table) :type 'wrong-type-argument)))
+(defun json-tests--parse-string-error-pos (s)
+ (condition-case e
+ (json-parse-string s)
+ (json-error (nth 3 e))
+ (:success 'no-error)))
+
+(defun json-tests--parse-buffer-error-pos ()
+ (condition-case e
+ (json-parse-buffer)
+ (json-error (nth 3 e))
+ (:success 'no-error)))
+
+(ert-deftest json-parse-error-position ()
+ (let* ((s "[\"*Ωßœ☃*\",,8]")
+ (su (encode-coding-string s 'utf-8-emacs)))
+ (should (equal (json-tests--parse-string-error-pos s) 11))
+ (should (equal (json-tests--parse-string-error-pos su) 16))
+
+ (with-temp-buffer
+ (let ((junk "some leading junk"))
+ (insert junk)
+ (insert s)
+ (goto-char (1+ (length junk)))
+ (should (equal (json-tests--parse-buffer-error-pos) 11))
+
+ (set-buffer-multibyte nil)
+ (goto-char (1+ (length junk)))
+ (should (equal (json-tests--parse-buffer-error-pos) 16))))))
+
(provide 'json-tests)
;;; json-tests.el ends here