Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 09:14:18 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge remote-tracking branch 'origin/master' into feature/package-autosuggest

Browse source
This commit is contained in:
Philip Kaludercic 2026-02-01 21:01:40 +01:00
commit 2cde30aa1b
No known key found for this signature in database
66 changed files with 1761 additions and 719 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
admin/authors.el
View file

@ -69,6 +69,7 @@ files.")
(nil "BlaCk_Void" "alstjr7375@daum\\.net")
(nil "bug-gnu-emacs@gnu\\.org") ; mistake
("Björn Torkelsson" "Bjorn Torkelsson")
("Boris Buliga" "boris@d12frosted\\.io")
(nil "brandon\\.irizarry@gmail\\.com")
("Brian Fox" "Brian J\\. Fox")
("Brian P Templeton" "BT Templeton")

6
admin/download-android-deps.sh
View file

@ -61,7 +61,7 @@ download_tarball ()
# 1c8f3b0cbad474da0ab09018c4ecf2119ac4a52d pixman-0.38.4-emacs.tar.gz
# b687c8439d51634d921674dd009645e24873ca36 rsvg-2.40.21-emacs.tar.gz
# eda251614598aacb06f5984a0a280833de456b29 tiff-4.5.1-emacs.tar.gz
# c00d0ea9c6e848f5cce350cb3ed742024f2bdb8b tree-sitter-0.20.7-emacs.tar.gz
# 9d032de89c874354c22d304f7e968f4ca6de8c0a tree-sitter-0.26.3-emacs.tar.gz
download_tarball "giflib-5.2.1-emacs.tar.gz" "giflib-5.2.1" \
"a407c568961d729bb2d0175a34e0d4ed4a269978"
@ -90,8 +90,8 @@ download_tarball "libtasn1-4.19.0-emacs.tar.gz" "libtasn1-4.19.0" \
"fdc827211075d9b70a8ba6ceffa02eb48d6741e9"
download_tarball "libselinux-3.6-emacs.tar.gz" "libselinux-3.6" \
"8361966e19fe25ae987b08799f1442393ae6366b"
download_tarball "tree-sitter-0.20.7-emacs.tar.gz" "tree-sitter-0.20.7" \
"c00d0ea9c6e848f5cce350cb3ed742024f2bdb8b"
download_tarball "tree-sitter-0.26.3-emacs.tar.gz" "tree-sitter-0.26.3" \
"9d032de89c874354c22d304f7e968f4ca6de8c0a"
download_tarball "harfbuzz-7.1.0-emacs.tar.gz" "harfbuzz-7.1.0" \
"22dc71d503ab2eb263dc8411de9da1db144520f5"
download_tarball "tiff-4.5.1-emacs.tar.gz" "tiff-4.5.1" \

32
configure.ac
View file

@ -4069,39 +4069,15 @@ TREE_SITTER_OBJ=
NEED_DYNLIB=no
if test "${with_tree_sitter}" != "no"; then
dnl Tree-sitter 0.20.2 added support to change the malloc it uses
dnl at runtime, we need that feature. However, tree-sitter's
dnl Makefile has problems, until that's fixed, all tree-sitter
dnl libraries distributed are versioned 0.6.3. We try to
dnl accept a tree-sitter library that has incorrect version as long
dnl as it supports changing malloc.
EMACS_CHECK_MODULES([TREE_SITTER], [tree-sitter >= 0.20.2],
dnl Tree-sitter 0.20.10 added ts_tree_cursor_goto_previous_sibling, we
dnl need it for a more efficient implementation for traversing the
dnl parse tree backwards (bug#80108).
EMACS_CHECK_MODULES([TREE_SITTER], [tree-sitter >= 0.20.10],
[HAVE_TREE_SITTER=yes], [HAVE_TREE_SITTER=no])
if test "${HAVE_TREE_SITTER}" = yes; then
AC_DEFINE(HAVE_TREE_SITTER, 1, [Define if using tree-sitter.])
NEED_DYNLIB=yes
else
EMACS_CHECK_MODULES([TREE_SITTER], [tree-sitter >= 0.6.3],
[HAVE_TREE_SITTER=yes], [HAVE_TREE_SITTER=no])
if test "${HAVE_TREE_SITTER}" = yes; then
OLD_CFLAGS=$CFLAGS
OLD_LIBS=$LIBS
CFLAGS="$CFLAGS $TREE_SITTER_CFLAGS"
LIBS="$TREE_SITTER_LIBS $LIBS"
AC_CHECK_FUNCS([ts_set_allocator])
CFLAGS=$OLD_CFLAGS
LIBS=$OLD_LIBS
if test "$ac_cv_func_ts_set_allocator" = yes; then
AC_DEFINE(HAVE_TREE_SITTER, 1, [Define if using tree-sitter.])
NEED_DYNLIB=yes
else
AC_MSG_ERROR([Tree-sitter library exists but its version is too old]);
TREE_SITTER_CFLAGS=
TREE_SITTER_LIBS=
fi
fi
fi
# Windows loads tree-sitter dynamically
if test "${opsys}" = "mingw32"; then
TREE_SITTER_LIBS=

78
doc/emacs/custom.texi
View file

@ -1615,24 +1615,30 @@ your preference, such as @code{ws-butler-mode}.
@cindex per-connection local variables
Most of the variables reflect the situation on the local machine.
Often, they must use a different value when you operate in buffers
with a remote default directory. Think about the behavior when
calling @code{shell} -- on your local machine, you might use
@file{/bin/bash} and rely on termcap, but on a remote machine, it may
be @file{/bin/ksh} and terminfo.
Often, they must use a different value when you operate in buffers with
a remote default directory. Think about the behavior when calling
@code{shell} --- on your local machine, you might use @file{/bin/bash}
and rely on termcap, but on a remote machine, it may be @file{/bin/ksh}
and terminfo.
This can be accomplished with @dfn{connection-local variables}.
Directory and file local variables override connection-local
variables. Unsafe connection-local variables are handled in the same
way as unsafe file-local variables (@pxref{Safe File Variables}).
This can be accomplished with @dfn{connection-local variables}. Such
variables are declared depending on the value of
@code{default-directory} of the current buffer. When a buffer has a
remote @code{default-directory}, and there exist a connection-local
variable which matches @code{default-directory}, this alternative value
of the variable is used. Directory and file local variables override
connection-local variables. Unsafe connection-local variables are
handled in the same way as unsafe file-local variables (@pxref{Safe File
Variables}).
@findex connection-local-set-profile-variables
@findex connection-local-set-profiles
Connection-local variables are declared as a group of
variables/value pairs in a @dfn{profile}, using the
Connection-local variables are declared as a group of variables/value
pairs in a @dfn{profile}, using the
@code{connection-local-set-profile-variables} function. The function
@code{connection-local-set-profiles} activates profiles for a given
criteria, identifying a remote machine:
@code{connection-local-set-profiles} declares profiles for a given
criteria (the first argument), identifying a remote machine with respect
to @code{default-directory} of the current buffer:
@example
(connection-local-set-profile-variables 'remote-terminfo
@ -1654,12 +1660,46 @@ criteria, identifying a remote machine:
This code declares three different profiles, @code{remote-terminfo},
@code{remote-ksh}, and @code{remote-bash}. The profiles
@code{remote-terminfo} and @code{remote-ksh} are applied to all
buffers which have a remote default directory matching the regexp
@code{"remotemachine"} as host name. Such a criteria can also
discriminate for the properties @code{:protocol} (this is the Tramp
method) or @code{:user} (a remote user name). The @code{nil} criteria
matches all buffers with a remote default directory.
@code{remote-terminfo} and @code{remote-ksh} are applied to all buffers
which have a remote @code{default-directory} matching the string
@code{"remotemachine"} as host name.
Criteria, the first argument of @code{connection-local-set-profiles},
specifies, how the profiles match @code{default-directory}. It is a
plist identifying a connection and the application using this
connection. Property names might be @code{:application},
@code{:protocol}, @code{:user} and @code{:machine}. The property value
of @code{:application} is a symbol, all other property values are
strings. In general the symbol @code{tramp} should be used as
@code{:application} value. Some packages use a different
@code{:application} (for example @code{eshell} or @code{vc-git}); they
say it in their documentation then. All properties are optional.
The other properties are used for checking @code{default-directory}.
The propertiy @code{:protocol} is used for the method a remote
@code{default-directory} uses, the property
@code{:user} is the remote user name, and the property @code{:machine}
is the remote host name. All checks are performed via
@code{string-equal}. The @code{nil} criteria matches all buffers
with a remote default directory.
Connection-local variables are not activated by default. A package
which uses connection-local variables must activate them for a given
buffer, specifying for which @code{:application} it uses them.
@xref{Applying Connection Local Variables,,, elisp, The Emacs Lisp
Reference Manual}, for details.
After the above definition of profiles and their activation, any
connection made by Tramp to the @samp{remotemachine} system will use
@itemize
@item @code{t} as the connection-specific value of @code{system-uses-terminfo},
@item @samp{dumb-emacs-ansi} as the connection-specific value of
@code{comint-terminfo-terminal},
@item @samp{/bin/ksh} as the connection-specific value of as
@code{shell-file-name},
@item @samp{-c} as the connection-specific value of @code{shell-command-switch}.
@end itemize
Be careful when declaring different profiles with the same variable,
and setting these profiles to criteria which could match in parallel.

3
doc/emacs/files.texi
View file

@ -1835,7 +1835,8 @@ the start of the @var{n}th previous file.
@findex diff-hunk-kill
@item M-k
Kill the hunk at point (@code{diff-hunk-kill}).
Kill the hunk at point (@code{diff-hunk-kill}). If the region is
active, kills all hunks the region overlaps.
@findex diff-file-kill
@item M-K

3
doc/emacs/maintaining.texi
View file

@ -1712,6 +1712,9 @@ Do an incremental regular expression search on the fileset
Apart from acting on multiple files, these commands behave much like
their single-buffer counterparts (@pxref{Search}).
@c Outstanding changes commands under 'T' are not mentioned because
@c these are an advanced feature documented only in vc1-xtra.texi.
The VC Directory buffer additionally defines some branch-related
commands starting with the prefix @kbd{b}:

65
doc/emacs/vc1-xtra.texi
View file

@ -298,22 +298,31 @@ yet merged into the target branch.
@cindex outstanding changes
@table @kbd
@item C-x v o =
@item C-x v T =
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 o D
Display all changes since the merge base of this branch and its upstream
counterpart (@code{vc-root-diff-outgoing-base}).
@item C-x v T D
Display a diff of all changes since the merge base of this branch and
its upstream counterpart (@code{vc-root-diff-outgoing-base}).
@item C-x v T l
Display log messages for changes to the VC fileset since the merge base
of this branch and its upstream counterpart
(@code{vc-log-outgoing-base}).
@item C-x v T L
Display log messages for all changes since the merge base of this branch
and its upstream counterpart (@code{vc-root-log-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 are conceptually distinct, and so
we will introduce them separately.
these commands provide specialized versions of @kbd{C-x v M L} and
@w{@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 are conceptually
distinct, and so we will introduce them separately.
First, consider working on a single branch. @dfn{Outstanding changes}
are those which you haven't yet pushed upstream. This includes both
@ -321,17 +330,17 @@ 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 o =
@kindex C-x v T =
@findex vc-diff-outgoing-base
@kindex C-x v o D
@kindex C-x v T D
@findex vc-root-diff-outgoing-base
Type @kbd{C-x v o D} (@code{vc-root-diff-outgoing-base}) to display a
Type @kbd{C-x v T 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 o =} (@code{vc-diff-outgoing-base}) instead to limit
can use @kbd{C-x v T =} (@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 o D}} and @w{@kbd{C-x v o =}} is like the
between @w{@kbd{C-x v T D}} and @w{@kbd{C-x v T =}} 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})
@ -340,6 +349,16 @@ include uncommitted changes in the reported diffs. Like those other
commands, you can use a prefix argument to specify a particular upstream
location.}
@kindex C-x v T l
@findex vc-log-outgoing-base
@kindex C-x v T L
@findex vc-root-log-outgoing-base
Type @kbd{C-x v T L} (@code{vc-root-log-outgoing-base}) to display a
summary of the same changes in the form of a revision log; this does not
include uncommitted changes. You can use @kbd{C-x v T l}
(@code{vc-log-outgoing-base}) instead to limit the display of changes to
the current VC fileset.
Second, consider developing a feature on a separate branch. Call this
the @dfn{topic branch},@footnote{What we mean by a topic branch is any
shorter-lived branch used for work which will later be merged into a
@ -359,13 +378,15 @@ upstream repository's development trunk. That means committed changes
on the topic branch that haven't yet been merged into the trunk, plus
uncommitted changes.
When the current branch is a topic branch and you type @kbd{C-x v o D},
When the current branch is a topic branch and you type @kbd{C-x v T D},
Emacs displays a summary of all the changes that are outstanding against
the trunk to which the current branch will be merged. This summary is
in the form of a diff of what committing and pushing all the changes,
@emph{and} subsequently merging the topic branch, would do to the trunk.
As above, you can use @kbd{C-x v o =} instead to limit the display of
changes to the current VC fileset.
As above, you can use @kbd{C-x v T =} instead to limit the display of
changes to the current VC fileset. @kbd{C-x v T L} and @kbd{C-x v T l}
show the corresponding revision logs, excluding uncommitted changes as
above.
This functionality relies on Emacs correctly detecting whether the
current branch is a trunk or a topic branch, and in the latter case,
@ -379,8 +400,8 @@ The variables @code{vc-trunk-branch-regexps} and
@code{vc-topic-branch-regexps} contain lists of regular expressions
matching the names of branches that should always be considered trunk
and topic branches, respectively. You can also specify prefix arguments
to @kbd{C-x v o D} and @kbd{C-x v o =}. Here is a summary of how to use
these controls:
to @kbd{C-x v T @dots{}}. Here is a summary of how to use these
controls:
@enumerate
@item
@ -425,7 +446,7 @@ described. E.g., if the value of @code{vc-trunk-branch-regexps} is
branch.
@item
Supply a double prefix argument, i.e. @w{@kbd{C-u C-u C-x v o @dots{}}},
Supply a double prefix argument, i.e. @w{@kbd{C-u C-u C-x v T @dots{}}},
and Emacs will treat the current branch as a trunk, no matter what.
This is useful when you simply want to obtain a diff of all outgoing
changes (@pxref{VC Change Log}) plus uncommitted changes.
@ -433,7 +454,7 @@ changes (@pxref{VC Change Log}) plus uncommitted changes.
@item
@cindex outgoing base, version control
Finally, you can take full manual control by supplying a single prefix
argument, i.e. @w{@kbd{C-u C-x v o @dots{}}}. Emacs will prompt you for
argument, i.e. @w{@kbd{C-u C-x v T @dots{}}}. Emacs will prompt you for
the @dfn{outgoing base}, which is the upstream location for which the
changes are destined once they are no longer outstanding.

12
doc/emacs/windows.texi
View file

@ -519,6 +519,8 @@ selected frame, and display the buffer in that new window.
@vindex split-height-threshold
@vindex split-width-threshold
@vindex split-window-preferred-direction
@cindex portrait frame
@cindex landscape frame
The split can be either vertical or horizontal, depending on the
variables @code{split-height-threshold} and
@code{split-width-threshold}. These variables should have integer
@ -528,8 +530,14 @@ window's height, the split puts the new window below. Otherwise, if
split puts the new window on the right. If neither condition holds,
Emacs tries to split so that the new window is below---but only if the
window was not split before (to avoid excessive splitting). Whether
Emacs tries first to split vertically or horizontally, is
determined by the value of @code{split-window-preferred-direction}.
Emacs tries first to split vertically or horizontally when both
conditions hold is determined by the value of
@code{split-window-preferred-direction}. Its default is @code{longest},
which means to split vertically if the window's frame is taller than it
is wide (a @dfn{portrait} frame), and split horizontally if its wider
than it's tall (a @dfn{landscape} frame). The values @code{vertical}
and @code{horizontal} always prefer, respectively, the vertical or the
horizontal split.
@item
Otherwise, display the buffer in a window previously showing it.

4
doc/lispref/control.texi
View file

@ -2344,7 +2344,9 @@ the other usual filtering mechanisms say it should. @xref{Error Debugging}.
The macro @code{condition-case-unless-debug} provides another way to
handle debugging of such forms. It behaves exactly like
@code{condition-case}, unless the variable @code{debug-on-error} is
non-@code{nil}, in which case it does not handle any errors at all.
non-@code{nil}, in which case it causes Emacs to enter the debugger
before executing any applicable handler. (The applicable handler, if
any, will still run when the debugger exits.)
@end defmac
Once Emacs decides that a certain handler handles the error, it

34
doc/lispref/display.texi
View file

@ -2243,6 +2243,9 @@ means hide the excess parts of @var{string} with a @code{display} text
property (@pxref{Display Property}) showing the ellipsis, instead of
actually truncating the string.
See also the function @code{truncate-string-pixelwise} for pixel-level
resolution.
@example
@group
(truncate-string-to-width "\tab\t" 12 4)
@ -2440,6 +2443,37 @@ non-@code{nil}, use any face remappings (@pxref{Face Remapping}) from
that buffer when computing the width of @var{string}.
@end defun
@defun truncate-string-pixelwise string max-pixels &optional buffer ellipsis ellipsis-pixels
This is a convenience function that uses @code{window-text-pixel-size}
to truncate @var{string} to @var{max-pixels} pixels. Caveat: if you
call this function to measure the width of a string with embedded
newlines, it will then return the width of the widest substring that
does not include newlines. The meaning of this result is the widest
line taken by the string if inserted into a buffer. If @var{buffer} is
non-@code{nil}, use any face remappings (@pxref{Face Remapping}) from
that buffer when computing the width of @var{string}.
If @var{ellipsis} is non-@code{nil}, it should be a string which will
replace the end of @var{string} when it is truncated. In this case,
more characters will be removed from @var{string} to free enough space
for @var{ellipsis} to fit within @var{max-pixels} pixels. However, if
the pixel width of @var{string} is less than the pixel width of
@var{ellipsis}, @var{ellipsis} will not be appended to the result. If
@var{ellipsis} is non-@code{nil} and not a string, it stands for the
value returned by the function @code{truncate-string-ellipsis},
described above.
If @var{ellipsis-pixels} is non-@code{nil} and @var{ellipsis} is
non-@code{nil}, it should be the number of pixels of @var{ellipsis} that
you should precompute using @code{string-pixel-width}, specifying the
same buffer. This is useful to avoid the cost of recomputing this value
repeatedly when you have many strings to truncate using the same
ellipsis string.
See also the function @code{truncate-string-to-width} for
character-level resolution.
@end defun
@defun line-pixel-height
This function returns the height in pixels of the line at point in the
selected window. The value includes the line spacing of the line

24
doc/lispref/frames.texi
View file

@ -109,6 +109,7 @@ must be a root frame, which means it cannot be a child frame itself
descending from it.
@end defun
@cindex frame identifier
@defun frame-id &optional frame
This function returns the unique identifier of a frame, an integer,
assigned to @var{frame}. If @var{frame} is @code{nil} or unspecified,
@ -3187,6 +3188,29 @@ could switch to a different terminal without switching back when
you're done.
@end deffn
@deffn Command select-frame-by-id id &optional noerror
This function searches open and undeletable frames for a matching frame
identifier @var{id} (@pxref{Frames}). If found, its frame is undeleted,
if necessary, then raised, given focus, and made the selected frame. On
a text terminal, raising a frame causes it to occupy the entire terminal
display.
This function returns the selected frame or signals an error if @var{id}
is not found, unless @var{noerror} is non-@code{nil}, in which case it
returns @code{nil}.
@end deffn
@deffn Command undelete-frame-by-id id &optional noerror
This function searches undeletable frames for a matching frame
identifier @var{id} (@pxref{Frames}). If found, its frame is undeleted,
raised, given focus, and made the selected frame. On a text terminal,
raising a frame causes it to occupy the entire terminal display.
This function returns the undeleted frame or signals an error if
@var{id} is not found, unless @var{noerror} is non-@code{nil}, in which
case it returns @code{nil}.
@end deffn
@cindex text-terminal focus notification
Emacs cooperates with the window system by arranging to select frames
as the server and window manager request. When a window system

15
doc/lispref/sequences.texi
View file

@ -1110,9 +1110,9 @@ instead of the default @code{equal}.
@cindex sequences, intersection of
@cindex intersection of sequences
This function returns a copy of @var{sequence1} from which the
elements that appear in @var{sequence2} where removed. If the optional
argument @var{function} is non-@code{nil}, it is a function of two
arguments to use to compare elements instead of the default
elements that do not appear in @var{sequence2} were removed. If the
optional argument @var{function} is non-@code{nil}, it is a function of
two arguments to use to compare elements instead of the default
@code{equal}.
@example
@ -1125,10 +1125,11 @@ arguments to use to compare elements instead of the default
@defun seq-difference sequence1 sequence2 &optional function
This function returns a list of the elements that appear in
@var{sequence1} but not in @var{sequence2}. If the optional argument
@var{function} is non-@code{nil}, it is a function of two arguments to
use to compare elements instead of the default @code{equal}.
This function returns a copy of @var{sequence1} from which the
elements that appear in @var{sequence2} were removed. If the optional
argument @var{function} is non-@code{nil}, it is a function of two
arguments to use to compare elements instead of the default
@code{equal}.
@example
@group

13
doc/lispref/variables.texi
View file

@ -2653,6 +2653,19 @@ This macro returns the connection-local value of @var{symbol} for
If @var{symbol} does not have a connection-local
binding, the value is the default binding of the variable.
The difference to @code{with-connection-local@{-application@}-variables}
is, that @code{symbol} is not set buffer-local. A typical usage pattern
is to use only the the connection value of a variable if it exists, and
not to use its default value otherwise (using @code{my-app-variable}
initialized above):
@lisp
(if (connection-local-p my-app-variable 'my-app)
(connection-local-value my-app-variable 'my-app)
;; Something else.
)
@end lisp
@end defmac
@defvar enable-connection-local-variables

35
doc/lispref/windows.texi
View file

@ -4122,16 +4122,19 @@ window. If @var{window} cannot be split, it returns @code{nil}. If
@var{window} is omitted or @code{nil}, it defaults to the selected
window.
This function obeys the usual rules that determine when a window may
be split (@pxref{Splitting Windows}). It first tries to split by
placing the new window below, subject to the restriction imposed by
@code{split-height-threshold} (see below), in addition to any other
restrictions. If that fails, it tries to split by placing the new
window to the right, subject to @code{split-width-threshold} (see
below). If that also fails, and the window is the only window on its
frame, this function again tries to split and place the new window
below, disregarding @code{split-height-threshold}. If this fails as
well, this function gives up and returns @code{nil}.
This function obeys the usual rules that determine when a window may be
split (@pxref{Splitting Windows}). It first tries either a vertical
split by placing the new window below, subject to the restriction
imposed by @code{split-height-threshold} (see below), or a horizontal
split that places the new window to the right, subject to
@code{split-width-threshold}, in addition to any other restrictions.
Whether it tries first to split vertically or horizontally depends on
the value of the user option @code{split-window-preferred-direction}.
If splitting along the first dimension fails, it tries to split along
the other dimension. If that also fails, and the window is the only
window on its frame, this function again tries to split and place the
new window below, disregarding @code{split-height-threshold}. If this
fails as well, this function gives up and returns @code{nil}.
@end defun
@defopt split-height-threshold
@ -4150,6 +4153,18 @@ window has at least that many columns. If the value is @code{nil},
that means not to split this way.
@end defopt
@defopt split-window-preferred-direction
This variable determines the first dimension along which
@code{split-window-sensibly} tries to split the window, if the window
could be split both vertically and horizontally, as determined by the
values of @code{split-height-threshold} and
@code{split-width-threshold}. The default value is @code{longest},
which means to split vertically if the height of the window's frame is
greater or equal to its width, and horizontally otherwise. The values
@code{vertical} and @code{horizontal} specify the direction in which to
attempt the first split.
@end defopt
@defopt even-window-sizes
This variable, if non-@code{nil}, causes @code{display-buffer} to even
window sizes whenever it reuses an existing window, and that window is

77
etc/NEWS
View file

@ -416,11 +416,20 @@ for which you can use '(category . tex-shell)'.
+++
*** New user option 'split-window-preferred-direction'.
Users can now choose in which direction Emacs tries to split first:
vertically or horizontally. The new default is to prefer to split
horizontally if the frame is landscape and vertically if it is portrait.
You can customize this option to 'vertical' to restore Emacs's old
behavior of always preferring vertical splits.
Functions called by 'display-buffer' split the selected window when they
need to create a new window. A window can be split either vertically,
one below the other, or horizontally, side by side. This new option
determines which direction will be tried first, when both directions are
possible according to the values of 'split-width-threshold' and
'split-height-threshold'. The default value is 'longest', which means
to prefer to split horizontally if the window's frame is a "landscape"
frame, and vertically if it is a "portrait" frame. (A frame is
considered to be "portrait" if its vertical dimension in pixels is
greater or equal to its horizontal dimension, otherwise it's considered
to be "landscape".) Previous versions of Emacs always tried to split
vertically first, so to get previous behavior, you can customize this
option to 'vertical'. The value 'horizontal' always prefers the
horizontal split.
+++
*** New argument INDIRECT for 'get-buffer-window-list'.
@ -844,10 +853,10 @@ Northern Iroquoian language family: 'mohawk-postfix' (Mohawk
[Kanien’kéha / Kanyen’kéha / Onkwehonwehnéha]), 'oneida-postfix' (Oneida
[Onʌyote’a·ká· / Onyota’a:ká: / Ukwehuwehnéha]), 'cayuga-postfix'
(Cayuga [Gayogo̱ho:nǫhnéha:ˀ]), 'onondaga-postfix' (Onondaga
[Onųdaʔgegáʔ]), and 'seneca-postfix' (Seneca [Onödowá’ga:’]).
Additionally, there is a general-purpose 'haudenosaunee-postfix' input
method to facilitate writing in the orthographies of the five languages
simultaneously.
[Onųdaʔgegáʔ]), 'seneca-postfix' (Seneca [Onödowá’ga:’]), and
'tuscarora-postfix' (Tuscarora [Skarù·ręʔ]). Additionally, there is a
general-purpose 'haudenosaunee-postfix' input method to facilitate
writing in the orthographies of the six languages simultaneously.
---
*** New input methods for languages based on Burmese.
@ -2078,6 +2087,11 @@ for docstrings where symbols 'nil' and 't' are in quotes.
In most cases, having it enabled leads to a large amount of false
positives.
---
*** New function 'checkdoc-batch'.
It checks the buffer in batch mode, prints all found errors
and signals the first found error.
*** New file-local variable 'lisp-indent-local-overrides'.
This variable can be used to locally override the indent specification
of symbols.
@ -2270,15 +2284,19 @@ one as before. This makes them different from 'vc-diff' and
*** 'diff-apply-hunk' now supports creating and deleting files.
+++
*** 'diff-apply-hunk' and 'diff-apply-buffer' now consider the region.
If the region is active, these commands now apply all hunks that the
region overlaps. Otherwise, they have their existing behavior.
*** Diff mode's application and killing commands now consider the region.
If the region is active, 'diff-apply-hunk', 'diff-apply-buffer' and
'diff-hunk-kill' now apply or kill all hunks that the region overlaps.
Otherwise, they have their existing behavior.
+++
*** 'diff-apply-buffer' can reverse-apply.
With a prefix argument, it now reverse-applies hunks.
This matches the existing prefix argument to 'diff-apply-hunk'.
---
*** 's' is now bound to 'diff-split-hunk' in read-only Diff mode buffers.
** Ediff
+++
@ -2745,12 +2763,15 @@ include were committed and will be pushed.
current VC fileset.
+++
*** New commands to report diffs of outstanding changes.
'C-x v o =' ('vc-diff-outgoing-base') and 'C-x v o D'
*** New commands to report information about outstanding changes.
'C-x v T =' ('vc-diff-outgoing-base') and 'C-x v T 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.
'C-x v T l' ('vc-log-outgoing-base') and 'C-x v T L'
('vc-root-log-outgoing-base') show the corresponding revision logs.
These are useful to view all outstanding (unmerged, unpushed) changes on
the current branch. They are also available as 'T =', 'T D', 'T l' and
'T L' in VC-Dir buffers.
+++
*** New user option 'vc-use-incoming-outgoing-prefixes'.
@ -3056,6 +3077,10 @@ Meant to be given a global binding convenient to the user. Example:
** Icomplete
*** New key 'M-j' for 'icomplete-mode' and 'icomplete-vertical-mode'.
Like 'M-j' in 'fido-mode', it can exit the minibuffer with a selected
candidate even when 'icomplete-show-matches-on-no-input' is non-nil.
*** New user options for 'icomplete-vertical-mode'.
New user options have been added to enhance 'icomplete-vertical-mode':
@ -3324,6 +3349,11 @@ each refresh. The sort direction can be controlled by using a cons cell
of a format string and a boolean. Alternatively, a sorting function can
be provided directly.
---
*** New user option 'display-time-help-echo-format'.
This option controls the format of the help echo when hovering over the
time.
** Fill
+++
@ -3833,6 +3863,14 @@ It has been obsolete since Emacs 26.1. Use the group 'text' instead.
If supplied, 'string-pixel-width' will use any face remappings from
BUFFER when computing the string's width.
+++
** New function 'truncate-string-pixelwise'.
This function truncates a string to the specified maximum number of
pixels rather than by characters, as in 'truncate-string-to-width', and
respects face remappings if BUFFER is specified. You can also specify
an optional ellipsis string to append, similar to
'truncate-string-to-width'.
---
** New macro 'with-work-buffer'.
This macro is similar to the already existing macro 'with-temp-buffer',
@ -3928,6 +3966,13 @@ Binding 'inhibit-message' to a non-nil value will now suppress both
the display of messages and the clearing of the echo area, such as
caused by calling 'message' with a nil argument.
---
** 'minibuffer-message' no longer blocks while displaying message.
'minibuffer-message' now uses a timer to clear the message printed to
the minibuffer, instead of waiting with 'sit-for' and then clearing it.
This makes 'minibuffer-message' usable in Lisp programs which want to
print a message and then continue to perform work.
** Special Events
+++

2
etc/symbol-releases.eld
View file

@ -9,6 +9,8 @@
;; TYPE being `fun' or `var'.
(
("31.1" fun any)
("31.1" fun all)
("30.1" fun dired-click-to-select-mode)
("30.1" var dired-click-to-select-mode)
("29.1" fun plistp)

1
etc/tutorials/TUTORIAL.translators
View file

@ -39,6 +39,7 @@ Maintainer: Mohsen BANAN <emacs@mohsen.1.banan.byname.net>
* TUTORIAL.fr:
Author: Éric Jacoboni <jaco@teaser.fr>
Maintainer: Éric Jacoboni <jaco@teaser.fr>
Bastien Guerry <bzg@gnu.org>
* TUTORIAL.he
Author: Eli Zaretskii <eliz@gnu.org>

6
lisp/cus-start.el
View file

@ -150,7 +150,11 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(scroll-down-aggressively windows
(choice (const :tag "off" nil) float)
"21.1")
(line-spacing display (choice (const :tag "none" nil) number)
(line-spacing display
(choice (const :tag "No spacing" nil)
(number :tag "Spacing below")
(cons :tag "Spacing above and below"
number number))
"22.1")
(cursor-in-non-selected-windows
cursor ,cursor-type-types nil

10
lisp/desktop.el
View file

@ -1064,13 +1064,19 @@ DIRNAME must be the directory in which the desktop file will be saved."
;; ----------------------------------------------------------------------------
(defun desktop--check-dont-save (frame)
(not (frame-parameter frame 'desktop-dont-save)))
(and (not (frame-parameter frame 'desktop-dont-save))
;; Don't save daemon initial frames, since we cannot (and don't
;; need to) restore them.
(not (and (daemonp)
(equal (terminal-name (frame-terminal frame))
"initial_terminal")))))
(defconst desktop--app-id `(desktop . ,desktop-file-version))
(defun desktop-save-frameset ()
"Save the state of existing frames in `desktop-saved-frameset'.
Frames with a non-nil `desktop-dont-save' parameter are not saved."
Frames with a non-nil `desktop-dont-save' parameter are not saved.
Likewise the initial frame of a daemon sesion."
(setq desktop-saved-frameset
(and desktop-restore-frames
(frameset-save nil

6
lisp/emacs-lisp/bytecomp.el
View file

@ -1856,7 +1856,8 @@ It is too wide if it has any lines longer than the largest of
;; The native compiler doesn't use those dynamic docstrings.
(not byte-native-compiling)
;; Docstrings can only be dynamic when compiling a file.
byte-compile--\#$)
byte-compile--\#$
(not (equal doc ""))) ; empty lazy strings are pointless
(let* ((byte-pos (with-memoization
;; Reuse a previously written identical docstring.
;; This is not done out of thriftiness but to try and
@ -5141,7 +5142,8 @@ binding slots have been popped."
(when (stringp doc)
(setq rest (byte-compile--list-with-n
rest 0
(byte-compile--docstring doc (nth 0 form) name)))))
(byte-compile--docstring doc (nth 0 form) name)))
(setq form (nconc (take 3 form) rest))))
(pcase-let*
;; `macro' is non-nil if it defines a macro.
;; `fun' is the function part of `arg' (defaults to `arg').

29
lisp/emacs-lisp/checkdoc.el
View file

@ -381,6 +381,9 @@ large number of libraries means it is impractical to fix all
of these warnings masse. In almost any other case, setting
this to anything but t is likely to be counter-productive.")
(defvar checkdoc--batch-flag nil
"Non-nil in batch mode.")
(defun checkdoc-list-of-strings-p (obj)
"Return t when OBJ is a list of strings."
(declare (obsolete list-of-strings-p "29.1"))
@ -1063,12 +1066,13 @@ Optional argument INTERACT permits more interactive fixing."
(e (checkdoc-rogue-space-check-engine nil nil interact))
(checkdoc-generate-compile-warnings-flag
(or take-notes checkdoc-generate-compile-warnings-flag)))
(if (not (called-interactively-p 'interactive))
(if (not (or (called-interactively-p 'interactive) checkdoc--batch-flag))
e
(if e
(message "%s" (checkdoc-error-text e))
(checkdoc-show-diagnostics)
(message "Space Check: done.")))))
(if (called-interactively-p 'interactive)
(message "Space Check: done."))))))
;;;###autoload
(defun checkdoc-message-text (&optional take-notes)
@ -1081,7 +1085,7 @@ Optional argument TAKE-NOTES causes all errors to be logged."
(checkdoc-generate-compile-warnings-flag
(or take-notes checkdoc-generate-compile-warnings-flag)))
(setq e (checkdoc-message-text-search))
(if (not (called-interactively-p 'interactive))
(if (not (or (called-interactively-p 'interactive) checkdoc--batch-flag))
e
(if e
(user-error "%s" (checkdoc-error-text e))
@ -2819,7 +2823,7 @@ function called to create the messages."
(defun checkdoc-show-diagnostics ()
"Display the checkdoc diagnostic buffer in a temporary window."
(if checkdoc-pending-errors
(if (and checkdoc-pending-errors (not checkdoc--batch-flag))
(let* ((b (get-buffer checkdoc-diagnostic-buffer))
(win (if b (display-buffer b))))
(when win
@ -2832,6 +2836,23 @@ function called to create the messages."
(setq checkdoc-pending-errors nil)
nil)))
;;;###autoload
(defun checkdoc-batch ()
"Check current buffer in batch mode.
Report any errors and signal the first found error."
(when noninteractive
(let ((checkdoc-autofix-flag nil)
(checkdoc--batch-flag t))
(checkdoc-current-buffer t)
(when checkdoc-pending-errors
(when-let* ((b (get-buffer checkdoc-diagnostic-buffer)))
(with-current-buffer b
(princ (buffer-string)))
(terpri))
(checkdoc-current-buffer)))))
(defun checkdoc-get-keywords ()
"Return a list of package keywords for the current file."
(save-excursion

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

@ -327,15 +327,16 @@ FORM is of the form (ARGS . BODY)."
;; "manual" parsing.
(let ((slen (length simple-args))
(usage-str
;; Macro expansion can take place in the middle of
;; apparently harmless computation, so it should not
;; touch the match-data.
(save-match-data
(help--docstring-quote
(let ((print-gensym nil) (print-quoted t)
(print-escape-newlines t))
(format "%S" (cons 'fn (cl--make-usage-args
orig-args))))))))
;; Macro expansion can take place in the middle of
;; apparently harmless computation, so it should not
;; touch the match-data.
(save-match-data
(require 'help)
(help--docstring-quote
(let ((print-gensym nil) (print-quoted t)
(print-escape-newlines t))
(format "%S" (cons 'fn (cl--make-usage-args
orig-args))))))))
(when (memq '&optional simple-args)
(decf slen))
(setq header

24
lisp/emacs-lisp/cl-preloaded.el
View file

@ -296,10 +296,11 @@
(cl-defstruct (built-in-class
(:include cl--class)
(:conc-name built-in-class--)
(:noinline t)
(:constructor nil)
(:constructor built-in-class--make
(name docstring parent-types
(name docstring parent-types &optional non-abstract-supertype
&aux (parents
(mapcar (lambda (type)
(or (get type 'cl--class)
@ -308,7 +309,9 @@
(:copier nil))
"Type descriptors for built-in types.
The `slots' (and hence `index-table') are currently unused."
)
;; As a general rule, built-in types are abstract if-and-only-if they have
;; other built-in types as subtypes. But there are a few exceptions.
(non-abstract-supertype nil :read-only t))
(defmacro cl--define-built-in-type (name parents &optional docstring &rest slots)
;; `slots' is currently unused, but we could make it take
@ -322,19 +325,22 @@ The `slots' (and hence `index-table') are currently unused."
(let ((predicate (intern-soft (format
(if (string-match "-" (symbol-name name))
"%s-p" "%sp")
name))))
name)))
(nas nil))
(unless (fboundp predicate) (setq predicate nil))
(while (keywordp (car slots))
(let ((kw (pop slots)) (val (pop slots)))
(pcase kw
(:predicate (setq predicate val))
(:non-abstract-supertype (setq nas val))
(_ (error "Unknown keyword arg: %S" kw)))))
`(progn
,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate)
;; (message "Missing predicate for: %S" name)
nil)
(put ',name 'cl--class
(built-in-class--make ',name ,docstring ',parents)))))
(built-in-class--make ',name ,docstring ',parents
,@(if nas '(t)))))))
;; FIXME: Our type DAG has various quirks:
;; - Some `keyword's are also `symbol-with-pos' but that's not reflected
@ -381,6 +387,7 @@ regardless if `funcall' would accept to call them."
"Abstract supertype of both `number's and `marker's.")
(cl--define-built-in-type symbol atom
"Type of symbols."
:non-abstract-supertype t
;; Example of slots we could document. It would be desirable to
;; have some way to extract this from the C code, or somehow keep it
;; in sync (probably not for `cons' and `symbol' but for things like
@ -411,7 +418,8 @@ The size depends on the Emacs version and compilation options.
For this build of Emacs it's %dbit."
(1+ (logb (1+ most-positive-fixnum)))))
(cl--define-built-in-type boolean (symbol)
"Type of the canonical boolean values, i.e. either nil or t.")
"Type of the canonical boolean values, i.e. either nil or t."
:non-abstract-supertype t)
(cl--define-built-in-type symbol-with-pos (symbol)
"Type of symbols augmented with source-position information.")
(cl--define-built-in-type vector (array))
@ -450,9 +458,9 @@ The fields are used as follows:
5 [iform] The interactive form (if present)")
(cl--define-built-in-type byte-code-function (compiled-function closure)
"Type of functions that have been byte-compiled.")
(cl--define-built-in-type subr (atom)
"Abstract type of functions compiled to machine code.")
(cl--define-built-in-type module-function (function)
(cl--define-built-in-type subr (atom) ;Beware: not always a function.
"Abstract type of functions and special forms compiled to machine code.")
(cl--define-built-in-type module-function (compiled-function)
"Type of functions provided via the module API.")
(cl--define-built-in-type interpreted-function (closure)
"Type of functions that have not been compiled.")

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

@ -155,7 +155,10 @@ scanning for autoloads and will be in the `load-path'."
;; employing :autoload-end to omit unneeded forms).
(defconst loaddefs--defining-macros
'( transient-define-prefix transient-define-suffix transient-define-infix
transient-define-argument transient-define-group))
transient-define-argument
;; FIXME: How can this one make sense? It doesn't put anything
;; into `symbol-function'!
transient-define-group))
(defvar loaddefs--load-error-files nil)
(defun loaddefs-generate--make-autoload (form file &optional expansion)
@ -237,7 +240,7 @@ expand)' among their `declare' forms."
(push file loaddefs--load-error-files) ; do not attempt again
(warn "loaddefs-gen: load error\n\t%s" e)))))
(and (macrop car)
(eq 'expand (function-get car 'autoload-macro))
(eq 'expand (function-get car 'autoload-macro 'macro))
(setq expand (let ((load-true-file-name file)
(load-file-name file))
(macroexpand-1 form)))
@ -249,12 +252,7 @@ expand)' among their `declare' forms."
;; directly.
((memq car loaddefs--defining-macros)
(let* ((name (nth 1 form))
(args (pcase car
((or 'transient-define-prefix 'transient-define-suffix
'transient-define-infix 'transient-define-argument
'transient-define-group)
(nth 2 form))
(_ t)))
(args (nth 2 form))
(body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
(doc (if (stringp (car body)) (pop body))))
;; Add the usage form at the end where describe-function-1
@ -263,18 +261,7 @@ expand)' among their `declare' forms."
;; `define-generic-mode' quotes the name, so take care of that
(loaddefs-generate--shorten-autoload
`(autoload ,(if (listp name) name (list 'quote name))
,file ,doc
,(or (and (memq car '( transient-define-prefix
transient-define-suffix
transient-define-infix
transient-define-argument
transient-define-group))
t)
(and (eq (car-safe (car body)) 'interactive)
;; List of modes or just t.
(or (if (nthcdr 2 (car body))
(list 'quote (nthcdr 2 (car body)))
t))))))))
,file ,doc t))))
;; For defclass forms, use `eieio-defclass-autoload'.
((eq car 'defclass)

70
lisp/emacs-lisp/pcase.el
View file

@ -525,15 +525,13 @@ how many time this CODEGEN is called."
(if (pcase--self-quoting-p pat) `',pat pat))
((memq head '(guard quote)) pat)
((eq head 'pred)
;; Ad-hoc expansion of some predicates that are the complement of another.
;; Ad-hoc expansion of some predicates that are complements or aliases.
;; Not required for correctness but results in better code.
(let* ((expr (cadr pat))
(compl (assq expr '((atom . consp)
(nlistp . listp)
(identity . null)))))
(cond (compl `(,head (not ,(cdr compl))))
((eq expr 'not) `(,head null)) ; normalise
(t pat))))
(let ((equiv (assq (cadr pat) '((atom . (not consp))
(nlistp . (not listp))
(identity . (not null))
(not . null)))))
(if equiv `(,head ,(cdr equiv)) pat)))
((memq head '(or and)) `(,head ,@(mapcar #'pcase--macroexpand (cdr pat))))
((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
(t
@ -664,13 +662,22 @@ recording whether the var has been referenced by earlier parts of the match."
(lambda (x y)
(> (length (nth 2 x)) (length (nth 2 y))))))
;; We presume that the "fundamental types" (i.e. the built-in types
;; that have no subtypes) are all mutually exclusive and give them
;; one bit each in bitsets.
;; The "non-abstract-supertypes" also get their own bit.
;; All other built-in types are abstract, so they don't need their
;; own bits (they are faithfully modeled by the set of bits
;; corresponding to their subtypes).
(let ((bitsets (make-hash-table))
(i 1))
(dolist (x built-in-types)
;; Don't dedicate any bit to those predicates which already
;; have a bitset, since it means they're already represented
;; by their subtypes.
(unless (and (nth 1 x) (gethash (nth 1 x) bitsets))
(unless (and (nth 1 x) (gethash (nth 1 x) bitsets)
(not (built-in-class--non-abstract-supertype
(get (nth 0 x) 'cl--class))))
(dolist (parent (nth 2 x))
(let ((pred (nth 1 (assq parent built-in-types))))
(unless (or (eq parent t) (null pred))
@ -678,24 +685,35 @@ recording whether the var has been referenced by earlier parts of the match."
bitsets))))
(setq i (+ i i))))
;; (cl-assert (= (1- i) (apply #'logior (map-values bitsets))))
;; Extra predicates that don't have matching types.
(dolist (pred-types '((functionp cl-functionp consp symbolp)
(keywordp symbolp)
(characterp fixnump)
(natnump integerp)
(facep symbolp stringp)
(plistp listp)
(cl-struct-p recordp)
;; ;; FIXME: These aren't quite in the same
;; ;; category since they'll signal errors.
(fboundp symbolp)
))
(puthash (car pred-types)
(apply #'logior
(mapcar (lambda (pred)
(gethash pred bitsets))
(cdr pred-types)))
bitsets))
;; Beware: For these predicates, the bitsets are conservative
;; approximations (so, e.g., it wouldn't be correct to use one of
;; them after a `!' since the negation would be an unsound
;; under-approximation).
(let ((all (1- i)))
(dolist (pred-types '((functionp cl-functionp consp symbolp)
(keywordp symbolp)
(nlistp ! listp)
(characterp fixnump)
(natnump integerp)
(facep symbolp stringp)
(plistp listp)
(cl-struct-p recordp)
;; ;; FIXME: These aren't quite in the same
;; ;; category since they'll signal errors.
(fboundp symbolp)
))
(let* ((types (cdr pred-types))
(neg (when (eq '! (car types)) (setq types (cdr types))))
(bitset (apply #'logior
(mapcar (lambda (pred)
(gethash pred bitsets))
types))))
(puthash (car pred-types)
(if neg (- all bitset) bitset)
bitsets))))
bitsets)))
(defconst pcase--subtype-bitsets

4
lisp/emacs-lisp/seq.el
View file

@ -567,7 +567,7 @@ This does not modify SEQUENCE1 or SEQUENCE2."
;;;###autoload
(cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
"Return copy of SEQUENCE1 with elements that appear in SEQUENCE2 removed.
"Return copy of SEQUENCE1 with elements that do not appear in SEQUENCE2 removed.
\"Equality\" of elements is defined by the function TESTFN, which
defaults to `equal'.
This does not modify SEQUENCE1 or SEQUENCE2."
@ -579,7 +579,7 @@ This does not modify SEQUENCE1 or SEQUENCE2."
'()))
(cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn)
"Return list of all the elements that appear in SEQUENCE1 but not in SEQUENCE2.
"Return copy of SEQUENCE1 with elements that appear in SEQUENCE2 removed.
\"Equality\" of elements is defined by the function TESTFN, which
defaults to `equal'.
This does not modify SEQUENCE1 or SEQUENCE2."

103
lisp/emacs-lisp/subr-x.el
View file

@ -37,6 +37,7 @@
(eval-when-compile (require 'cl-lib))
(require 'mule-util)
(defmacro internal--thread-argument (first? &rest forms)
"Internal implementation for `thread-first' and `thread-last'.
@ -357,6 +358,29 @@ buffer when possible, instead of creating a new one on each call."
(progn ,@body)
(work-buffer--release ,work-buffer))))))
(defun work-buffer--prepare-pixelwise (string buffer)
"Set up the current buffer to correctly compute STRING's pixel width.
Call this with a work buffer as the current buffer.
BUFFER is the originating buffer and if non-nil, make the current
buffer's (work buffer) face remappings match it."
(when buffer
(dolist (v '(face-remapping-alist
char-property-alias-alist
default-text-properties))
(if (local-variable-p v buffer)
(set (make-local-variable v)
(buffer-local-value v buffer)))))
;; Avoid deactivating the region as side effect.
(let (deactivate-mark)
(insert string))
;; If `display-line-numbers' is enabled in internal
;; buffers (e.g. globally), it breaks width calculation
;; (bug#59311). Disable `line-prefix' and `wrap-prefix',
;; for the same reason.
(add-text-properties
(point-min) (point-max)
'(display-line-numbers-disable t line-prefix "" wrap-prefix "")))
;;;###autoload
(defun string-pixel-width (string &optional buffer)
"Return the width of STRING in pixels.
@ -371,26 +395,69 @@ substring that does not include newlines."
;; Keeping a work buffer around is more efficient than creating a
;; new temporary buffer.
(with-work-buffer
;; Setup current buffer to correctly compute pixel width.
(when buffer
(dolist (v '(face-remapping-alist
char-property-alias-alist
default-text-properties))
(if (local-variable-p v buffer)
(set (make-local-variable v)
(buffer-local-value v buffer)))))
;; Avoid deactivating the region as side effect.
(let (deactivate-mark)
(insert string))
;; If `display-line-numbers' is enabled in internal
;; buffers (e.g. globally), it breaks width calculation
;; (bug#59311). Disable `line-prefix' and `wrap-prefix',
;; for the same reason.
(add-text-properties
(point-min) (point-max)
'(display-line-numbers-disable t line-prefix "" wrap-prefix ""))
(work-buffer--prepare-pixelwise string buffer)
(car (buffer-text-pixel-size nil nil t)))))
;;;###autoload
(defun truncate-string-pixelwise (string max-pixels &optional buffer
ellipsis ellipsis-pixels)
"Return STRING truncated to fit within MAX-PIXELS.
If BUFFER is non-nil, use the face remappings, alternative and default
properties from that buffer when determining the width.
If you call this function to measure pixel width of a string
with embedded newlines, it returns the width of the widest
substring that does not include newlines.
If ELLIPSIS is non-nil, it should be a string which will replace the end
of STRING if it extends beyond MAX-PIXELS, unless the pixel width of
STRING is equal to or less than the pixel width of ELLIPSIS. If it is
non-nil and not a string, then ELLIPSIS defaults to
`truncate-string-ellipsis', or to three dots when it's nil.
If ELLIPSIS-PIXELS is non-nil, it is the pixel width of ELLIPSIS, and
can be used to avoid the cost of recomputing this for multiple calls to
this function using the same ELLIPSIS."
(declare (important-return-value t))
(if (zerop (length string))
0
;; Keeping a work buffer around is more efficient than creating a
;; new temporary buffer.
(with-work-buffer
(work-buffer--prepare-pixelwise string buffer)
(set-window-buffer nil (current-buffer) 'keep-margins)
;; Use a binary search to prune the number of calls to
;; `window-text-pixel-size'.
;; These are 1-based buffer indexes.
(let* ((low 1)
(high (1+ (length string)))
mid)
(when (> (car (window-text-pixel-size nil 1 high)) max-pixels)
(when (and ellipsis (not (stringp ellipsis)))
(setq ellipsis (truncate-string-ellipsis)))
(setq ellipsis-pixels (if ellipsis
(if ellipsis-pixels
ellipsis-pixels
(string-pixel-width ellipsis buffer))
0))
(let ((adjusted-pixels
(if (> max-pixels ellipsis-pixels)
(- max-pixels ellipsis-pixels)
max-pixels)))
(while (<= low high)
(setq mid (floor (+ low high) 2))
(if (<= (car (window-text-pixel-size nil 1 mid))
adjusted-pixels)
(setq low (1+ mid))
(setq high (1- mid))))))
(set-window-buffer nil buffer 'keep-margins)
(if mid
;; Binary search ran.
(if (and ellipsis (> max-pixels ellipsis-pixels))
(concat (substring string 0 (1- high)) ellipsis)
(substring string 0 (1- high)))
;; Fast path.
string)))))
;;;###autoload
(defun string-glyph-split (string)
"Split STRING into a list of strings representing separate glyphs.

2
lisp/files.el
View file

@ -5478,7 +5478,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
(defvar file-name-version-regexp
"\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)"
;; The last ~[[:digit]]+ matches relative versions in git,
;; The last ~[[:digit:]]+ matches relative versions in git,
;; e.g. `foo.js.~HEAD~1~'.
"Regular expression matching the backup/version part of a file name.
Used by `file-name-sans-versions'.")

25
lisp/frame.el
View file

@ -1440,13 +1440,14 @@ This is useful when you have a frame ID and a potentially dead frame
reference that may have been resurrected. Also see `frame-live-p'."
(frame-live-p (frame-by-id id)))
(defun select-frame-by-id (id)
(defun select-frame-by-id (id &optional noerror)
"Select the frame whose identifier is ID and raise it.
If the frame is undeletable, undelete it.
Frames on the current terminal are checked first.
Raise the frame and give it input focus. On a text terminal, the frame
will occupy the entire terminal screen after the next redisplay.
If there is no frame with that ID, signal an error."
Return the selected frame or signal an error if no frame matching ID
was found. If NOERROR is non-nil, return nil instead."
(interactive
(let* ((frame-ids-alist (frame--make-frame-ids-alist))
(default (car (car frame-ids-alist)))
@ -1455,15 +1456,19 @@ If there is no frame with that ID, signal an error."
frame-ids-alist nil t)))
(list (string-to-number
(if (zerop (length input)) default input)))))
;; `undelete-frame-by-id' returns the undeleted frame, or nil.
(unless (undelete-frame-by-id id 'noerror)
(select-frame-set-input-focus
;; Prefer frames on the current display.
(or (cdr (assq id (frame--make-frame-ids-alist)))
(catch 'done
(dolist (frame (frame-list))
(when (eq (frame-id frame) id)
(throw 'done frame))))
(error "There is no frame with identifier `%S'" id)))))
;; Prefer frames on the current display.
(if-let* ((found (or (cdr (assq id (frame--make-frame-ids-alist)))
(catch 'done
(dolist (frame (frame-list))
(when (eq (frame-id frame) id)
(throw 'done frame)))))))
(progn
(select-frame-set-input-focus found)
found)
(unless noerror
(error "There is no frame with identifier `%S'" id)))))
;;;; Background mode.

15
lisp/frameset.el
View file

@ -1362,9 +1362,18 @@ All keyword parameters default to nil."
;; Clean up the frame list
(when cleanup-frames
(let ((map nil)
(cleanup (if (eq cleanup-frames t)
(lambda (frame action)
(when (memq action '(:rejected :ignored))
(cleanup
(if (eq cleanup-frames t)
(lambda (frame action)
(when (and (memq action '(:rejected :ignored))
;; Don't try deleting the daemon's initial
;; frame, as that would only trigger
;; warnings.
(not
(and (daemonp)
(equal (terminal-name (frame-terminal
frame))
"initial_terminal"))))
(delete-frame frame)))
cleanup-frames)))
(maphash (lambda (frame _action) (push frame map)) frameset--action-map)

4
lisp/help-fns.el
View file

@ -40,8 +40,8 @@
(defvar help-fns-describe-function-functions nil
"List of functions to run in help buffer in `describe-function'.
Those functions will be run after the header line and argument
list was inserted, and before the documentation is inserted.
Those functions will be run after the header line, the argument
list, and the function's documentation are inserted.
The functions will be called with one argument: the function's symbol.
They can assume that a newline was output just before they were called,
and they should terminate any of their own output with a newline.

3
lisp/icomplete.el
View file

@ -242,6 +242,7 @@ Used to implement the option `icomplete-show-matches-on-no-input'.")
:doc "Keymap used by `icomplete-mode' in the minibuffer."
"C-M-i" #'icomplete-force-complete
"C-j" #'icomplete-force-complete-and-exit
"M-j" #'icomplete-exit
"C-." #'icomplete-forward-completions
"C-," #'icomplete-backward-completions
"<remap> <minibuffer-complete-and-exit>" #'icomplete-ret)
@ -455,6 +456,8 @@ if that doesn't produce a completion match."
(minibuffer-complete-and-exit)
(exit-minibuffer)))
(defalias 'icomplete-exit #'icomplete-fido-exit)
(defun icomplete-fido-backward-updir ()
"Delete char before or go up directory, like `ido-mode'."
(interactive)

3
lisp/jsonrpc.el
View file

@ -488,7 +488,8 @@ to the original request (normal or error) are ignored."
,@(when (plist-member args :timeout) `(:timeout ,timeout)))))
(cond (cancel-on-input
(unwind-protect
(let ((inhibit-quit t)) (while (sit-for 30)))
(let ((inhibit-quit t) (inhibit-redisplay t))
(while (sit-for 30 t)))
(setq canceled t))
(when (functionp cancel-on-input)
(funcall cancel-on-input (car id-and-timer)))

104
lisp/ldefs-boot.el
View file

@ -2699,10 +2699,10 @@ from `browse-url-elinks-wrapper'.
(fn URL &optional NEW-WINDOW)" t)
(autoload 'browse-url-button-open "browse-url" "\
Follow the link under point using `browse-url'.
If EXTERNAL (the prefix if used interactively), open with the
external browser instead of the default one.
If SECONDARY (the prefix if used interactively), open with the
secondary browser instead of the default one.
(fn &optional EXTERNAL MOUSE-EVENT)" t)
(fn &optional SECONDARY MOUSE-EVENT)" t)
(autoload 'browse-url-button-open-url "browse-url" "\
Open URL using `browse-url'.
If `current-prefix-arg' is non-nil, use
@ -5133,7 +5133,7 @@ List of directories to search for source files named in error messages.
Elements should be directory names, not file names of directories.
The value nil as an element means to try the default directory.")
(custom-autoload 'compilation-search-path "compile" t)
(defvar compile-command "make -k " "\
(defvar compile-command (format "make -k -j%d " (ceiling (num-processors) 1.5)) "\
Last shell command used to do a compilation; default for next compilation.
Sometimes it is useful for files to supply local values for this variable.
@ -13691,8 +13691,6 @@ evaluate the variable `flymake-mode'.
The mode's hook is called both when the mode is enabled and when it is
disabled.
\\{flymake-mode-map}
(fn &optional ARG)" t)
(autoload 'flymake-mode-on "flymake" "\
Turn Flymake mode on.")
@ -24735,6 +24733,21 @@ If optional argument NOCONFIRM is non-nil, or when invoked with a prefix
argument, don't ask for confirmation to install packages.
(fn &optional NOCONFIRM)" t)
(autoload 'package-delete "package" "\
Delete package PKG-DESC.
Argument PKG-DESC is the full description of the package, for example as
obtained by `package-get-descriptor'. Interactively, prompt the user
for the package name and version.
When package is used elsewhere as dependency of another package,
refuse deleting it and return an error.
If prefix argument FORCE is non-nil, package will be deleted even
if it is used elsewhere.
If NOSAVE is non-nil, the package is not removed from
`package-selected-packages'.
(fn PKG-DESC &optional FORCE NOSAVE)" t)
(autoload 'package-reinstall "package" "\
Reinstall package PKG.
PKG should be either a symbol, the package name, or a `package-desc'
@ -24779,11 +24792,18 @@ short description.
(defcustom package-quickstart-file (locate-user-emacs-file "package-quickstart.el") "\
Location of the file used to speed up activation of packages at startup." :type 'file :group 'applications :initialize #'custom-initialize-delay :version "27.1")
(custom-autoload 'package-quickstart-file "package" t)
(autoload 'package-browse-url "package" "\
Open the website of the package under point in a browser.
`browse-url' is used to determine the browser to be used. If
SECONDARY (interactively, the prefix), use the secondary browser.
DESC must be a `package-desc' object.
(fn DESC &optional SECONDARY)" t)
(autoload 'package-report-bug "package" "\
Prepare a message to send to the maintainers of a package.
DESC must be a `package-desc' object.
(fn DESC)" '(package-menu-mode))
(fn DESC)" t)
(register-definition-prefixes "package" '("bad-signature" "define-package" "describe-package-1" "package-"))
@ -25815,6 +25835,10 @@ Note that this function doesn't work if DELTA is larger than
the height of the current window.
(fn DELTA)")
(autoload 'pixel-scroll-interpolate-down "pixel-scroll" "\
Interpolate a scroll downwards by one page." t)
(autoload 'pixel-scroll-interpolate-up "pixel-scroll" "\
Interpolate a scroll upwards by one page." t)
(defvar pixel-scroll-precision-mode nil "\
Non-nil if Pixel-Scroll-Precision mode is enabled.
See the `pixel-scroll-precision-mode' command
@ -27749,8 +27773,6 @@ evaluate the variable `rectangle-mark-mode'.
The mode's hook is called both when the mode is enabled and when it is
disabled.
\\{rectangle-mark-mode-map}
(fn &optional ARG)" t)
(register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-"))
@ -36590,6 +36612,50 @@ topic branch. (With a double prefix argument, this command is like
When called from Lisp, optional argument FILESET overrides the fileset.
(fn &optional UPSTREAM-LOCATION FILESET)" t)
(autoload 'vc-log-outgoing-base "vc" "\
Show log for the 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.
When unspecified, UPSTREAM-LOCATION is the outgoing base.
For a trunk branch this is always the place \\[vc-push] would push to.
For a topic branch, query the backend for an appropriate outgoing base.
See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding
the difference between trunk and topic branches.
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 interactively with a \\[universal-argument] \\[universal-argument] prefix argument, always
use the place to which \\[vc-push] would push to as the outgoing base,
i.e., treat this branch as a trunk branch even if Emacs thinks it is a
topic branch.
When called from Lisp, optional argument FILESET overrides the fileset.
(fn &optional UPSTREAM-LOCATION FILESET)" t)
(autoload 'vc-root-log-outgoing-base "vc" "\
Show log of revisions since the merge base with UPSTREAM-LOCATION.
The merge base with UPSTREAM-LOCATION means the common ancestor of the
working revision and UPSTREAM-LOCATION.
When unspecified, UPSTREAM-LOCATION is the outgoing base.
For a trunk branch this is always the place \\[vc-push] would push to.
For a topic branch, query the backend for an appropriate outgoing base.
See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding
the difference between trunk and topic branches.
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 interactively with a \\[universal-argument] \\[universal-argument] prefix argument, always
use the place to which \\[vc-push] would push to as the outgoing base,
i.e., treat this branch as a trunk branch even if Emacs thinks it is a
topic branch.
(fn &optional UPSTREAM-LOCATION)" t)
(autoload 'vc-version-ediff "vc" "\
Show differences between REV1 and REV2 of FILES using ediff.
This compares two revisions of the files in FILES. Currently,
@ -37320,7 +37386,7 @@ step during initialization." t)
;;; Generated autoloads from progmodes/verilog-mode.el
(push '(verilog-mode 2025 11 8 248496848) package--builtin-versions)
(push '(verilog-mode 2026 1 18 88738971) package--builtin-versions)
(autoload 'verilog-mode "verilog-mode" "\
Major mode for editing Verilog code.
\\<verilog-mode-map>
@ -39641,6 +39707,14 @@ list. Delete FRAME2 if the merge completed successfully and return
FRAME1.
(fn &optional FRAME1 FRAME2 VERTICAL)" t)
(autoload 'window-get-split-combination "window-x" "\
Return window combination suitable for `split-frame'.
WINDOW is the main window in which the combination should be derived.
ARG is the argument passed to `split-frame'. Return a
combination of windows `split-frame' is considered to split off.
(fn WINDOW ARG)")
(autoload 'split-frame "window-x" "\
Split windows of specified FRAME into two separate frames.
FRAME must be a live frame and defaults to the selected frame. ARG
@ -39975,12 +40049,9 @@ output of this command when the backend is etags.
(define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
(autoload 'xref-references-in-directory "xref" "\
Find all references to SYMBOL in directory DIR.
See `xref-references-in-directory-function' for the implementation.
Return a list of xref values.
This function uses the Semantic Symbol Reference API, see
`semantic-symref-tool-alist' for details on which tools are used,
and when.
(fn SYMBOL DIR)")
(autoload 'xref-matches-in-directory "xref" "\
Find all matches for REGEXP in directory DIR.
@ -39988,8 +40059,9 @@ Return a list of xref values.
Only files matching some of FILES and none of IGNORES are searched.
FILES is a string with glob patterns separated by spaces.
IGNORES is a list of glob patterns for files to ignore.
If DELIMITED is `symbol', only select matches that span full symbols.
(fn REGEXP FILES DIR IGNORES)")
(fn REGEXP FILES DIR IGNORES &optional DELIMITED)")
(autoload 'xref-matches-in-files "xref" "\
Find all matches for REGEXP in FILES.
Return a list of xref values.
@ -40087,7 +40159,7 @@ 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.")
(when (boundp 'treesit-major-mode-remap-alist) (add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode-maybe)) (add-to-list 'treesit-major-mode-remap-alist '(yaml-mode . yaml-ts-mode)))
(register-definition-prefixes "yaml-ts-mode" '("yaml-ts-mode--"))
(register-definition-prefixes "yaml-ts-mode" '("yaml-ts-mode-"))
;;; Generated autoloads from yank-media.el

198
lisp/leim/quail/iroquoian.el
View file

@ -24,7 +24,7 @@
;; This file implements input methods for Northern Iroquoian languages.
;; Input methods are implemented for all Five Nations Iroquois
;; Input methods are implemented for the following Northern Iroquoian
;; languages:
;; - Mohawk (Kanien’kéha / Kanyen’kéha / Onkwehonwehnéha)
@ -32,6 +32,7 @@
;; - Onondaga (Onųdaʔgegáʔ)
;; - Cayuga (Gayogo̱ho:nǫhnéha:ˀ)
;; - Seneca (Onödowá’ga:’)
;; - Tuscarora (Skarù·ręʔ)
;; A composite input method for all of the languages above is also
;; defined: `haudenosaunee-postfix'.
@ -39,7 +40,6 @@
;; Input methods are not yet implemented for the remaining Northern
;; Iroquoian languages, including:
;; - Tuscarora (Skarù:ręʔ)
;; - Wendat (Huron) / Wyandot
;;; Code:
@ -798,6 +798,159 @@ simultaneously using the input method `haudenosaunee-postfix'."
iroquoian-seneca-vowel-alist))
(quail-defrule key trans))
;;; Tuscarora
;;
;; The primary community orthography used for Tuscarora follows that
;; used in Blair Rudes's dictionary (see below).
;;
;; Reference work for Tuscarora orthography:
;;
;; Blair Rudes. 1999. Tuscarora-English/English-Tuscarora
;; dictionary. Toronto: University of Toronto Press.
;;
(defconst iroquoian-tuscarora-modifier-alist
'(("::" ?\N{MIDDLE DOT}))
"Alist of rules for modifier letters in Tuscarora input methods.
Entries are as with rules in `quail-define-rules'.")
(defconst iroquoian-tuscarora-vowel-alist
'(("a'" ?á)
("a`" ?à)
("A'" ?Á)
("A`" ?À)
("e'" ?é)
("e`" ?è)
("E'" ?É)
("E`" ?È)
("i'" ?í)
("i`" ?ì)
("I'" ?Í)
("I`" ?Ì)
("u'" ?ú)
("u`" ?ù)
("U'" ?Ú)
("U`" ?Ù)
("e," ?ę)
("e,'" ["ę́"])
("e,`" ["ę̀"])
("E," ?Ę)
("E,'" ["Ę́"])
("E,`" ["Ę̀"])
("a''" ["a'"])
("a``" ["a`"])
("A''" ["A'"])
("A``" ["A`"])
("e''" ["e'"])
("e``" ["e`"])
("E''" ["E'"])
("E``" ["E`"])
("i''" ["i'"])
("i``" ["i`"])
("I''" ["I'"])
("I``" ["I`"])
("u''" ["u'"])
("u``" ["u`"])
("U''" ["U'"])
("U``" ["U`"])
("e,," ["e,"])
("e,''" ["ę'"])
("e,``" ["ę`"])
("E,," ["E,"])
("E,''" ["Ę'"])
("E,``" ["Ę`"]))
"Alist of rules for vowel letters in Tuscarora input methods.
Entries are as with rules in `quail-define-rules'.")
(defconst iroquoian-tuscarora-consonant-alist
'((";;" ?\N{LATIN LETTER GLOTTAL STOP})
("c/" ?č)
("c//" ["c/"])
("C/" ?Č)
("C//" ["C/"])
("t/" ?θ)
("t//" ["t/"]))
"Alist of rules for consonant letters in Tuscarora input methods.
Entries are as with rules in `quail-define-rules'.")
(defconst iroquoian-tuscarora-exception-alist
'(("_" ?\N{COMBINING LOW LINE})
("__" ?_))
"Alist of rules for phonological exception marking in Tuscarora input methods.
Entries are as with rules in `quail-define-rules'.")
(quail-define-package
"tuscarora-postfix" "Tuscarora" "TUS<" t
"Tuscarora (Skarù·ręʔ) input method with postfix modifiers
Modifiers:
| Key | Translation | Description |
|-----+-------------+--------------------------|
| :: | · | Vowel length |
Stress diacritics:
| Key | Description | Example |
|------+--------------+---------|
| \\=' | Acute accent | a' -> á |
| \\=` | Grave accent | a` -> à |
Doubling the postfix separates the letter and the postfix.
Vowels:
| Key | Translation | Description |
|-----+-------------+---------------------------------|
| e, | ę | Mid front nasal vowel |
| E, | Ę | Mid front nasal vowel (capital) |
a, e, i, and u are bound to a single key.
Consonants:
| Key | Translation | Description |
|-------+-------------+------------------------------------|
| ;; | ˀ | Glottal stop |
| c/ | č | Postalveolar affricate |
| C/ | Č | Postalveolar affricate (capital) |
| t/ | θ | Voiceless dental fricative |
h, k, n, r, s, t, w, and y are bound to a single key.
b, l, m, and p are used rarely in loanwords. They are also each bound
to a single key.
Stress exception markers:
| Key | Description | Example |
|-----+--------------------+----------|
| _ | Combining low line | a_ -> a̲ |
Note: Not all fonts can properly display a combining low line on all
letters.
Underlining has been used by some to indicate that vowels behave
exceptionally with regard to stress placement. Alternatively, markup or
other methods can be used to create an underlining effect.
To enter a plain underscore, type the underscore twice.
All Haudenosaunee languages, including Tuscarora can be input
simultaneously using the input method `haudenosaunee-postfix'."
nil t nil nil nil nil nil nil nil nil t)
(pcase-dolist (`(,key ,trans)
(append iroquoian-tuscarora-modifier-alist
iroquoian-tuscarora-consonant-alist
iroquoian-tuscarora-vowel-alist
iroquoian-tuscarora-exception-alist))
(quail-defrule key trans))
;;; Haudenosaunee (composite Northern Iroquoian)
@ -857,7 +1010,8 @@ simultaneously using the input method `haudenosaunee-postfix'."
iroquoian-oneida-modifier-alist
iroquoian-onondaga-modifier-alist
iroquoian-cayuga-modifier-alist
iroquoian-seneca-modifier-alist))
iroquoian-seneca-modifier-alist
iroquoian-tuscarora-modifier-alist))
"Alist of rules for modifier letters in Haudenosaunee input methods.
Entries are as with rules in `quail-define-rules'.")
@ -866,7 +1020,8 @@ Entries are as with rules in `quail-define-rules'.")
iroquoian-oneida-vowel-alist
iroquoian-onondaga-vowel-alist
iroquoian-cayuga-vowel-alist
iroquoian-seneca-vowel-alist))
iroquoian-seneca-vowel-alist
iroquoian-tuscarora-vowel-alist))
"Alist of rules for vowel letters in Haudenosaunee input methods.
Entries are as with rules in `quail-define-rules'.")
@ -879,16 +1034,17 @@ Entries are as with rules in `quail-define-rules'.")
iroquoian-oneida-consonant-alist
iroquoian-onondaga-consonant-alist
iroquoian-cayuga-consonant-alist
iroquoian-seneca-consonant-alist)
iroquoian-seneca-consonant-alist
iroquoian-tuscarora-consonant-alist)
(lambda (c1 c2)
(equal (car c1) (car c2))))
"Alist of rules for consonant letters in Haudenosaunee input methods.
Entries are as with rules in `quail-define-rules'.")
(defconst iroquoian-haudenosaunee-devoicing-alist
(defconst iroquoian-haudenosaunee-exception-alist
'(("_" ?\N{COMBINING LOW LINE})
("__" ?_))
"Alist of rules for devoicing characters in Haudenosaunee input methods.
"Rules' alist for phonological exception markers in Haudenosaunee input methods.
Entries are as with rules in `quail-define-rules'.")
(defconst iroquoian-haudenosaunee-nasal-alist iroquoian-onondaga-nasal-alist
@ -906,6 +1062,7 @@ This input method can be used to enter the following languages:
- Cayuga (Gayogo̱ho:nǫhnéha:ˀ)
- Onondaga (Onųdaʔgegáʔ)
- Seneca (Onödowá’ga:’)
- Tuscarora (Skarù·ręʔ)
Modifiers:
@ -989,6 +1146,12 @@ Vowels:
| a\" | ä | Low front vowel |
| A\" | Ä | Low front vowel (capital) |
| Single-key vowels: a e i o u |
|----------------------------------------------------------------------|
| Tuscarora |
| -------------------------------------------------------------------- |
| e, | ę | Mid front nasal vowel |
| E, | Ę | Mid front nasal vowel (capital) |
| Single-key vowels: a e i u |
Consonants:
@ -1023,8 +1186,16 @@ Consonants:
| s/ | š | Voiceless postalveolar fricative |
| S/ | Š | Voiceless postalveolar fricative (capital) |
| Single-key consonants: d g h j k n s t w y z (b m p) |
|----------------------------------------------------------------------|
| Tuscarora |
| -------------------------------------------------------------------- |
| ;: | ʔ | Glottal stop (alternate) |
| c/ | č | Postalveolar affricate |
| C/ | Č | Postalveolar affricate (capital) |
| t/ | θ | Voiceless dental fricative |
| Single-key consonants: h k n r s t w y (b l m p) |
Devoicing:
Phonological exception markers:
| Key | Description | Examples |
|-----+------------------------+------------------------------|
@ -1035,8 +1206,10 @@ Note: Not all fonts can properly display a combining low line on all
letters and a combining macron below on all vowels.
Underlining is commonly used in Oneida to indicate devoiced syllables on
pre-pausal forms (also called utterance-final forms). Alternatively,
markup or other methods can be used to create an underlining effect.
pre-pausal forms (also called utterance-final forms), and it has been
used in some Tuscarora orthographies to indicate that vowels behave
exceptionally with regard to stress placement. Alternatively, markup or
other methods can be used to create an underlining effect.
To enter a plain underscore, the underscore twice.
@ -1046,7 +1219,8 @@ To enter a plain hyphen after a vowel, simply type the hyphen twice.
There are individual input methods for each of the languages that can be
entered with this input method: `mohawk-postfix', `oneida-postfix',
`onondaga-postfix', `cayuga-postfix', `seneca-postfix'."
`onondaga-postfix', `cayuga-postfix', `seneca-postfix',
`tuscarora-postfix'.."
nil t nil nil nil nil nil nil nil nil t)
(pcase-dolist (`(,key ,trans)
@ -1054,7 +1228,7 @@ entered with this input method: `mohawk-postfix', `oneida-postfix',
iroquoian-haudenosaunee-consonant-alist
iroquoian-haudenosaunee-nasal-alist
iroquoian-haudenosaunee-vowel-alist
iroquoian-haudenosaunee-devoicing-alist))
iroquoian-haudenosaunee-exception-alist))
(quail-defrule key trans))
(provide 'iroquoian)

104
lisp/minibuffer.el
View file

@ -797,6 +797,19 @@ for use at QPOS."
(defvar minibuffer-message-properties nil
"Text properties added to the text shown by `minibuffer-message'.")
(defvar minibuffer--message-overlay nil)
(defvar minibuffer--message-timer nil)
(defun minibuffer--delete-message-overlay ()
(when (overlayp minibuffer--message-overlay)
(delete-overlay minibuffer--message-overlay)
(setq minibuffer--message-overlay nil))
(when (timerp minibuffer--message-timer)
(cancel-timer minibuffer--message-timer)
(setq minibuffer--message-timer nil))
(remove-hook 'pre-command-hook #'minibuffer--delete-message-overlay))
(defun minibuffer-message (message &rest args)
"Temporarily display MESSAGE at the end of minibuffer text.
This function is designed to be called from the minibuffer, i.e.,
@ -814,13 +827,9 @@ through `format-message'.
If some of the minibuffer text has the `minibuffer-message' text
property, MESSAGE is shown at that position instead of EOB."
(if (not (minibufferp (current-buffer) t))
(progn
(if args
(apply #'message message args)
(message "%s" message))
(prog1 (sit-for (or minibuffer-message-timeout 1000000))
(message nil)))
(apply #'message message args)
;; Clear out any old echo-area message to make way for our new thing.
(minibuffer--delete-message-overlay)
(message nil)
(setq message (if (and (null args)
(string-match-p "\\` *\\[.+\\]\\'" message))
@ -834,30 +843,24 @@ property, MESSAGE is shown at that position instead of EOB."
(setq message (apply #'propertize message minibuffer-message-properties)))
;; Put overlay either on `minibuffer-message' property, or at EOB.
(let* ((ovpos (minibuffer--message-overlay-pos))
(ol (make-overlay ovpos ovpos nil t t))
;; A quit during sit-for normally only interrupts the sit-for,
;; but since minibuffer-message is used at the end of a command,
;; at a time when the command has virtually finished already, a C-g
;; should really cause an abort-recursive-edit instead (i.e. as if
;; the C-g had been typed at top-level). Binding inhibit-quit here
;; is an attempt to get that behavior.
(inhibit-quit t))
(unwind-protect
(progn
(unless (zerop (length message))
;; The current C cursor code doesn't know to use the overlay's
;; marker's stickiness to figure out whether to place the cursor
;; before or after the string, so let's spoon-feed it the pos.
(put-text-property 0 1 'cursor t message))
(overlay-put ol 'after-string message)
;; Make sure the overlay with the message is displayed before
;; any other overlays in that position, in case they have
;; resize-mini-windows set to nil and the other overlay strings
;; are too long for the mini-window width. This makes sure the
;; temporary message will always be visible.
(overlay-put ol 'priority 1100)
(sit-for (or minibuffer-message-timeout 1000000)))
(delete-overlay ol)))))
(ol (make-overlay ovpos ovpos nil t t)))
(unless (zerop (length message))
;; The current C cursor code doesn't know to use the overlay's
;; marker's stickiness to figure out whether to place the cursor
;; before or after the string, so let's spoon-feed it the pos.
(put-text-property 0 1 'cursor t message))
(overlay-put ol 'after-string message)
;; Make sure the overlay with the message is displayed before
;; any other overlays in that position, in case they have
;; resize-mini-windows set to nil and the other overlay strings
;; are too long for the mini-window width. This makes sure the
;; temporary message will always be visible.
(overlay-put ol 'priority 1100)
(setq minibuffer--message-overlay ol
minibuffer--message-timer
(run-at-time (or minibuffer-message-timeout 1000000) nil
#'minibuffer--delete-message-overlay))
(add-hook 'pre-command-hook #'minibuffer--delete-message-overlay))))
(defcustom minibuffer-message-clear-timeout nil
"How long to display an echo-area message when the minibuffer is active.
@ -2774,18 +2777,27 @@ so that the update is less likely to interfere with user typing."
;; If we got interrupted, try again the next time the user is idle.
(completions--start-eager-display))))
(defun completions--start-eager-display ()
(defun completions--start-eager-display (&optional require-eager-update)
"Maybe display the *Completions* buffer when the user is next idle.
Only displays if `completion-eager-display' is t, or if eager display
has been requested by the completion table."
(when completion-eager-display
(when (or (eq completion-eager-display t)
(completion-metadata-get
(completion-metadata
(buffer-substring-no-properties (minibuffer-prompt-end) (point))
minibuffer-completion-table minibuffer-completion-predicate)
'eager-display))
has been requested by the completion table.
When REQUIRE-EAGER-UPDATE is non-nil, also require eager-display to be
requested by the completion table."
(when (and completion-eager-display
;; If it's already displayed, don't display it again.
(not (get-buffer-window "*Completions*" 0)))
(when (let ((metadata
(completion-metadata
(buffer-substring-no-properties (minibuffer-prompt-end) (point))
minibuffer-completion-table minibuffer-completion-predicate)))
(and
(or (eq completion-eager-display t)
(completion-metadata-get metadata 'eager-display))
(or (not require-eager-update)
(eq completion-eager-update t)
(completion-metadata-get metadata 'eager-update))))
(setq completion-eager-display--timer
(run-with-idle-timer 0 nil #'completions--eager-display)))))
@ -2797,13 +2809,16 @@ has been requested by the completion table."
(defun completions--after-change (_start _end _old-len)
"Update displayed *Completions* buffer after change in buffer contents."
(when (or completion-auto-deselect completion-eager-update)
(when-let* ((window (minibuffer--completions-visible)))
(if (not (or (minibufferp nil t) completion-in-region-mode))
(remove-hook 'after-change-functions #'completions--after-change t)
(when-let* ((window (get-buffer-window "*Completions*" 0)))
(when completion-auto-deselect
(with-selected-window window
(completions--deselect)))
(when completion-eager-update
(add-hook 'post-command-hook #'completions--post-command-update)))))
(add-hook 'post-command-hook #'completions--post-command-update)))
(when (minibufferp nil t)
(completions--start-eager-display t))))
(defun minibuffer-completion-help (&optional start end)
"Display a list of possible completions of the current minibuffer contents."
@ -2821,6 +2836,8 @@ has been requested by the completion table."
(- (point) start)
md)))
(message nil)
(when (or completion-auto-deselect completion-eager-update)
(add-hook 'after-change-functions #'completions--after-change nil t))
(if (or (null completions)
(and (not (consp (cdr completions)))
(equal (car completions) string)))
@ -2828,7 +2845,6 @@ has been requested by the completion table."
;; If there are no completions, or if the current input is already
;; the sole completion, then hide (previous&stale) completions.
(minibuffer-hide-completions)
(remove-hook 'after-change-functions #'completions--after-change t)
(if completions
(completion--message "Sole completion")
(unless completion-fail-discreetly
@ -2894,8 +2910,6 @@ has been requested by the completion table."
(body-function
. ,#'(lambda (window)
(with-current-buffer mainbuf
(when (or completion-auto-deselect completion-eager-update)
(add-hook 'after-change-functions #'completions--after-change nil t))
;; Remove the base-size tail because `sort' requires a properly
;; nil-terminated list.
(when last (setcdr last nil))

2
lisp/net/tramp-adb.el
View file

@ -882,8 +882,8 @@ will be used."
;; is deleted. The temporary file will exist
;; until the process is deleted.
(when (bufferp stderr)
(tramp-taint-remote-process-buffer stderr)
(ignore-errors
(tramp-taint-remote-process-buffer stderr)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit)))

17
lisp/pixel-scroll.el
View file

@ -90,7 +90,6 @@
(require 'mwheel)
(require 'subr-x)
(require 'ring)
(require 'cua-base)
(defvar pixel-wait 0
"Idle time on each step of pixel scroll specified in second.
@ -831,7 +830,13 @@ It is a vector of the form [ VELOCITY TIME SIGN ]."
;; since we want exactly 1
;; page to be scrolled.
nil 1)
(cua-scroll-up)))
(cond
((eobp)
(scroll-up)) ; signal error
(t
(condition-case nil
(scroll-up)
(end-of-buffer (goto-char (point-max))))))))
;;;###autoload
(defun pixel-scroll-interpolate-up ()
@ -840,7 +845,13 @@ It is a vector of the form [ VELOCITY TIME SIGN ]."
(if pixel-scroll-precision-interpolate-page
(pixel-scroll-precision-interpolate (window-text-height nil t)
nil 1)
(cua-scroll-down)))
(cond
((bobp)
(scroll-down)) ; signal error
(t
(condition-case nil
(scroll-down)
(beginning-of-buffer (goto-char (point-min))))))))
;;;###autoload
(define-minor-mode pixel-scroll-precision-mode

35
lisp/progmodes/eglot.el
View file

@ -308,7 +308,7 @@ automatically)."
(racket-mode . ("racket" "-l" "racket-langserver"))
((latex-mode plain-tex-mode context-mode texinfo-mode bibtex-mode tex-mode)
. ,(eglot-alternatives '("digestif" "texlab")))
(erlang-mode . ("erlang_ls" "--transport" "stdio"))
(erlang-mode . ("elp" "server"))
(wat-mode . ("wat_server"))
((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio"))
((toml-ts-mode conf-toml-mode) . ("tombi" "lsp"))
@ -1438,6 +1438,12 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see."
(maphash (lambda (f s)
(when (eq s server) (remhash f eglot--servers-by-xrefed-file)))
eglot--servers-by-xrefed-file)
;; Cleanup entries in 'flymake-list-only-diagnostics'
(setq flymake-list-only-diagnostics
(cl-delete-if
(lambda (x) (eq server
(get-text-property 0 'eglot--server (car x))))
flymake-list-only-diagnostics))
(cond ((eglot--shutdown-requested server)
t)
((not (eglot--inhibit-autoreconnect server))
@ -3422,11 +3428,8 @@ object. The originator of this \"push\" is usually either regular
(with-current-buffer buffer
(if (and version (/= version eglot--docver))
(cl-return-from eglot--flymake-handle-push))
(setq
;; if no explicit version received, assume it's current.
version eglot--docver
flymake-list-only-diagnostics
(assoc-delete-all path flymake-list-only-diagnostics))
;; if no explicit version received, assume it's current.
(setq version eglot--docver)
(funcall then diagnostics))
(cl-loop
for diag-spec across diagnostics
@ -3437,12 +3440,13 @@ object. The originator of this \"push\" is usually either regular
(flymake-make-diagnostic
path (cons line char) nil
(eglot--flymake-diag-type severity)
(list source code message))))
(list source code message)
`((eglot-lsp-diag . ,diag-spec)))))
into diags
finally
(setq flymake-list-only-diagnostics
(assoc-delete-all path flymake-list-only-diagnostics))
(push (cons path diags) flymake-list-only-diagnostics))))
(setf (alist-get (propertize path 'eglot--server server)
flymake-list-only-diagnostics nil nil #'equal)
diags))))
(cl-defun eglot--flymake-pull (&aux (server (eglot--current-server-or-lose))
(origin (current-buffer)))
@ -3506,6 +3510,17 @@ MODE is like `eglot--flymake-report-1'."
(pushed-outdated-p (and pushed-docver (< pushed-docver eglot--docver))))
"Push previously collected diagnostics to `eglot--flymake-report-fn'.
If KEEP, knowingly push a dummy do-nothing update."
;; Maybe hack in diagnostics we previously may have saved in
;; `flymake-list-only-diagnostics', pushed for this file before it was
;; visited (github#1531).
(when-let* ((hack (and (<= eglot--docver 0)
(null eglot--pushed-diagnostics)
(cdr (assoc (buffer-file-name)
flymake-list-only-diagnostics)))))
(cl-loop
for x in hack
collect (alist-get 'eglot-lsp-diag (flymake-diagnostic-data x)) into res
finally (setq eglot--pushed-diagnostics `(,(vconcat res) ,eglot--docver))))
(eglot--widening
(if (and (null eglot--pulled-diagnostics) pushed-outdated-p)
;; Here, we don't have anything interesting to give to Flymake.

4
lisp/progmodes/elisp-mode.el
View file

@ -1783,7 +1783,9 @@ and `eval-expression-print-level'.
(funcall
(syntax-propertize-rules
(emacs-lisp-byte-code-comment-re
(1 (prog1 "< b" (elisp--byte-code-comment end (point))))))
(1 (prog1 "< b"
(goto-char (match-end 2))
(elisp--byte-code-comment end (point))))))
start end))
;;;###autoload

1
lisp/progmodes/project.el
View file

@ -841,6 +841,7 @@ See `project-vc-extra-root-markers' for the marker value format.")
(project--value-in-dir 'project-vc-ignores dir)))
(defun project--vc-ignores (dir backend extra-ignores)
(require 'vc)
(append
(when backend
(delq

122
lisp/progmodes/xref.el
View file

@ -247,7 +247,9 @@ generic functions.")
;;;###autoload
(defun xref-find-backend ()
(run-hook-with-args-until-success 'xref-backend-functions))
(or
(run-hook-with-args-until-success 'xref-backend-functions)
(user-error "No Xref backend available")))
(cl-defgeneric xref-backend-definitions (backend identifier)
"Find definitions of IDENTIFIER.
@ -269,9 +271,7 @@ To create an xref object, call `xref-make'.")
The result must be a list of xref objects. If no references can
be found, return nil.
The default implementation uses `semantic-symref-tool-alist' to
find a search tool; by default, this uses \"find | grep\" in the
current project's main and external roots."
The default implementation uses `xref-references-in-directory'."
(mapcan
(lambda (dir)
(message "Searching %s..." dir)
@ -1793,15 +1793,43 @@ and just use etags."
(declare-function grep-expand-template "grep")
(defvar ede-minor-mode) ;; ede.el
(defcustom xref-references-in-directory-function
#'xref-references-in-directory-semantic
"Function to find all references to a symbol in a directory.
It should take two string arguments: SYMBOL and DIR.
And return a list of xref values representing all code references to
SYMBOL in files under DIR."
:type '(choice
(const :tag "Using Grep via Find" xref-references-in-directory-grep)
(const :tag "Using Semantic Symbol Reference API"
xref-references-in-directory-semantic)
function)
:version "31.1")
;;;###autoload
(defun xref-references-in-directory (symbol dir)
"Find all references to SYMBOL in directory DIR.
See `xref-references-in-directory-function' for the implementation.
Return a list of xref values."
(cl-assert (directory-name-p dir))
(funcall xref-references-in-directory-function symbol dir))
(defun xref-references-in-directory-grep (symbol dir)
"Find all references to SYMBOL in directory DIR using find and grep.
Return a list of xref values. The files in DIR are filtered according
to its project's list of ignore patterns (as returned by
`project-ignores'), or the default ignores if there is no project."
(let ((ignores (project-ignores (project-current nil dir) dir)))
(xref-matches-in-directory (regexp-quote symbol) "*" dir ignores
'symbol)))
(defun xref-references-in-directory-semantic (symbol dir)
"Find all references to SYMBOL in directory DIR.
Return a list of xref values.
This function uses the Semantic Symbol Reference API, see
`semantic-symref-tool-alist' for details on which tools are used,
and when."
(cl-assert (directory-name-p dir))
(require 'semantic/symref)
(defvar semantic-symref-tool)
@ -1831,12 +1859,13 @@ and when."
"27.1")
;;;###autoload
(defun xref-matches-in-directory (regexp files dir ignores)
(defun xref-matches-in-directory (regexp files dir ignores &optional delimited)
"Find all matches for REGEXP in directory DIR.
Return a list of xref values.
Only files matching some of FILES and none of IGNORES are searched.
FILES is a string with glob patterns separated by spaces.
IGNORES is a list of glob patterns for files to ignore."
IGNORES is a list of glob patterns for files to ignore.
If DELIMITED is `symbol', only select matches that span full symbols."
;; DIR can also be a regular file for now; let's not advertise that.
(grep-compute-defaults)
(defvar grep-find-template)
@ -1855,6 +1884,9 @@ IGNORES is a list of glob patterns for files to ignore."
(local-dir (directory-file-name
(file-name-unquote
(file-local-name (expand-file-name dir)))))
(hits-regexp (if (eq delimited 'symbol)
(format "\\_<%s\\_>" regexp)
regexp))
(buf (get-buffer-create " *xref-grep*"))
(`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
(status nil)
@ -1864,20 +1896,9 @@ IGNORES is a list of glob patterns for files to ignore."
(setq default-directory dir)
(setq status
(process-file-shell-command command nil t))
(goto-char (point-min))
;; Can't use the exit status: Grep exits with 1 to mean "no
;; matches found". Find exits with 1 if any of the invocations
;; exit with non-zero. "No matches" and "Grep program not found"
;; are all the same to it.
(when (and (/= (point-min) (point-max))
(not (looking-at grep-re)))
(user-error "Search failed with status %d: %s" status (buffer-string)))
(while (re-search-forward grep-re nil t)
(push (list (string-to-number (match-string line-group))
(concat local-dir (substring (match-string file-group) 1))
(buffer-substring-no-properties (point) (line-end-position)))
hits)))
(xref--convert-hits (nreverse hits) regexp)))
(setq hits (xref--parse-hits grep-re line-group file-group status
local-dir)))
(xref--convert-hits (xref--sort-hits hits) hits-regexp)))
(define-obsolete-function-alias
'xref-collect-matches
@ -2003,29 +2024,42 @@ to control which program to use when looking for matches."
nil
shell-command-switch
command))))
(goto-char (point-min))
(when (and (/= (point-min) (point-max))
(not (looking-at grep-re))
;; TODO: Show these matches as well somehow?
;; Matching both Grep's and Ripgrep 13's messages.
(not (looking-at ".*[bB]inary file.* matches")))
(user-error "Search failed with status %d: %s" status
(buffer-substring (point-min) (line-end-position))))
(while (re-search-forward grep-re nil t)
(push (list (string-to-number (match-string line-group))
(match-string file-group)
(buffer-substring-no-properties (point) (line-end-position)))
hits)))
;; By default, ripgrep's output order is non-deterministic
;; (https://github.com/BurntSushi/ripgrep/issues/152)
;; because it does the search in parallel.
;; Grep's output also comes out in seemingly arbitrary order,
;; though stable one. Let's sort both for better UI.
(setq hits
(sort (nreverse hits)
(lambda (h1 h2)
(string< (cadr h1) (cadr h2)))))
(xref--convert-hits hits regexp)))
(setq hits (xref--parse-hits grep-re line-group file-group status)))
(xref--convert-hits (xref--sort-hits hits) regexp)))
(defun xref--parse-hits ( grep-re line-group file-group status
&optional parent-dir)
(let (hits)
(goto-char (point-min))
;; Can't use the exit status: Grep exits with 1 to mean "no
;; matches found". Find exits with 1 if any of the invocations
;; exit with non-zero. "No matches" and "Grep program not found"
;; are all the same to it.
(when (and (/= (point-min) (point-max))
(not (looking-at grep-re))
;; TODO: Show these matches as well somehow?
;; Matching both Grep's and Ripgrep 13's messages.
(not (looking-at ".*[bB]inary file.* matches")))
(user-error "Search failed with status %d: %s" status
(buffer-substring (point-min) (line-end-position))))
(while (re-search-forward grep-re nil t)
(push (list (string-to-number (match-string line-group))
(if parent-dir
(concat parent-dir (substring (match-string file-group) 1))
(match-string file-group))
(buffer-substring-no-properties (point) (line-end-position)))
hits))
(nreverse hits)))
(defun xref--sort-hits (hits)
;; By default, ripgrep's output order is non-deterministic
;; (https://github.com/BurntSushi/ripgrep/issues/152)
;; because it does the search in parallel.
;; Grep's output also comes out in seemingly arbitrary order,
;; though stable one. Let's sort both for better UI.
(sort hits
(lambda (h1 h2)
(string< (cadr h1) (cadr h2)))))
(defun xref--process-file-region ( start end program
&optional buffer display

3
lisp/replace.el
View file

@ -1878,6 +1878,9 @@ is not modified."
(bound-and-true-p ido-everywhere))
(substitute-command-keys
"(\\<ido-completion-map>\\[ido-select-text] to end): "))
((bound-and-true-p icomplete-mode)
(substitute-command-keys
"(\\<icomplete-minibuffer-map>\\[icomplete-exit] to end): "))
((bound-and-true-p fido-mode)
(substitute-command-keys
"(\\<icomplete-fido-mode-map>\\[icomplete-fido-exit] to end): "))

8
lisp/subr.el
View file

@ -5445,9 +5445,11 @@ If BODY finishes, `while-no-input' returns whatever value BODY produced."
(t val)))))))
(defmacro condition-case-unless-debug (var bodyform &rest handlers)
"Like `condition-case' except that it does not prevent debugging.
More specifically if `debug-on-error' is set then the debugger will be invoked
even if this catches the signal."
"Like `condition-case', except that it does not prevent debugging.
More specifically, if `debug-on-error' is set, then the debugger will
be invoked even if some handler catches the signal.
Note that this doesn't prevent the handler from executing, it just
causes the debugger to be called before running the handler."
(declare (debug condition-case) (indent 2))
`(condition-case ,var
,bodyform

16
lisp/time.el
View file

@ -177,6 +177,18 @@ depend on `display-time-day-and-date' and `display-time-24hr-format'."
:type '(choice (const :tag "Default" nil)
string))
(defcustom display-time-help-echo-format "%a %b %e, %Y"
"Format for the help echo when hovering over the time in the mode line.
Use the function `customize-variable' to choose a common format, and/or
see the function `format-time-string' for an explanation of the syntax."
:version "31.1"
:type `(choice
,@(mapcar #'(lambda (fmt)
(list 'const
':tag (format-time-string fmt 0 "UTC") fmt))
'("%a %b %e, %Y" "%F (%a)" "%a %D"))
(string :tag "Format string")))
(defcustom display-time-string-forms
'((if (and (not display-time-format) display-time-day-and-date)
(format-time-string "%a %b %e " now)
@ -186,7 +198,9 @@ depend on `display-time-day-and-date' and `display-time-24hr-format'."
(if display-time-24hr-format "%H:%M" "%-I:%M%p"))
now)
'face 'display-time-date-and-time
'help-echo (format-time-string "%a %b %e, %Y" now))
'help-echo (format-time-string (if (stringp display-time-help-echo-format)
display-time-help-echo-format
"%a %b %e, %Y") now))
load
(if mail
;; Build the string every time to act on customization.

59
lisp/tutorial.el
View file

@ -153,60 +153,17 @@ options:
" you can use "
(if (string-match-p "^the .*menus?$" where)
""
"the key")
"the key ")
where
(format-message " to get the function `%s'." db))))
(fill-region (point-min) (point)))))
(help-print-return-message))))
(defun tutorial--sort-keys (left right)
"Sort predicate for use with `tutorial--default-keys'.
This is a predicate function to `sort'.
The sorting is for presentation purpose only and is done on the
key sequence.
LEFT and RIGHT are the elements to compare."
(let ((x (append (cadr left) nil))
(y (append (cadr right) nil)))
;; Skip the front part of the key sequences if they are equal:
(while (and x y
(listp x) (listp y)
(equal (car x) (car y)))
(setq x (cdr x))
(setq y (cdr y)))
;; Try to make a comparison that is useful for presentation (this
;; could be made nicer perhaps):
(let ((cx (car x))
(cy (car y)))
;;(message "x=%s, y=%s;;;; cx=%s, cy=%s" x y cx cy)
(cond
;; Lists? Then call this again
((and cx cy
(listp cx)
(listp cy))
(tutorial--sort-keys cx cy))
;; Are both numbers? Then just compare them
((and (wholenump cx)
(wholenump cy))
(> cx cy))
;; Is one of them a number? Let that be bigger then.
((wholenump cx)
t)
((wholenump cy)
nil)
;; Are both symbols? Compare the names then.
((and (symbolp cx)
(symbolp cy))
(string< (symbol-name cy)
(symbol-name cx)))))))
(defconst tutorial--default-keys
;; On window system, `suspend-emacs' is replaced in the default keymap.
(let* ((suspend-emacs 'suspend-frame)
(default-keys
(eval-when-compile
(let ((default-keys
;; The first few are not mentioned but are basic:
`((ESC-prefix [27])
'((ESC-prefix [27])
(Control-X-prefix [?\C-x])
(mode-specific-command-prefix [?\C-c])
(save-buffers-kill-terminal [?\C-x ?\C-c])
@ -227,7 +184,7 @@ LEFT and RIGHT are the elements to compare."
(move-end-of-line [?\C-e])
(backward-sentence [?\M-a])
(forward-sentence [?\M-e])
(newline "\r")
(newline [?\C-m])
(beginning-of-buffer [?\M-<])
(end-of-buffer [?\M->])
(universal-argument [?\C-u])
@ -245,7 +202,7 @@ LEFT and RIGHT are the elements to compare."
;; * INSERTING AND DELETING
;; C-u 8 * to insert ********.
(delete-backward-char "\d")
(delete-backward-char [?\C-?])
(delete-char [?\C-d])
(backward-kill-word [?\M-\d])
(kill-word [?\M-d])
@ -309,8 +266,8 @@ LEFT and RIGHT are the elements to compare."
;; * CONCLUSION
;;(iconify-or-deiconify-frame [?\C-z])
(,suspend-emacs [?\C-z]))))
(sort default-keys 'tutorial--sort-keys))
(suspend-frame [?\C-z]))))
(sort default-keys :key #'cadr)))
"Default Emacs key bindings that the tutorial depends on.")
(defun tutorial--detailed-help (button)

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

@ -218,6 +218,7 @@ See also `diff-mode-read-only-map'."
"<mouse-2>" #'diff-goto-source
"o" #'diff-goto-source ; other-window
"<remap> <undo>" #'undo-ignore-read-only
"s" #'diff-split-hunk
;; The foregoing commands don't affect buffers beyond this one.
;; The following command is the only one that has a single-letter
@ -882,31 +883,19 @@ If the prefix ARG is given, restrict the view to the current file instead."
(goto-char (point-min))
(re-search-forward diff-hunk-header-re nil t)))
(defun diff-hunk-kill ()
"Kill the hunk at point."
(interactive)
(if (not (diff--some-hunks-p))
(error "No hunks")
(diff-beginning-of-hunk t)
(let* ((hunk-bounds (diff-bounds-of-hunk))
(file-bounds (ignore-errors (diff-bounds-of-file)))
;; If the current hunk is the only one for its file, kill the
;; file header too.
(bounds (if (and file-bounds
(progn (goto-char (car file-bounds))
(= (progn (diff-hunk-next) (point))
(car hunk-bounds)))
(progn (goto-char (cadr hunk-bounds))
;; bzr puts a newline after the last hunk.
(while (looking-at "^\n")
(forward-char 1))
(= (point) (cadr file-bounds))))
file-bounds
hunk-bounds))
(inhibit-read-only t))
(apply #'kill-region bounds)
(goto-char (car bounds))
(ignore-errors (diff-beginning-of-hunk t)))))
(defun diff-hunk-kill (&optional beg end)
"Kill the hunk at point.
When killing the last hunk left for a file, kill the file header too.
Interactively, if the region is active, kill all hunks that the region
overlaps.
When called from Lisp with optional arguments BEG and END non-nil, kill
all hunks overlapped by the region from BEG to END as though called
interactively with an active region delimited by BEG and END."
(interactive "R")
(when (xor beg end)
(error "Invalid call to `diff-hunk-kill'"))
(diff--revert-kill-hunks beg end nil))
;; This is not `diff-kill-other-hunks' because we might need to make
;; copies of file headers in order to ensure the new kill ring entry
@ -2282,6 +2271,83 @@ With a prefix argument, try to REVERSE the hunk."
:type 'boolean
:version "31.1")
(defun diff--revert-kill-hunks (beg end revertp)
"Workhorse routine for killing hunks, after possibly reverting them.
If BEG and END are nil, kill the hunk at point.
Otherwise kill all hunks overlapped by region delimited by BEG and END.
When killing a hunk that's the only one remaining for its file, kill the
file header too.
If REVERTP is non-nil, reverse-apply hunks before killing them."
;; With BEG and END non-nil, we push each hunk to the kill ring
;; separately. If we want to push to the kill ring just once, we have
;; to decide how to handle file headers such that the meanings of the
;; hunks in the kill ring entry, considered as a whole patch, do not
;; deviate too far from the meanings the hunks had in this buffer.
;;
;; For example, if we have a single hunk for one file followed by
;; multiple hunks for another file, and we naïvely kill the single
;; hunk and the first of the multiple hunks, our kill ring entry will
;; be a patch applying those two hunks to the first file. This is
;; because killing the single hunk will have brought its file header
;; with it, but not so killing the second hunk. So we will have put
;; together hunks that were previously for two different files.
;;
;; One option is to *copy* every file header that the region overlaps
;; (and that we will not kill, because we are leaving other hunks for
;; that file behind). But then the text this command pushes to the
;; kill ring would be different from the text it removes from the
;; buffer, which would be unintuitive for an Emacs kill command.
;;
;; An alternative might be to have restrictions as follows:
;;
;; Interactively, if the region is active, try to kill all hunks that the
;; region overlaps. This works when either
;; - all the hunks the region overlaps are for the same file; or
;; - the last hunk the region overlaps is the last hunk for its file.
;; These restrictions are so that the text added to the kill ring does not
;; merge together hunks for different files under a single file header.
;;
;; We would error out if neither property is met. When either holds,
;; any file headers the region overlaps are ones we should kill.
(unless (diff--some-hunks-p)
(error "No hunks"))
(if beg
(save-excursion
(goto-char beg)
(setq beg (car (diff-bounds-of-hunk)))
(goto-char end)
(unless (looking-at diff-hunk-header-re)
(setq end (cadr (diff-bounds-of-hunk)))))
(pcase-setq `(,beg ,end) (diff-bounds-of-hunk)))
(when (or (not revertp) (null (diff-apply-buffer beg end t)))
(goto-char end)
(when-let* ((pos (diff--at-diff-header-p)))
(goto-char pos))
(setq beg (copy-marker beg) end (point-marker))
(unwind-protect
(cl-loop initially (goto-char beg)
for (hunk-beg hunk-end) = (diff-bounds-of-hunk)
for file-bounds = (ignore-errors (diff-bounds-of-file))
for (file-beg file-end) = file-bounds
for inhibit-read-only = t
if (and file-bounds
(progn
(goto-char file-beg)
(diff-hunk-next)
(eq (point) hunk-beg))
(progn
(goto-char hunk-end)
;; bzr puts a newline after the last hunk.
(while (looking-at "^\n") (forward-char 1))
(eq (point) file-end)))
do (kill-region file-beg file-end) (goto-char file-beg)
else do (kill-region hunk-beg hunk-end) (goto-char hunk-beg)
do (ignore-errors (diff-beginning-of-hunk t))
until (or (< (point) (marker-position beg))
(eql (point) (marker-position end))))
(set-marker beg nil)
(set-marker end nil))))
(defun diff-revert-and-kill-hunk (&optional beg end)
"Reverse-apply and then kill the hunk at point. Save changed buffer.
Interactively, if the region is active, reverse-apply and kill all
@ -2307,27 +2373,7 @@ BEG and END."
(error "Invalid call to `diff-revert-and-kill-hunk'"))
(when (or (not diff-ask-before-revert-and-kill-hunk)
(y-or-n-p "Really reverse-apply and kill hunk(s)?"))
(if beg
(save-excursion
(goto-char beg)
(setq beg (car (diff-bounds-of-hunk)))
(goto-char end)
(unless (looking-at diff-hunk-header-re)
(setq end (cadr (diff-bounds-of-hunk)))))
(pcase-setq `(,beg ,end) (diff-bounds-of-hunk)))
(when (null (diff-apply-buffer beg end t))
;; Use `diff-hunk-kill' because it properly handles file headers.
(goto-char end)
(when-let* ((pos (diff--at-diff-header-p)))
(goto-char pos))
(setq beg (copy-marker beg) end (point-marker))
(unwind-protect
(cl-loop initially (goto-char beg)
do (diff-hunk-kill)
until (or (< (point) (marker-position beg))
(eql (point) (marker-position end))))
(set-marker beg nil)
(set-marker end nil)))))
(diff--revert-kill-hunks beg end t)))
(defun diff-apply-buffer (&optional beg end reverse test-or-no-save)
"Apply the diff in the entire diff buffer.
@ -2359,7 +2405,7 @@ applied. Other non-nil values are reserved."
(while (pcase-let ((`(,buf ,line-offset ,pos ,_src ,dst ,switched)
(diff-find-source-location nil reverse test)))
;; FIXME: Should respect `diff-apply-hunk-to-backup-file'
;; similarly to how `diff-apply-buffer' does.
;; similarly to how `diff-apply-hunk' does.
;; Prompt for each relevant file.
(cond ((and line-offset (not switched))
(push (cons pos dst)

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

@ -397,6 +397,10 @@ That is, refreshing the VC-Dir buffer also hides `up-to-date' and
(define-key map (kbd "M-s a M-C-s") #'vc-dir-isearch-regexp)
(define-key map "G" #'vc-dir-ignore)
(define-key map "@" #'vc-revert)
(define-key map "Tl" #'vc-log-outgoing-base)
(define-key map "TL" #'vc-root-log-outgoing-base)
(define-key map "T=" #'vc-diff-outgoing-base)
(define-key map "TD" #'vc-root-diff-outgoing-base)
(let ((branch-map (make-sparse-keymap)))
(define-key map "b" branch-map)

127
lisp/vc/vc-git.el
View file

@ -772,70 +772,91 @@ or an empty string if none."
(vc-git--out-match '("symbolic-ref" "HEAD")
"^\\(refs/heads/\\)?\\(.+\\)$" 2))
(defun vc-git--branch-remotes ()
"Return alist of configured remote branches for current branch.
If there is a configured upstream, return the remote-tracking branch
with key `upstream'. If there is a distinct configured push remote,
return the remote-tracking branch there with key `push'.
A configured push remote that's just the same as the upstream remote is
ignored because that means we're not actually in a triangular workflow."
;; Possibly we could simplify this using @{push}, but that may involve
;; an unwanted dependency on the setting of push.default.
(cl-flet ((get (key)
(string-trim-right (vc-git--out-str "config" key))))
(let* ((branch (vc-git-working-branch))
(pull (get (format "branch.%s.remote" branch)))
(merge (string-remove-prefix "refs/heads/"
(get (format "branch.%s.merge"
branch))))
(push (get (format "branch.%s.pushRemote" branch)))
(push (if (string-empty-p push)
(get "remote.pushDefault")
push))
(alist (and (not (string-empty-p pull))
(not (string-empty-p merge))
`((upstream . ,(format "%s/%s" pull merge))))))
(if (or (string-empty-p push) (equal push pull))
alist
(cl-acons 'push (format "%s/%s" push branch) alist)))))
(defun vc-git-trunk-or-topic-p ()
"Return `topic' if branch has distinct pull and push remotes, else nil.
This is able to identify topic branches for certain forge workflows."
(let* ((branch (vc-git-working-branch))
(merge (string-trim-right
(vc-git--out-str "config" (format "branch.%s.remote"
branch))))
(push (string-trim-right
(vc-git--out-str "config" (format "branch.%s.pushRemote"
branch))))
(push (if (string-empty-p push)
(string-trim-right
(vc-git--out-str "config" "remote.pushDefault"))
push)))
(and (plusp (length merge))
(plusp (length push))
(not (equal merge push))
'topic)))
(let ((remotes (vc-git--branch-remotes)))
(and (assq 'upstream remotes) (assq 'push remotes) 'topic)))
(defun vc-git-topic-outgoing-base ()
"Return the outgoing base for the current branch as a string.
This works by considering the current branch as a topic branch
(whether or not it actually is).
Requires that the corresponding trunk exists as a local branch.
The algorithm employed is as follows. Find all merge bases between the
current branch and other local branches. Each of these is a commit on
the current branch. Use `git merge-base --independent' on them all to
find the topologically most recent. Take the branch for which that
commit is a merge base with the current branch to be the branch into
which the current branch will eventually be merged. Find its upstream.
(If there is more than one branch whose merge base with the current
branch is that same topologically most recent commit, try them
one-by-one, accepting the first that has an upstream.)"
(cl-flet ((get-line () (buffer-substring (point) (pos-eol))))
(let* ((branches (vc-git-branches))
(current (pop branches))
merge-bases)
(with-temp-buffer
(dolist (branch branches)
(erase-buffer)
(when (vc-git--out-ok "merge-base" "--all" branch current)
(goto-char (point-min))
(while (not (eobp))
(push branch
(alist-get (get-line) merge-bases nil nil #'equal))
(forward-line 1))))
(erase-buffer)
(unless (apply #'vc-git--out-ok "merge-base" "--independent"
(mapcar #'car merge-bases))
(error "`git merge-base --independent' failed"))
;; If 'git merge-base --independent' printed more than one line,
;; just pick the first.
(goto-char (point-min))
(catch 'ret
(dolist (target (cdr (assoc (get-line) merge-bases)))
If there is a distinct push remote for this branch, assume the target
for outstanding changes is the tracking branch, and return that.
Otherwise, fall back to the following algorithm, which requires that the
corresponding trunk exists as a local branch. Find all merge bases
between the current branch and other local branches. Each of these is a
commit on the current branch. Use `git merge-base --independent' on
them all to find the topologically most recent. Take the branch for
which that commit is a merge base with the current branch to be the
branch into which the current branch will eventually be merged. Find
its upstream. (If there is more than one branch whose merge base with
the current branch is that same topologically most recent commit, try
them one-by-one, accepting the first that has an upstream.)"
(if-let* ((remotes (vc-git--branch-remotes))
(_ (assq 'push remotes))
(upstream (assq 'upstream remotes)))
(cdr upstream)
(cl-flet ((get-line () (buffer-substring (point) (pos-eol))))
(let* ((branches (vc-git-branches))
(current (pop branches))
merge-bases)
(with-temp-buffer
(dolist (branch branches)
(erase-buffer)
(when (vc-git--out-ok "for-each-ref"
"--format=%(upstream:short)"
(concat "refs/heads/" target))
(when (vc-git--out-ok "merge-base" "--all" branch current)
(goto-char (point-min))
(let ((outgoing-base (get-line)))
(unless (string-empty-p outgoing-base)
(throw 'ret outgoing-base))))))))))
(while (not (eobp))
(push branch (alist-get (get-line) merge-bases
nil nil #'equal))
(forward-line 1))))
(erase-buffer)
(unless (apply #'vc-git--out-ok "merge-base" "--independent"
(mapcar #'car merge-bases))
(error "`git merge-base --independent' failed"))
;; If 'git merge-base --independent' printed more than one
;; line, just pick the first.
(goto-char (point-min))
(catch 'ret
(dolist (target (cdr (assoc (get-line) merge-bases)))
(erase-buffer)
(when (vc-git--out-ok "for-each-ref"
"--format=%(upstream:short)"
(concat "refs/heads/" target))
(goto-char (point-min))
(let ((outgoing-base (get-line)))
(unless (string-empty-p outgoing-base)
(throw 'ret outgoing-base)))))))))))
(defun vc-git-dir--branch-headers ()
"Return headers for branch-related information."

6
lisp/vc/vc-hooks.el
View file

@ -1018,8 +1018,10 @@ In the latter case, VC mode is deactivated for this buffer."
"O" #'vc-root-log-outgoing
"M L" #'vc-log-mergebase
"M D" #'vc-diff-mergebase
"o =" #'vc-diff-outgoing-base
"o D" #'vc-root-diff-outgoing-base
"T l" #'vc-log-outgoing-base
"T L" #'vc-root-log-outgoing-base
"T =" #'vc-diff-outgoing-base
"T D" #'vc-root-diff-outgoing-base
"m" #'vc-merge
"r" #'vc-retrieve-tag
"s" #'vc-create-tag

122
lisp/vc/vc.el
View file

@ -3330,15 +3330,13 @@ to which `vc-push' would push as UPSTREAM-LOCATION, unconditionally.
(This is passed when the user invokes an outgoing base command with a
\\`C-u C-u' prefix argument; see `vc--maybe-read-outgoing-base'.)
REFRESH is passed on to `vc--incoming-revision'."
(if-let* ((incoming
(vc--incoming-revision backend
(pcase upstream-location
('t nil)
('nil (vc--outgoing-base backend))
(_ upstream-location))
refresh)))
(vc-call-backend backend 'mergebase incoming)
(user-error "No incoming revision -- local-only branch?")))
(vc-call-backend backend 'mergebase
(vc--incoming-revision backend
(pcase upstream-location
('t nil)
('nil (vc--outgoing-base backend))
(_ upstream-location))
refresh)))
;;;###autoload
(defun vc-root-diff-outgoing-base (&optional upstream-location)
@ -3403,6 +3401,63 @@ When called from Lisp, optional argument FILESET overrides the fileset."
nil
(called-interactively-p 'interactive))))
;;;###autoload
(defun vc-log-outgoing-base (&optional upstream-location fileset)
"Show log for the 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.
When unspecified, UPSTREAM-LOCATION is the outgoing base.
For a trunk branch this is always the place \\[vc-push] would push to.
For a topic branch, query the backend for an appropriate outgoing base.
See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding
the difference between trunk and topic branches.
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 interactively with a \\[universal-argument] \\[universal-argument] \
prefix argument, always
use the place to which \\[vc-push] would push to as the outgoing base,
i.e., treat this branch as a trunk branch even if Emacs thinks it is a
topic branch.
When called from Lisp, optional argument FILESET overrides the fileset."
(interactive (let ((fileset (vc-deduce-fileset t)))
(list (vc--maybe-read-outgoing-base (car fileset))
fileset)))
(let* ((fileset (or fileset (vc-deduce-fileset t)))
(backend (car fileset)))
(vc-print-log-internal backend (cadr fileset) nil nil
(vc--outgoing-base-mergebase backend
upstream-location))))
;;;###autoload
(defun vc-root-log-outgoing-base (&optional upstream-location)
"Show log of revisions since the merge base with UPSTREAM-LOCATION.
The merge base with UPSTREAM-LOCATION means the common ancestor of the
working revision and UPSTREAM-LOCATION.
When unspecified, UPSTREAM-LOCATION is the outgoing base.
For a trunk branch this is always the place \\[vc-push] would push to.
For a topic branch, query the backend for an appropriate outgoing base.
See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding
the difference between trunk and topic branches.
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 interactively with a \\[universal-argument] \\[universal-argument] \
prefix argument, always
use the place to which \\[vc-push] would push to as the outgoing base,
i.e., treat this branch as a trunk branch even if Emacs thinks it is a
topic branch."
(interactive (list (vc--maybe-read-outgoing-base)))
(vc--with-backend-in-rootdir "VC revision log"
(vc-log-outgoing-base upstream-location `(,backend (,rootdir)))))
(declare-function ediff-load-version-control "ediff" (&optional silent))
(declare-function ediff-vc-internal "ediff-vers"
(rev1 rev2 &optional startup-hooks))
@ -4342,11 +4397,19 @@ BACKEND is the VC backend."
(let* ((outgoing-base (vc-call-backend (or backend
(vc-deduce-backend))
'topic-outgoing-base))
;; If OUTGOING-BASE is non-nil then it isn't possible to
;; specify an empty string in response to the prompt, which
;; normally means to treat the current branch as a trunk.
;; That's okay because you can use a double prefix argument
;; to force treating the current branch as a trunk.
;; If OUTGOING-BASE is non-nil then 'C-u C-x v T ... RET' is
;; how the user can force Emacs to treat the current branch
;; as a topic while having Emacs automatically determine the
;; outgoing base with which to do so (otherwise, forcing
;; Emacs to treat the current branch as a topic if it thinks
;; it's a trunk requires specifying an outgoing base which
;; will have that effect).
;;
;; In this case that OUTGOING-BASE is non-nil, it isn't
;; possible to specify an empty string as the outgoing base,
;; which normally means that Emacs should treat the current
;; branch as a trunk. That's okay because you can use a
;; double prefix argument to achieve that.
(res (read-string (if outgoing-base
(format-prompt "Upstream location/branch"
outgoing-base)
@ -4370,20 +4433,23 @@ BACKEND is the VC backend."
;; Do store `nil', before signaling an error, if there is no incoming
;; revision, because that's also something that can be slow to
;; determine and so should be remembered.
(if-let* ((_ (not refresh))
(record (assoc upstream-location
(vc--repo-getprop backend 'vc-incoming-revision))))
(cdr record)
(let ((res (vc-call-backend backend 'incoming-revision
upstream-location refresh)))
(if-let* ((alist (vc--repo-getprop backend 'vc-incoming-revision)))
(setf (alist-get upstream-location alist nil nil #'equal)
res)
(vc--repo-setprop backend
'vc-incoming-revision
`((,upstream-location . ,res))))
(or res
(user-error "No incoming revision -- local-only branch?")))))
(or (if-let* ((_ (not refresh))
(record (assoc upstream-location
(vc--repo-getprop backend
'vc-incoming-revision))))
(cdr record)
(let ((res (vc-call-backend backend 'incoming-revision
upstream-location refresh)))
(if-let* ((alist (vc--repo-getprop backend
'vc-incoming-revision)))
(setf (alist-get upstream-location alist
nil nil #'equal)
res)
(vc--repo-setprop backend
'vc-incoming-revision
`((,upstream-location . ,res))))
res))
(user-error "No incoming revision -- local-only branch?")))
;;;###autoload
(defun vc-root-log-incoming (&optional upstream-location)

13
lisp/window.el
View file

@ -7584,6 +7584,17 @@ strategy."
(with-selected-window window
(split-window-right))))
(defun window--frame-landscape-p (&optional frame)
"Non-nil if FRAME is wider than it is tall.
This means actually wider on the screen, not character-wise.
On text frames, use the heuristic that characters are roughtly twice as
tall as they are wide."
(if (display-graphic-p frame)
(> (frame-pixel-width frame) (frame-pixel-height frame))
;; On a terminal, displayed characters are usually roughly twice as
;; tall as they are wide.
(> (frame-width frame) (* 2 (frame-height frame)))))
(defun split-window-sensibly (&optional window)
"Split WINDOW in a way suitable for `display-buffer'.
The variable `split-window-preferred-direction' prescribes an order of
@ -7624,7 +7635,7 @@ split."
(or (if (or
(eql split-window-preferred-direction 'horizontal)
(and (eql split-window-preferred-direction 'longest)
(> (frame-width) (frame-height))))
(window--frame-landscape-p (window-frame window))))
(or (window--try-horizontal-split window)
(window--try-vertical-split window))
(or (window--try-vertical-split window)

27
src/frame.c
View file

@ -2887,6 +2887,15 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
promise that the terminal of the frame must be valid until we
have called the window-system-dependent frame destruction
routine. */
/* Remember if this was a GUI child frame, so we can
process pending window system events after destruction. */
bool was_gui_child_frame = FRAME_WINDOW_P (f) && FRAME_PARENT_FRAME (f);
#ifdef HAVE_X_WINDOWS
/* Save the X display before the frame is destroyed, so we can
sync with the X server afterwards. */
Display *child_frame_display = (was_gui_child_frame && FRAME_X_P (f)
? FRAME_X_DISPLAY (f) : NULL);
#endif
{
struct terminal *terminal;
block_input ();
@ -2896,6 +2905,24 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
f->terminal = 0; /* Now the frame is dead. */
unblock_input ();
/* When a GUI child frame is deleted, the window system may
generate events that affect the parent frame (e.g.
ConfigureNotify, Expose, etc.). We need to sync with the
X server to ensure all events from the frame destruction
have been received, then process them to ensure subsequent
operations like `recenter' see up-to-date window state.
(Bug#76186) */
#ifdef HAVE_X_WINDOWS
if (child_frame_display)
{
block_input ();
XSync (child_frame_display, False);
unblock_input ();
}
#endif
if (was_gui_child_frame)
swallow_events (false);
/* Clear markers and overlays set by F on behalf of an input
method. */
#ifdef HAVE_TEXT_CONVERSION

26
src/image.c
View file

@ -2131,6 +2131,7 @@ image_clear_image_1 (struct frame *f, struct image *img, int flags)
static void
image_clear_image (struct frame *f, struct image *img)
{
img->lisp_data = Qnil;
block_input ();
image_clear_image_1 (f, img,
(CLEAR_IMAGE_PIXMAP
@ -9653,16 +9654,6 @@ static const struct image_keyword gif_format[GIF_LAST] =
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
/* Free X resources of GIF image IMG which is used on frame F.
Also used by other image types. */
static void
gif_clear_image (struct frame *f, struct image *img)
{
img->lisp_data = Qnil;
image_clear_image (f, img);
}
/* Return true if OBJECT is a valid GIF image specification. */
static bool
@ -10892,15 +10883,6 @@ static struct image_keyword imagemagick_format[IMAGEMAGICK_LAST] =
{":crop", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
};
/* Free X resources of imagemagick image IMG which is used on frame F. */
static void
imagemagick_clear_image (struct frame *f,
struct image *img)
{
image_clear_image (f, img);
}
/* Return true if OBJECT is a valid IMAGEMAGICK image specification. Do
this by calling parse_image_spec and supplying the keywords that
identify the IMAGEMAGICK format. */
@ -12946,7 +12928,7 @@ static struct image_type const image_types[] =
#endif
#ifdef HAVE_IMAGEMAGICK
{ SYMBOL_INDEX (Qimagemagick), imagemagick_image_p, imagemagick_load,
imagemagick_clear_image },
image_clear_image },
#endif
#ifdef HAVE_RSVG
{ SYMBOL_INDEX (Qsvg), svg_image_p, svg_load, image_clear_image,
@ -12957,7 +12939,7 @@ static struct image_type const image_types[] =
IMAGE_TYPE_INIT (init_png_functions) },
#endif
#if defined HAVE_GIF
{ SYMBOL_INDEX (Qgif), gif_image_p, gif_load, gif_clear_image,
{ SYMBOL_INDEX (Qgif), gif_image_p, gif_load, image_clear_image,
IMAGE_TYPE_INIT (init_gif_functions) },
#endif
#if defined HAVE_TIFF
@ -12974,7 +12956,7 @@ static struct image_type const image_types[] =
IMAGE_TYPE_INIT (init_xpm_functions) },
#endif
#if defined HAVE_WEBP
{ SYMBOL_INDEX (Qwebp), webp_image_p, webp_load, gif_clear_image,
{ SYMBOL_INDEX (Qwebp), webp_image_p, webp_load, image_clear_image,
IMAGE_TYPE_INIT (init_webp_functions) },
#endif
{ SYMBOL_INDEX (Qxbm), xbm_image_p, xbm_load, image_clear_image },

29
src/keyboard.c
View file

@ -1789,7 +1789,8 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified)
TEXT_PROP_MEANS_INVISIBLE (val))
#endif
&& !NILP (val = get_char_property_and_overlay
(make_fixnum (end), Qinvisible, Qnil, &overlay))
(make_fixnum (end), Qinvisible,
selected_window, &overlay))
&& (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
{
ellipsis = ellipsis || inv > 1
@ -1807,7 +1808,8 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified)
TEXT_PROP_MEANS_INVISIBLE (val))
#endif
&& !NILP (val = get_char_property_and_overlay
(make_fixnum (beg - 1), Qinvisible, Qnil, &overlay))
(make_fixnum (beg - 1), Qinvisible,
selected_window, &overlay))
&& (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
{
ellipsis = ellipsis || inv > 1
@ -1874,11 +1876,11 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified)
could lead to an infinite loop. */
;
else if (val = Fget_pos_property (make_fixnum (PT),
Qinvisible, Qnil),
Qinvisible, selected_window),
TEXT_PROP_MEANS_INVISIBLE (val)
&& (val = (Fget_pos_property
(make_fixnum (PT == beg ? end : beg),
Qinvisible, Qnil)),
Qinvisible, selected_window)),
!TEXT_PROP_MEANS_INVISIBLE (val)))
(check_composition = check_display = true,
SET_PT (PT == beg ? end : beg));
@ -10116,6 +10118,13 @@ read_char_x_menu_prompt (Lisp_Object map,
return Qnil ;
}
static Lisp_Object
follow_key (Lisp_Object keymap, Lisp_Object key)
{
return access_keymap (get_keymap (keymap, 0, 1),
key, 1, 0, 1);
}
static Lisp_Object
read_char_minibuf_menu_prompt (int commandflag,
Lisp_Object map)
@ -10327,7 +10336,10 @@ read_char_minibuf_menu_prompt (int commandflag,
if (!FIXNUMP (obj) || XFIXNUM (obj) == -2
|| (! EQ (obj, menu_prompt_more_char)
&& (!FIXNUMP (menu_prompt_more_char)
|| ! BASE_EQ (obj, make_fixnum (Ctl (XFIXNUM (menu_prompt_more_char)))))))
|| ! BASE_EQ (obj, make_fixnum (Ctl (XFIXNUM (menu_prompt_more_char))))))
/* If 'menu_prompt_more_char' collides with a binding in the
map, gives precedence to the map's binding (bug#80146). */
|| !NILP (follow_key (map, obj)))
{
if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
store_kbd_macro_char (obj);
@ -10339,13 +10351,6 @@ read_char_minibuf_menu_prompt (int commandflag,
/* Reading key sequences. */
static Lisp_Object
follow_key (Lisp_Object keymap, Lisp_Object key)
{
return access_keymap (get_keymap (keymap, 0, 1),
key, 1, 0, 1);
}
static Lisp_Object
active_maps (Lisp_Object first_event, Lisp_Object second_event)
{

9
src/nsterm.m
View file

@ -5838,6 +5838,15 @@ static Lisp_Object ns_new_font (struct frame *f, Lisp_Object font_object,
ns_pending_service_names = [[NSMutableArray alloc] init];
ns_pending_service_args = [[NSMutableArray alloc] init];
#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 260000
/* Disable problematic event processing on macOS 26 (Tahoe) to avoid
scrolling lag and input handling issues. These are undocumented
options as of macOS 26.0. */
[NSUserDefaults.standardUserDefaults
registerDefaults:@{@"NSEventConcurrentProcessingEnabled" : @"NO",
@"NSApplicationUpdateCycleEnabled" : @"NO"}];
#endif
/* Start app and create the main menu, window, view.
Needs to be here because ns_initialize_display_info () uses AppKit classes.
The view will then ask the NSApp to stop and return to Emacs. */

56
src/treesit.c
View file

@ -81,11 +81,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#undef ts_query_predicates_for_pattern
#undef ts_query_string_value_for_id
#undef ts_set_allocator
#undef ts_tree_cursor_copy
#undef ts_tree_cursor_current_node
#undef ts_tree_cursor_delete
#undef ts_tree_cursor_goto_first_child
#undef ts_tree_cursor_goto_first_child_for_byte
#undef ts_tree_cursor_goto_previous_sibling
#undef ts_tree_cursor_goto_next_sibling
#undef ts_tree_cursor_goto_parent
#undef ts_tree_cursor_new
@ -153,12 +153,12 @@ DEF_DLL_FN (const char *, ts_query_string_value_for_id,
(const TSQuery *, uint32_t, uint32_t *));
DEF_DLL_FN (void, ts_set_allocator,
(void *(*)(size_t), void *(*)(size_t, size_t), void *(*)(void *, size_t), void (*)(void *)));
DEF_DLL_FN (TSTreeCursor, ts_tree_cursor_copy, (const TSTreeCursor *));
DEF_DLL_FN (TSNode, ts_tree_cursor_current_node, (const TSTreeCursor *));
DEF_DLL_FN (void, ts_tree_cursor_delete, (const TSTreeCursor *));
DEF_DLL_FN (bool, ts_tree_cursor_goto_first_child, (TSTreeCursor *));
DEF_DLL_FN (int64_t, ts_tree_cursor_goto_first_child_for_byte, (TSTreeCursor *, uint32_t));
DEF_DLL_FN (bool, ts_tree_cursor_goto_next_sibling, (TSTreeCursor *));
DEF_DLL_FN (bool, ts_tree_cursor_goto_previous_sibling, (TSTreeCursor *));
DEF_DLL_FN (bool, ts_tree_cursor_goto_parent, (TSTreeCursor *));
DEF_DLL_FN (TSTreeCursor, ts_tree_cursor_new, (TSNode));
DEF_DLL_FN (void, ts_tree_delete, (TSTree *));
@ -221,12 +221,12 @@ init_treesit_functions (void)
LOAD_DLL_FN (library, ts_query_predicates_for_pattern);
LOAD_DLL_FN (library, ts_query_string_value_for_id);
LOAD_DLL_FN (library, ts_set_allocator);
LOAD_DLL_FN (library, ts_tree_cursor_copy);
LOAD_DLL_FN (library, ts_tree_cursor_current_node);
LOAD_DLL_FN (library, ts_tree_cursor_delete);
LOAD_DLL_FN (library, ts_tree_cursor_goto_first_child);
LOAD_DLL_FN (library, ts_tree_cursor_goto_first_child_for_byte);
LOAD_DLL_FN (library, ts_tree_cursor_goto_next_sibling);
LOAD_DLL_FN (library, ts_tree_cursor_goto_previous_sibling);
LOAD_DLL_FN (library, ts_tree_cursor_goto_parent);
LOAD_DLL_FN (library, ts_tree_cursor_new);
LOAD_DLL_FN (library, ts_tree_delete);
@ -283,12 +283,12 @@ init_treesit_functions (void)
#define ts_query_predicates_for_pattern fn_ts_query_predicates_for_pattern
#define ts_query_string_value_for_id fn_ts_query_string_value_for_id
#define ts_set_allocator fn_ts_set_allocator
#define ts_tree_cursor_copy fn_ts_tree_cursor_copy
#define ts_tree_cursor_current_node fn_ts_tree_cursor_current_node
#define ts_tree_cursor_delete fn_ts_tree_cursor_delete
#define ts_tree_cursor_goto_first_child fn_ts_tree_cursor_goto_first_child
#define ts_tree_cursor_goto_first_child_for_byte fn_ts_tree_cursor_goto_first_child_for_byte
#define ts_tree_cursor_goto_next_sibling fn_ts_tree_cursor_goto_next_sibling
#define ts_tree_cursor_goto_previous_sibling fn_ts_tree_cursor_goto_previous_sibling
#define ts_tree_cursor_goto_parent fn_ts_tree_cursor_goto_parent
#define ts_tree_cursor_new fn_ts_tree_cursor_new
#define ts_tree_delete fn_ts_tree_delete
@ -4278,50 +4278,14 @@ treesit_traverse_sibling_helper (TSTreeCursor *cursor,
}
else /* Backward. */
{
/* Go to first child and go through each sibling, until we find
the one just before the starting node. */
TSNode start = ts_tree_cursor_current_node (cursor);
if (!ts_tree_cursor_goto_parent (cursor))
return false;
treesit_assume_true (ts_tree_cursor_goto_first_child (cursor));
/* Now CURSOR is at the first child. If we started at the first
child, then there is no further siblings. */
TSNode first_child = ts_tree_cursor_current_node (cursor);
if (ts_node_eq (first_child, start))
return false;
/* PROBE is always DELTA siblings ahead of CURSOR. */
TSTreeCursor probe = ts_tree_cursor_copy (cursor);
/* This is position of PROBE minus position of CURSOR. */
ptrdiff_t delta = 0;
TSNode probe_node;
TSNode cursor_node;
while (ts_tree_cursor_goto_next_sibling (&probe))
if (!named)
return ts_tree_cursor_goto_previous_sibling (cursor);
/* Else named... */
while (ts_tree_cursor_goto_previous_sibling (cursor))
{
/* Move PROBE forward, if it equals to the starting node,
CURSOR points to the node we want (prev valid sibling of
the starting node). */
delta++;
probe_node = ts_tree_cursor_current_node (&probe);
/* PROBE matched, depending on NAMED, return true/false. */
if (ts_node_eq (probe_node, start))
{
ts_tree_cursor_delete (&probe);
cursor_node = ts_tree_cursor_current_node (cursor);
ts_tree_cursor_delete (&probe);
return (!named || (named && ts_node_is_named (cursor_node)));
}
/* PROBE didn't match, move CURSOR forward to PROBE's
position, but if we are looking for named nodes, only
move CURSOR to PROBE if PROBE is at a named node. */
if (!named || (named && ts_node_is_named (probe_node)))
for (; delta > 0; delta--)
treesit_assume_true (ts_tree_cursor_goto_next_sibling (cursor));
if (ts_node_is_named (ts_tree_cursor_current_node (cursor)))
return true;
}
ts_tree_cursor_delete (&probe);
return false;
}
}

6
src/xdisp.c
View file

@ -11300,6 +11300,7 @@ move_it_vertically_backward (struct it *it, int dy)
int line_height;
RESTORE_IT (&it3, &it3, it3data);
last_height = 0;
y1 = line_bottom_y (&it3);
line_height = y1 - y0;
RESTORE_IT (it, it, it2data);
@ -21673,8 +21674,9 @@ try_window_reusing_current_matrix (struct window *w)
return false;
/* If top-line visibility has changed, give up. */
if (window_wants_tab_line (w)
!= MATRIX_TAB_LINE_ROW (w->current_matrix)->mode_line_p)
if (!w->current_matrix->header_line_p
&& (window_wants_tab_line (w)
!= MATRIX_TAB_LINE_ROW (w->current_matrix)->mode_line_p))
return false;
/* If top-line visibility has changed, give up. */

32
src/xsettings.c
View file

@ -187,6 +187,8 @@ store_tool_bar_style_changed (const char *newstyle,
#ifndef HAVE_PGTK
#if defined USE_CAIRO || defined HAVE_XFT
#define XSETTINGS_FONT_NAME "Gtk/FontName"
#define XSETTINGS_GDK_DPI_NAME "Gdk/UnscaledDPI"
#define XSETTINGS_GDK_WSCALE_NAME "Gdk/WindowScalingFactor"
#endif
#define XSETTINGS_TOOL_BAR_STYLE "Gtk/ToolbarStyle"
#endif
@ -626,6 +628,15 @@ parse_settings (unsigned char *prop,
int bytes_parsed = 0;
int settings_seen = 0;
int i = 0;
#if defined USE_CAIRO || defined HAVE_XFT
/* Some X environments, e.g. XWayland, communicate DPI changes only
through the GDK xsettings values and not the regular Xft one, so
recognize both schemes. We want to see both the GDK window scaling
factor and the post-scaling DPI so we can compute our desired
actual DPI. */
int gdk_unscaled_dpi = 0;
int gdk_window_scale = 0;
#endif
/* First 4 bytes is a serial number, skip that. */
@ -668,7 +679,9 @@ parse_settings (unsigned char *prop,
want_this = strcmp (XSETTINGS_TOOL_BAR_STYLE, name) == 0;
#if defined USE_CAIRO || defined HAVE_XFT
if ((nlen > 6 && memcmp (name, "Xft/", 4) == 0)
|| strcmp (XSETTINGS_FONT_NAME, name) == 0)
|| strcmp (XSETTINGS_FONT_NAME, name) == 0
|| strcmp (XSETTINGS_GDK_DPI_NAME, name) == 0
|| strcmp (XSETTINGS_GDK_WSCALE_NAME, name) == 0)
want_this = true;
#endif
@ -769,6 +782,10 @@ parse_settings (unsigned char *prop,
settings->seen |= SEEN_DPI;
settings->dpi = ival / 1024.0;
}
else if (strcmp (name, XSETTINGS_GDK_DPI_NAME) == 0)
gdk_unscaled_dpi = ival;
else if (strcmp (name, XSETTINGS_GDK_WSCALE_NAME) == 0)
gdk_window_scale = ival;
else if (strcmp (name, "Xft/lcdfilter") == 0)
{
settings->seen |= SEEN_LCDFILTER;
@ -786,6 +803,19 @@ parse_settings (unsigned char *prop,
}
}
#if defined USE_CAIRO || defined HAVE_XFT
if (gdk_unscaled_dpi > 0 && gdk_window_scale > 0)
{
/* Override any previous DPI settings. GDK ones are intended to
be authoritative.
See
https://mail.gnome.org/archives/commits-list/2013-June/msg06726.html
*/
settings->seen |= SEEN_DPI;
settings->dpi = gdk_window_scale * gdk_unscaled_dpi / 1024.0;
}
#endif
return settings_seen;
}
#endif

277
test/lisp/emacs-lisp/package-vc-tests.el
View file

@ -65,25 +65,28 @@ of symbols, then preserve temporary directories and buffers for each
package that matches a symbol in the list. When this variable is t then
preserve all temporary directories.")
(defvar package-vc-tests-repos (make-hash-table))
(defvar package-vc-tests-dir)
(defvar package-vc-tests-packages)
(defvar package-vc-tests-repository)
(eval-and-compile
(defun package-vc-tests-packages ()
(defun package-vc-tests-packages (&optional full)
"Return a list of package definitions to test.
When variable `package-vc-tests-packages' is bound then return its
value. If `package-vc-tests-dir' is bound then each entry is in a form
of (PKG CHECKOUT-DIR LISP-DIR INSTALL-FUN), where PKG is a package
name (a symbol), CHECKOUT-DIR is an expected checkout directory,
LISP-DIR is a directory with package's sources (relative to
value. If `package-vc-tests-dir' is bound or FULL is non nil then each
entry is in a form of (PKG CHECKOUT-DIR LISP-DIR INSTALL-FUN), where PKG
is a package name (a symbol), CHECKOUT-DIR either is nil when
`package-vc-tests-dir' is not bound or is an expected checkout
directory, LISP-DIR is a directory with package's sources (relative to
CHECKOUT-DIR), and INSTALL-FUN is a function that checkouts and install
the package. Otherwise each entry is in a form of PKG."
(if (boundp 'package-vc-tests-packages)
package-vc-tests-packages
(cl-macrolet ((test-package-def
(pkg checkout-dir-exp lisp-dir install-fun)
`(if (boundp 'package-vc-tests-dir)
`(if (or (boundp 'package-vc-tests-dir) full)
(list
',pkg
(expand-file-name (symbol-name ',pkg)
@ -91,51 +94,54 @@ the package. Otherwise each entry is in a form of PKG."
,lisp-dir
#',install-fun)
',pkg)))
(list
;; checkout and install with `package-vc-install' (on ELPA)
(test-package-def
test-package-one package-user-dir nil
package-vc-tests-install-from-elpa)
;; checkout and install with `package-vc-install' (not on ELPA)
(test-package-def
test-package-two package-user-dir nil
package-vc-tests-install-from-spec)
;; checkout with `package-vc-checktout' and install with
;; `package-vc-install-from-checkout' (on ELPA)
(test-package-def
test-package-three package-vc-tests-dir nil
package-vc-tests-checkout-from-elpa-install-from-checkout)
;; checkout with git and install with
;; `package-vc-install-from-checkout'
(test-package-def
test-package-four package-vc-tests-dir nil
package-vc-tests-checkout-with-git-install-from-checkout)
;; sources in "lisp" sub directory, checkout and install with
;; `package-vc-install' (not on ELPA)
(test-package-def
test-package-five package-user-dir "lisp"
package-vc-tests-install-from-spec)
;; sources in "lisp" sub directory, checkout with git and
;; install with `package-vc-install-from-checkout'
(test-package-def
test-package-six package-vc-tests-dir "lisp"
package-vc-tests-checkout-with-git-install-from-checkout)
;; sources in "src" sub directory, checkout and install with
;; `package-vc-install' (on ELPA)
(test-package-def
test-package-seven package-user-dir "src"
package-vc-tests-install-from-elpa)
;; sources in "src" sub directory, checkout with
;; `package-vc-checktout' and install with
;; `package-vc-install-from-checkout' (on ELPA)
(test-package-def
test-package-eight package-vc-tests-dir nil
package-vc-tests-checkout-from-elpa-install-from-checkout)
;; sources in "custom-dir" sub directory, checkout and install
;; with `package-vc-install' (on ELPA)
(test-package-def
test-package-nine package-user-dir "custom-dir"
package-vc-tests-install-from-elpa))))))
(let* ((tests-dir (bound-and-true-p package-vc-tests-dir))
(user-dir (and tests-dir package-user-dir)))
(list
;; checkout and install with `package-vc-install' (on ELPA)
(test-package-def
test-package-one user-dir nil
package-vc-tests-install-from-elpa)
;; checkout and install with `package-vc-install' (not on
;; ELPA)
(test-package-def
test-package-two user-dir nil
package-vc-tests-install-from-spec)
;; checkout with `package-vc-checktout' and install with
;; `package-vc-install-from-checkout' (on ELPA)
(test-package-def
test-package-three tests-dir nil
package-vc-tests-checkout-from-elpa-install-from-checkout)
;; checkout with git and install with
;; `package-vc-install-from-checkout'
(test-package-def
test-package-four tests-dir nil
package-vc-tests-checkout-with-git-install-from-checkout)
;; sources in "lisp" sub directory, checkout and install with
;; `package-vc-install' (not on ELPA)
(test-package-def
test-package-five user-dir "lisp"
package-vc-tests-install-from-spec)
;; sources in "lisp" sub directory, checkout with git and
;; install with `package-vc-install-from-checkout'
(test-package-def
test-package-six tests-dir "lisp"
package-vc-tests-checkout-with-git-install-from-checkout)
;; sources in "src" sub directory, checkout and install with
;; `package-vc-install' (on ELPA)
(test-package-def
test-package-seven user-dir "src"
package-vc-tests-install-from-elpa)
;; sources in "src" sub directory, checkout with
;; `package-vc-checktout' and install with
;; `package-vc-install-from-checkout' (on ELPA)
(test-package-def
test-package-eight tests-dir nil
package-vc-tests-checkout-from-elpa-install-from-checkout)
;; sources in "custom-dir" sub directory, checkout and
;; install with `package-vc-install' (on ELPA)
(test-package-def
test-package-nine user-dir "custom-dir"
package-vc-tests-install-from-elpa)))))))
;; TODO: add test for deleting packages, with asserting
;; `package-vc-selected-packages'
@ -165,12 +171,11 @@ When LISP-DIR is non-nil place the NAME file under LISP-DIR."
(error "Failed to invoke sed on %s" in-file))
(vc-git-command nil 0 nil "add" ".")))
(defun package-vc-tests-create-repository (suffix &optional lisp-dir)
"Create a test package repository with SUFFIX.
(defun package-vc-tests-create-repository (suffix repos-dir &optional lisp-dir)
"Create a test package repository with SUFFIX in REPOS-DIR.
If LISP-DIR is non-nil place sources of the package in LISP-DIR."
(let* ((name (format "test-package-%s" suffix))
(repo-dir (expand-file-name (file-name-concat "repo" name)
package-vc-tests-dir)))
(repo-dir (expand-file-name name repos-dir)))
(make-directory (expand-file-name (or lisp-dir ".") repo-dir) t)
(let ((default-directory repo-dir)
(process-environment
@ -179,7 +184,8 @@ If LISP-DIR is non-nil place sources of the package in LISP-DIR."
(format "GIT_AUTHOR_NAME=%s" name)
(format "GIT_COMMITTER_NAME=%s" name))
process-environment)))
(vc-git-command nil 0 nil "init" "-b" "master")
(vc-git-command nil 0 nil "init")
(vc-git-command nil 0 nil "checkout" "-b" "master")
(package-vc-tests-add
suffix "test-package-SUFFIX-lib-v0.1.el.in" lisp-dir)
(package-vc-tests-add
@ -395,6 +401,11 @@ names."
(not (member lisp-dir '("lisp" "src")))
(list :lisp-dir lisp-dir)))))
(defun package-vc-tests-make-temp-dir (prefix)
"Create temp directory with PREFIX."
(expand-file-name
(make-temp-file prefix t (format-time-string "-%Y%m%d.%H%M%S.%3N"))))
(defun package-vc-with-tests-environment (pkg function)
"Call FUNCTION with no arguments within a test environment set up for PKG."
;; Create a test package sources repository, based on skeleton files
@ -402,10 +413,7 @@ names."
;; that:
;;
(let* ((package-vc-tests-dir
(expand-file-name
(make-temp-file "package-vc-tests-"
t
(format-time-string "-%Y%m%d.%H%M%S.%3N"))))
(package-vc-tests-make-temp-dir "package-vc-tests-"))
;; - packages are installed into test directory
(package-user-dir (expand-file-name "elpa"
package-vc-tests-dir))
@ -424,13 +432,25 @@ names."
(package-vc-tests-packages (package-vc-tests-packages))
;; - create a test package bundle
(package-vc-tests-repository
(let* ((pkg-name (symbol-name pkg))
(suffix (and (string-match
(rx ?- (group (1+ (not ?-))) eos)
pkg-name)
(match-string 1 pkg-name))))
(package-vc-tests-create-repository
suffix (cadr (alist-get pkg package-vc-tests-packages)))))
(or
(gethash pkg package-vc-tests-repos)
(let* ((pkg-name (symbol-name pkg))
(suffix (and (string-match
(rx ?- (group (1+ (not ?-))) eos)
pkg-name)
(match-string 1 pkg-name)))
(repos-dir
(or (gethash 'repos-dir package-vc-tests-repos)
(puthash 'repos-dir
(package-vc-tests-make-temp-dir
"package-vc-tests-repos-")
package-vc-tests-repos))))
(puthash pkg
(package-vc-tests-create-repository
suffix
repos-dir
(cadr (alist-get pkg package-vc-tests-packages)))
package-vc-tests-repos))))
;; - find all packages that are present in a test ELPA
(package-vc-tests-elpa-packages
(cl-loop
@ -491,6 +511,12 @@ names."
(package-vc-allow-build-commands t))
(funcall function)))
(defun package-vc-tests-preserve-pkg-artifacts-p (pkg)
"Return non nil if files and buffers for PKG should be preserved."
(or (memq package-vc-tests-preserve-artifacts `(t ,pkg))
(and (listp package-vc-tests-preserve-artifacts)
(memq pkg package-vc-tests-preserve-artifacts))))
(defun package-vc-tests-environment-tear-down (pkg)
"Tear down test environment for PKG.
Unbind package defined symbols, and remove package defined features and
@ -534,27 +560,74 @@ when PKG matches `package-vc-tests-preserve-artifacts'."
(package-vc-tests-log-buffer-name pkg
type)))
'(doc make)))))
(if (or (memq package-vc-tests-preserve-artifacts `(t ,pkg))
(and (listp package-vc-tests-preserve-artifacts)
(memq pkg package-vc-tests-preserve-artifacts)))
(if (package-vc-tests-preserve-pkg-artifacts-p pkg)
(let ((buffers
(mapconcat (lambda (buffer)
(with-current-buffer buffer
(let* ((old-name (buffer-name))
(new-name (make-temp-name
(string-trim old-name))))
(rename-buffer new-name)
(concat old-name " -> " new-name))))
buffers
", ")))
(if buffers
(format " and %s: %s"
(if (cdr buffers) "buffers" "buffer")
(mapconcat
(lambda (buffer)
(with-current-buffer buffer
(let* ((old-name (buffer-name))
(new-name (make-temp-name
(string-trim old-name))))
(rename-buffer new-name)
(format "`%s' -> `%s'"
old-name new-name))))
buffers
", "))
""))
(repo-dir (car (gethash pkg package-vc-tests-repos))))
(message
"package-vc-tests: preserving temporary directory: %s%s"
"package-vc-tests: preserving temporary %s: %s%s%s"
(if repo-dir "directories" "directory")
package-vc-tests-dir
(and buffers (format " and buffers: %s" buffers))))
(if repo-dir (format " and %s" repo-dir) "")
buffers))
(delete-directory package-vc-tests-dir t)
(dolist (buffer buffers)
(kill-buffer buffer)))))
;; Tests create a repository for a package only once per a tests run.
;; The repository location is cached in `package-vc-tests-repos'. To
;; support development, clear the cache on start of each tests run, such
;; that the package repository contains files from the source code.
;; When tests run completes delete repositories accounting for
;; `package-vc-tests-preserve-artifacts', which see.
(defun package-vc-tests-add-ert-run-tests-listener (args)
"Add `package-vc-tests' repositories cleanup to listener in ARGS."
(if-let* ((listener (cadr args))
((functionp listener)))
(cl-list*
(car args)
(lambda (event-type &rest event-args)
(cl-case event-type
(run-started
(clrhash package-vc-tests-repos))
(run-ended
(when-let* ((repos-dir (gethash 'repos-dir
package-vc-tests-repos))
((file-directory-p repos-dir)))
(if package-vc-tests-preserve-artifacts
(progn
(dolist (pkg (package-vc-tests-packages))
(unless
(package-vc-tests-preserve-pkg-artifacts-p pkg)
(when-let* ((repo-dir
(car (gethash pkg package-vc-tests-repos)))
((file-directory-p repo-dir)))
(delete-directory repo-dir t))))
(when (directory-empty-p repos-dir)
(delete-directory repos-dir)))
(delete-directory repos-dir t)))))
(apply listener (cons event-type event-args)))
(drop 2 args))
args))
(advice-add #'ert-run-tests
:filter-args #'package-vc-tests-add-ert-run-tests-listener)
(defun package-vc-tests-with-installed (pkg function)
"Call FUNCTION with PKG installed in a test environment.
FUNCTION should have no arguments."
@ -678,27 +751,33 @@ contains key `:tags' use its value as tests tags."
(error "`package-vc' tests first argument has to be a symbol"))
(let ((file (or (macroexp-file-name) buffer-file-name))
(tests '()) (fn (gensym))
(pkg-arg (car args))
(skip-forms (take-while (lambda (form)
(memq (car-safe form) '(skip-when
skip-unless)))
body))
(tags (plist-get (cdr-safe args) :tags)))
(setq body (nthcdr (length skip-forms) body))
(dolist (pkg (package-vc-tests-packages))
(let ((name (intern (format "package-vc-tests-%s/%s" name pkg))))
(push
`(ert-set-test
',name
(make-ert-test
:name ',name
:tags (cons 'package-vc ',tags)
:file-name ,file
:body
(lambda ()
(package-vc-tests-with-installed
',pkg (funcall ,fn ',pkg))
nil)))
`(ert-set-test ',name
(make-ert-test
:name ',name
:tags (cons 'package-vc ',tags)
:file-name ,file
:body
(lambda ()
(funcall ,fn ',pkg)
nil)))
tests)))
`(let ((,fn (lambda (,(car args))
(cl-macrolet ((skip-when (form) `(ert--skip-when ,form))
(skip-unless (form) `(ert--skip-unless ,form)))
(lambda () ,@body)))))
,@tests)))
`(cl-macrolet ((skip-when (form) `(ert--skip-when ,form))
(skip-unless (form) `(ert--skip-unless ,form)))
(let ((,fn (lambda (,pkg-arg)
,@skip-forms
(package-vc-tests-with-installed ,pkg-arg
(lambda () ,@body)))))
,@tests))))
(package-vc-test-deftest install-post-conditions (pkg)
(let ((install-begin
@ -1006,7 +1085,7 @@ contains key `:tags' use its value as tests tags."
(package-vc-test-deftest pkg-spec-make-shell-command (pkg)
;; Only `package-vc-install' runs make and shell command
(skip-unless (memq (caddr (alist-get pkg package-vc-tests-packages))
(skip-unless (memq (caddr (alist-get pkg (package-vc-tests-packages t)))
'(package-vc-tests-install-from-elpa
package-vc-tests-install-from-spec)))
(let* ((desc (package-vc-tests-package-desc pkg t))
@ -1024,7 +1103,7 @@ contains key `:tags' use its value as tests tags."
;; Only `package-vc-install' builds info manuals, but only when
;; executable install-info is available.
(skip-unless (and (executable-find "install-info")
(memq (caddr (alist-get pkg package-vc-tests-packages))
(memq (caddr (alist-get pkg (package-vc-tests-packages t)))
'(package-vc-tests-install-from-elpa
package-vc-tests-install-from-spec))))
(should-not (package-vc-tests-log-buffer-exists 'doc pkg))

18
test/lisp/emacs-lisp/pcase-tests.el
View file

@ -192,4 +192,22 @@
(should (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x)))
(should-not (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x))))))
(ert-deftest pcase-pred-equiv ()
(cl-flet ((f1 (x) (pcase x ((pred atom) 1) (_ 2))))
(should (equal (f1 'a) 1))
(should (equal (f1 nil) 1))
(should (equal (f1 '(a)) 2)))
(cl-flet ((f2 (x) (pcase x ((pred nlistp) 1) (_ 2))))
(should (equal (f2 'a) 1))
(should (equal (f2 nil) 2))
(should (equal (f2 '(a)) 2)))
(cl-flet ((f3 (x) (pcase x ((pred identity) 1) (_ 2))))
(should (equal (f3 'a) 1))
(should (equal (f3 nil) 2))
(should (equal (f3 '(a)) 1)))
(cl-flet ((f4 (x) (pcase x ((pred not) 1) (_ 2))))
(should (equal (f4 'a) 2))
(should (equal (f4 nil) 1))
(should (equal (f4 '(a)) 2))))
;;; pcase-tests.el ends here.

6
test/lisp/filenotify-tests.el
View file

@ -1256,6 +1256,10 @@ delivered."
:tags '(:expensive-test)
(skip-unless (file-notify--test-local-enabled))
(let ((file-notify-debug ;; Temporarily.
(or file-notify-debug
(getenv "EMACS_EMBA_CI"))))
(with-file-notify-test
(write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
(should
@ -1334,7 +1338,7 @@ delivered."
(file-notify--rm-descriptor file-notify--test-desc)
;; The environment shall be cleaned up.
(file-notify--test-cleanup-p))))
(file-notify--test-cleanup-p)))))
(file-notify--deftest-remote file-notify-test08-backup
"Check that backup keeps file notification for remote files.")

80
test/lisp/misc-tests.el
View file

@ -25,6 +25,7 @@
(require 'ert)
(require 'misc)
(require 'mule-util)
(defmacro with-misc-test (original result &rest body)
(declare (indent 2))
@ -243,5 +244,84 @@
(setq-default display-line-numbers dln))
(should (= w0 w1))))
;; Exercise `truncate-string-pixelwise' with strings of the same
;; characters of differing widths, with and without ellipses, in varying
;; faces, and varying face heights and compare results to each
;; character's measured width.
(ert-deftest misc-test-truncate-string-pixelwise ()
(dolist (c '(?W ?X ?y ?1))
(dolist (ellipsis `(nil "..." ,(truncate-string-ellipsis)))
(dolist (face '(fixed-pitch variable-pitch))
(dolist (height '(1.0 0.5 1.5))
(with-temp-buffer
(setq-local face-remapping-alist `((,face . default)))
(face-remap-add-relative 'default :height height)
(let ((char-pixels (string-pixel-width
(make-string 1 c) (current-buffer))))
(dotimes (i 20)
(setq i (1+ i))
(should (eq i (length
(truncate-string-pixelwise
(make-string (* i 2) c)
(* i char-pixels)
(current-buffer)
ellipsis))))))))))))
;; Exercise `truncate-string-pixelwise' with varying unicode strings, in
;; varying faces, and varying face heights and compare results to a
;; naive `string-pixel-width' based string truncate function.
(ert-deftest misc-test-truncate-string-pixelwise-unicode ()
:tags '(:expensive-test)
(skip-when noninteractive)
(let ((max-pixels 500)
(truncate-string-naive (lambda (string pixels buffer)
(while (and (length> string 0)
(> (string-pixel-width string buffer) pixels))
(setq string (substring string 0 (1- (length string)))))
string))
(strings (list
"foo bar baz foo bar baz foo bar baz foo bar baz foo bar baz foo bar baz"
(concat "話說天下大勢，分久必合，合久必分：周末七國分爭，并入於秦。"
"及秦滅之後，楚、漢分爭，又并入於漢。漢朝自高祖斬白蛇而起義，"
"一統天下。後來光武中興，傳至獻帝，遂分為三國。推其致亂之由，"
"殆始於桓、靈二帝。桓帝禁錮善類，崇信宦官。及桓帝崩，靈帝即位，"
"大將軍竇武、太傅陳蕃，共相輔佐。時有宦官曹節等弄權，竇武、陳蕃謀誅之，"
"作事不密，反為所害。中涓自此愈橫")
(concat "короче теперь если по русски написать все четко или все равно"
" короче теперь если по русски написать все четко или все равно"
" короче теперь если по русски написать все четко или все равно"
" короче теперь если по русски написать все четко или все равно")
"будет разрыв строки непонятно где🏁🚩🎌🏴🏳️ 🏳️ <200d>🌈🏳️ <200d>⚧️🏴<200d>☠️"
(apply #'concat (make-list 200 "\u0065\u0301 ")) ; composed é \u00E9
(let ((woman-loves-man ; 👩‍❤️‍👨
(concat "\N{WOMAN}"
"\N{ZERO WIDTH JOINER}"
"\N{HEAVY BLACK HEART}"
"\N{VARIATION SELECTOR-16}"
"\N{ZERO WIDTH JOINER}"
"\N{MAN}"
" ")))
(apply #'concat (make-list 200 woman-loves-man)))
(propertize (let ((varying-height-string
(mapconcat
#'identity
(list "AWi!"
(propertize "foo" 'face '(:height 2.5))
(propertize "bar" 'face '(:height 0.5))
(propertize "baz" 'face '(:height 1.0)))
" ")))
(apply #'concat (make-list 100 varying-height-string)))
'face 'variable-pitch))))
(dolist (face '(fixed-pitch variable-pitch))
(dolist (height '(1.0 0.5 1.5))
(with-temp-buffer
(setq-local face-remapping-alist `((,face . default)))
(face-remap-add-relative 'default :height height)
(dolist (string strings)
(should (eq (length (funcall truncate-string-naive
string max-pixels (current-buffer)))
(length (truncate-string-pixelwise
string max-pixels (current-buffer)))))))))))
(provide 'misc-tests)
;;; misc-tests.el ends here

36
test/lisp/net/tramp-tests.el
View file

@ -8259,6 +8259,42 @@ process sentinels. They shall not disturb each other."
;; (tramp--test-deftest-direct-async-process tramp-test45-asynchronous-requests
;; 'unstable)
;; This test is inspired by Bug#49954 and Bug#60534.
(ert-deftest tramp-test45-force-remote-file-error ()
"Force `remote-file-error'."
:tags '(:expensive-test :tramp-asynchronous-processes :unstable)
;; It shall run only if selected explicitly.
(skip-unless
(eq (ert--stats-selector ert--current-run-stats)
(ert-test-name (ert--stats-current-test ert--current-run-stats))))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(let ((default-directory ert-remote-temporary-file-directory)
;; Do not cache Tramp properties.
(remote-file-name-inhibit-cache t)
(p (start-file-process-shell-command
"test" (generate-new-buffer "test" 'inhibit-buffer-hooks)
"while true; do echo test; sleep 0.2; done")))
(set-process-filter
p (lambda (&rest _)
(message "filter %s" default-directory)
(directory-files default-directory)
(dired-uncache default-directory)))
(run-at-time
0 0.2 (lambda ()
(message "timer %s" default-directory)
(directory-files default-directory)
(dired-uncache default-directory)))
(while t
(accept-process-output)
(message "main %s" default-directory)
(directory-files default-directory)
(dired-uncache default-directory))))
(ert-deftest tramp-test46-dired-compress-file ()
"Check that Tramp (un)compresses normal files."
(skip-unless (tramp--test-enabled))

35
test/lisp/vc/vc-git-tests.el
View file

@ -194,4 +194,39 @@ is absent."
("Tracking" . ,main-branch)
("Remote" . "none (tracking local branch)")))))))))
(ert-deftest vc-git-test-branch-remotes ()
"Test behavior of `vc-git--branch-remotes'."
(skip-unless (executable-find vc-git-program))
(vc-git-test--with-repo repo
(let ((main-branch (vc-git-test--start-branch)))
(should (null (vc-git--branch-remotes)))
(vc-git--out-ok "config"
(format "branch.%s.remote" main-branch)
"origin")
(should (null (vc-git--branch-remotes)))
(vc-git--out-ok "config"
(format "branch.%s.merge" main-branch)
main-branch)
(let ((alist (vc-git--branch-remotes)))
(should (assq 'upstream alist))
(should (null (assq 'push alist))))
(vc-git--out-ok "config"
(format "branch.%s.pushRemote" main-branch)
"fork")
(let ((alist (vc-git--branch-remotes)))
(should (assq 'upstream alist))
(should (equal (cdr (assq 'push alist))
(concat "fork/" main-branch))))
(vc-git--out-ok "config" "unset"
(format "branch.%s.pushRemote" main-branch))
(vc-git--out-ok "config" "remote.pushDefault" "fork")
(let ((alist (vc-git--branch-remotes)))
(should (assq 'upstream alist))
(should (equal (cdr (assq 'push alist))
(concat "fork/" main-branch))))
(vc-git--out-ok "config" "remote.pushDefault" "origin")
(let ((alist (vc-git--branch-remotes)))
(should (assq 'upstream alist))
(should (null (assq 'push alist)))))))
;;; vc-git-tests.el ends here

3
test/src/process-tests.el
View file

@ -106,6 +106,9 @@ process to complete."
(looking-at "hello stdout!")))
(should (with-current-buffer stderr-buffer
(goto-char (point-min))
;; Instrument for bug#80166.
(when (getenv "EMACS_EMBA_CI")
(message "stderr\n%s" (buffer-string)))
(looking-at "hello stderr!"))))))
(ert-deftest process-test-stderr-filter ()