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

Merge branch 'master' into feature/igc

Browse source
This commit is contained in:
Gerd Möllmann 2025-05-22 16:33:39 +02:00
commit 4f81359ab0
94 changed files with 1994 additions and 1018 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
.clangd
View file

@ -2,4 +2,5 @@
If:
PathMatch: "src/*.c"
CompileFlags:
Add: [-Wno-unused-macros, -include=config.h]
Add: [-Wno-unused-macros, -include=config.h, -fstrict-flex-arrays=3]
Remove: [-fstrict-flex-arrays]

85
configure.ac
View file

@ -2224,49 +2224,50 @@ esac
C_SWITCH_MACHINE=
AC_CACHE_CHECK([for flags to work around GCC bug 58416],
[emacs_cv_gcc_bug_58416_CFLAGS],
[emacs_cv_gcc_bug_58416_CFLAGS='none needed'
AS_CASE([$canonical],
[[i[3456]86-* | x86_64-*]],
[AS_IF([test "$GCC" = yes],
[old_CFLAGS=$CFLAGS
# If no flags are needed (e.g., not GCC 4+), don't use any.
# Otherwise, use -mfpmath=sse if already assuming SSE2.
# Otherwise, use -fno-tree-sra.
for emacs_cv_gcc_bug_58416_CFLAGS in \
'none needed' -mfpmath=sse -fno-tree-sra
do
AS_CASE([$emacs_cv_gcc_bug_58416_CFLAGS],
['none needed'], [],
[-fno-tree-sra], [break],
[CFLAGS="$old_CFLAGS $emacs_cv_gcc_bug_58416_CFLAGS"])
AC_COMPILE_IFELSE(
[AC_LANG_DEFINES_PROVIDED
[/* Work around GCC bug with double in unions on x86,
where the generated insns copy non-floating-point data
via fldl/fstpl instruction pairs. This can misbehave if
the data's bit pattern looks like a NaN. See, e.g.:
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=58416#c10
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=71460
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93271
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114659
Problem observed with 'gcc -m32' with GCC 14.1.1
20240607 (Red Hat 14.1.1-5) on x86-64. */
#include <float.h>
#if \
(4 <= __GNUC__ && __GNUC__ <= 14 && !defined __clang__ \
&& (defined __i386__ || defined __x86_64__) \
&& ! (0 <= FLT_EVAL_METHOD && FLT_EVAL_METHOD <= 1))
# error "GCC bug 58416 is possibly present"
#endif
]],
[break])
done
CFLAGS=$old_CFLAGS])])])
AS_CASE([$emacs_cv_gcc_bug_58416_CFLAGS],
AC_CACHE_CHECK([for flag to work around GCC bug 117423],
[emacs_cv_gcc_bug_117423_CFLAGS],
[emacs_cv_gcc_bug_117423_CFLAGS='none needed'
AS_IF([test "$GCC" = yes],
[old_CFLAGS=$CFLAGS
# If no flags are needed (e.g., not GCC 4+), don't use any.
# Otherwise, use -fno-tree-sra.
for emacs_cv_gcc_bug_117423_CFLAGS in \
'none needed' -fno-tree-sra
do
AS_CASE([$emacs_cv_gcc_bug_117423_CFLAGS],
['none needed'], [],
[-fno-tree-sra], [break],
[CFLAGS="$old_CFLAGS $emacs_cv_gcc_bug_117423_CFLAGS"])
AC_COMPILE_IFELSE(
[AC_LANG_DEFINES_PROVIDED
[/* Work around GCC bug 117423 with unions containing holes:
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=117423
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=119085
GCC bug 117423 is present even in GCC 15.1,
the current version as of this writing; for now,
assume it is present in all GCC versions starting with GCC 4.
Working wround GCC bug 117423 also works around GCC bug 58416
with double in unions on x86, where the generated insns
copy non-floating-point data via fldl/fstpl instruction pairs.
This can misbehave if the data's bit pattern looks like a NaN.
See, e.g.:
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=58416#c10
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=71460
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93271
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=114659
Although GCC bug 58416 is fixed in GCC 15.1,
GCC bug 117423 is still present there. */
#if 4 <= __GNUC__ && !defined __clang__
# error "GCC bug 117423 possibly present"
#endif
]],
[break])
done
CFLAGS=$old_CFLAGS])])
AS_CASE([$emacs_cv_gcc_bug_117423_CFLAGS],
[-*],
[C_SWITCH_MACHINE="$C_SWITCH_MACHINE $emacs_cv_gcc_bug_58416_CFLAGS"])
[C_SWITCH_MACHINE="$C_SWITCH_MACHINE $emacs_cv_gcc_bug_117423_CFLAGS"])
AC_SUBST([C_SWITCH_MACHINE])

9
doc/emacs/cmdargs.texi
View file

@ -146,6 +146,13 @@ appends (rather than prepends) the remainder to @code{load-path}.
(On MS Windows, use @samp{;} instead of @samp{:}; i.e., use
the value of @code{path-separator}.)
Note that the changes to @code{load-path} as result of using this option
do @emph{not} affect the directories where Emacs looks for the site
startup file and the Lisp packages loaded by the user's early-init and
init files (@pxref{Init File}), because @code{load-path} is changed by
the @samp{-L} option @emph{after} these files are loaded and
interpreted.
@item -f @var{function}
@opindex -f
@itemx --funcall=@var{function}
@ -567,7 +574,7 @@ whenever we say ``colon-separated list of directories'', it pertains
to Unix and GNU/Linux systems. On MS-DOS and MS-Windows, the
directories are separated by semi-colons instead, since DOS/Windows
file names might include a colon after a drive letter.} to search for
Emacs Lisp files. If set, it modifies the usual initial value of the
Emacs Lisp files. If set, it replaces the usual initial value of the
@code{load-path} variable (@pxref{Lisp Libraries}). An empty element
stands for the default value of @code{load-path}; e.g., using
@samp{EMACSLOADPATH="/tmp:"} adds @file{/tmp} to the front of

12
doc/emacs/files.texi
View file

@ -1035,11 +1035,11 @@ After the first time stamp, the line might look like this:
Time-stamp: <1993-07-06 11:05:14 terryg>
@end example
Second, configure Emacs to run @code{time-stamp} any time it saves a
Second, configure your Emacs to run @code{time-stamp} whenever it saves a
file, by adding @code{time-stamp}
to @code{before-save-hook} (@pxref{Hooks}).
You can either customize the option @code{before-save-hook}
(with @kbd{M-x customize-option}, @pxref{Specific Customization}),
You can either use @kbd{M-x customize-option} (@pxref{Specific
Customization}) to customize the option @code{before-save-hook},
or you can edit your init file adding this line:
@example
@ -1110,13 +1110,15 @@ End:
-->
@end example
@vindex time-stamp-format
By default the time stamp is
formatted according to your locale setting (@pxref{Environment}) and
time zone (@pxref{Time of Day,,, elisp, The Emacs Lisp Reference
Manual}).
@vindex time-stamp-time-zone
Set @code{time-stamp-time-zone} to override the time zone used.
@vindex time-stamp-format
See the built-in documentation for the variable @code{time-stamp-format}
for specifics and other variables that affect the formatting.
for specifics on formatting and other variables that affect it.
@node Time Stamps for One File
@subsubsection Forcing Time Stamps for One File

113
doc/emacs/programs.texi
View file

@ -1061,52 +1061,100 @@ nonblank line.
@cindex Electric Pair mode
@cindex inserting matching parentheses
@findex electric-pair-mode
Electric Pair mode, a global minor mode, provides a way to easily
insert matching delimiters: parentheses, braces, brackets, etc.
Whenever you insert an opening delimiter, the matching closing delimiter
is automatically inserted as well, leaving point between the two.
However, if you insert a closing delimiter where one already exists
(probably a mistake, since typing the opening delimiter inserted the
closing one for you), Emacs simply moves point to after the closing
delimiter, skipping the insertion. If the region is active
(@pxref{Mark}), insertion of a delimiter operates on the region: the
characters in the region are enclosed in a pair of matching delimiters,
leaving point after the delimiter you typed. If you provide a prefix
argument when inserting a delimiter, the numeric value of that prefix
argument specifies the number of pairs to insert.
Electric Pair mode is a minor mode that provides a way to easily
insert pairs of matching delimiters: parentheses, braces, brackets,
quotes, etc.@: (what counts as matching delimiters depends on the major
mode). To toggle Electric Pair mode globally, type @w{@kbd{M-x
electric-pair-mode}}. To toggle it only in the current buffer, type
@w{@kbd{M-x electric-pair-local-mode}}.
These variables control additional features of Electric Pair mode:
When this mode is enabled, typing an opening delimiter inserts both
that character and, immediately following it, the matching closing
delimiter, leaving point between the two. This makes it unnecessary to
type a matching closing delimiter in most cases. If you type one
nonetheless, Emacs simply inserts that character, unless point is
immediately before a closing delimiter of the same type; in that case,
point moves to immediately after the closing delimiter and no additional
closing delimiter is inserted. Thus, typing the sequence <opening
delimiter>, <matching closing delimiter> is a perhaps more convenient
alternative to the sequence <opening delimiter>, @kbd{C-f}.
With an active region (@pxref{Mark}), Electric Pair mode operates
differently: inserting either an opening or a closing delimiter encloses
the characters in the region within the resulting pair of matching
delimiters, leaving point after the delimiter you typed (this
facilitates continuing to type either before the text following the
opening delimiter or after the closing delimiter).
If you provide a prefix argument when inserting an opening
delimiter---and if the region is active, also when inserting a closing
delimiter---this results in the insertion of as many nested pairs of
matching delimiters as the numeric value of that prefix argument.
There are several user options for modifying the behavior of Electric
Pair mode:
@itemize @bullet
@item
@vindex electric-pair-preserve-balance
@code{electric-pair-preserve-balance}, when non-@code{nil}, makes the
default pairing logic balance out the number of opening and closing
delimiters.
@code{electric-pair-preserve-balance}, when non-@code{nil} (the
default), makes typing a delimiter preserve the balance between opening
and closing delimiters. Thus, if you type an opening delimiter and
there is an unpaired matching closing delimiter later in the buffer,
then only the opening delimiter gets inserted (and not a matching
closing delimiter immediately following it); likewise, if there is an
unpaired opening delimiter, then typing a matching closing delimiter
later in the buffer inserts this character even when the following
character is another matching closing delimiter.
When set to @code{nil}, typing an opening delimiter inserts only this
character, but only when point is either immediately before or
immediately after a matching opening delimiter, or immediately before a
letter or digit; in all other positions inserting an opening delimiter
automatically inserts a matching closing delimiter immediately following
it, even if there is an unpaired matching closing delimiter later in the
buffer. And typing a closing delimiter immediately before another
closing delimiter of the same type does not insert that character but
moves point as described above, even when there is an unpaired matching
opening delimiter earlier in the buffer.
If there is an active region, this variable has no effect.
@item
@vindex electric-pair-delete-adjacent-pairs
@code{electric-pair-delete-adjacent-pairs}, when non-@code{nil}, makes
backspacing between two adjacent delimiters also automatically delete
the closing delimiter.
@code{electric-pair-delete-adjacent-pairs}, when non-@code{nil} (the
default), makes deleting an opening delimiter by typing the @key{DEL}
key (which is normally the @key{BACKSPACE} key; @pxref{DEL Does Not
Delete}) automatically also delete an immediately following matching
closing delimiter (but not if there are any characters---including just
whitespace---between the paired delimiters). When set to @code{nil},
typing @key{BACKSPACE} deletes only the opening delimiter. (Typing
@key{BACKSPACE} to delete a closing delimiter always deletes only this
character.)
@item
@vindex electric-pair-open-newline-between-pairs
@code{electric-pair-open-newline-between-pairs}, when non-@code{nil},
makes inserting a newline between two adjacent pairs also
automatically open an extra newline after point.
When @code{electric-pair-open-newline-between-pairs} is non-@code{nil}
(the default) and point is between an opening delimiter and an
immediately following matching closing delimiter, then typing a newline
automatically inserts an extra newline after point (possibly indenting
the empty line point is on, depending on the major mode). When set to
@code{nil}, typing a newline inserts only one newline before point, as
usual.
@item
@vindex electric-pair-skip-whitespace
@code{electric-pair-skip-whitespace}, when non-@code{nil}, causes the minor
mode to skip whitespace forward before deciding whether to skip over
the closing delimiter.
When @code{electric-pair-skip-whitespace} has its default non-@code{nil}
value and point is separated from a closing delimiter only by
whitespace, then typing a closing delimiter of the same type does not
insert that character but instead moves point to immediately after the
already present closing delimiter. You can also set this option to
additionally delete any whitespace that point moves over. When set to
@code{nil}, typing a closing delimiter simply inserts that character
(even when this makes the following closing delimiter of the same type
unbalanced).
@end itemize
To toggle Electric Pair mode, type @kbd{M-x electric-pair-mode}. To
toggle the mode in a single buffer, use @kbd{M-x
electric-pair-local-mode}.
@node Comments
@section Manipulating Comments
@cindex comments
@ -1668,6 +1716,7 @@ Hide all blocks @var{n} levels below this block
@end table
@vindex hs-hide-comments-when-hiding-all
@vindex hs-display-lines-hidden
@vindex hs-isearch-open
@vindex hs-special-modes-alist
These variables can be used to customize Hideshow mode:
@ -1677,6 +1726,10 @@ Hide all blocks @var{n} levels below this block
If non-@code{nil}, @kbd{C-c @@ C-M-h} (@code{hs-hide-all}) hides
comments too.
@item hs-display-lines-hidden
If non-@code{nil}, display the number of hidden lines next to the
ellipsis.
@item hs-isearch-open
This variable specifies the conditions under which incremental search
should unhide a hidden block when matching text occurs within the

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

@ -380,6 +380,25 @@ appropriate version control system. If @code{vc-command-messages} is
non-@code{nil}, VC displays messages to indicate which shell commands
it runs, and additional messages when the commands finish.
@vindex vc-async-checkin
Normally checkin operations are done synchronously; that is, Emacs
waits until the checkin has completed before doing anything else. This
can be inconvenient for repositories in which the checkin operation is
slow, such as Git repositories where you check in changes to very large
files, or Mercurial repositories with a very large number of files.
For those backends which support it, setting @code{vc-async-checkin}
to non-@code{nil} switches to doing checkin operations asynchronously.
This is particularly useful as a directory local variable in
repositories where checkin operations are slow (@pxref{Directory Local
Variables,,,elisp,GNU Emacs Lisp Reference Manual}).
While an asynchronous checkin operation is in progress, if you use
@kbd{C-x C-s} to save a buffer visiting any file within the current VC
tree, then the operation reverts to a synchronous checkin and Emacs
waits for it to complete before saving the buffer. This is to avoid
nondeterminism regarding exactly what changes get checked in.
@node RCS and SCCS
@subsubsection Options for RCS and SCCS

17
doc/lispref/frames.texi
View file

@ -2886,15 +2886,16 @@ the @code{delete-frame} call in a @code{condition-case} form.
@defun frame-list
This function returns a list of all the live frames, i.e., those that
have not been deleted. It is analogous to @code{buffer-list} for
buffers, and includes frames on all terminals. The list that you get
is newly created, so modifying the list doesn't have any effect on the
internals of Emacs.
buffers, and includes frames on all terminals with the exception of
tooltip frames (@pxref{Tooltips}). The list that you get is newly
created, so modifying the list doesn't have any effect on the internals
of Emacs.
@end defun
@defun visible-frame-list
This function returns a list of just the currently visible frames.
@xref{Visibility of Frames}. Frames on text terminals always count as
visible, even though only the selected one is actually displayed.
@xref{Visibility of Frames}. Frames on text terminals will count as
visible even though only the selected one is actually displayed.
@end defun
@defun frame-list-z-order &optional display
@ -2917,7 +2918,7 @@ This function lets you cycle conveniently through all the frames on a
specific terminal from an arbitrary starting point. It returns the
frame following @var{frame}, in the list of all live frames, on
@var{frame}'s terminal. The argument @var{frame} must specify a live
frame and defaults to the selected frame. It never returns a frame
frame and defaults to the selected frame. It does not return a frame
whose @code{no-other-frame} parameter (@pxref{Frame Interaction
Parameters}) is non-@code{nil}.
@ -2937,6 +2938,10 @@ minibuffer window.
@item anything else
Consider all frames.
@end table
If this function does not find a suitable frame, it returns @var{frame}
even if it would not qualify according to the @var{minibuf} argument or
its @code{no-other-frame} parameter.
@end defun
@defun previous-frame &optional frame minibuf

16
doc/lispref/searching.texi
View file

@ -1030,13 +1030,13 @@ programming language:
@example
@group
(rx "/*" ; Initial /*
(rx "/*" ; Initial /*
(zero-or-more
(or (not "*") ; Either non-*,
(seq "*" ; or * followed by
(not "/")))) ; non-/
(one-or-more "*") ; At least one star,
"/") ; and the final /
(or (not "*") ; Either non-*,
(seq (one-or-more "*") ; or some * followed by
(not (or "*" "/"))))) ; neither * nor /
(one-or-more "*") ; At least one star,
"/") ; and the final /
@end group
@end example
@ -1047,7 +1047,7 @@ or, using shorter synonyms and written more compactly,
@group
(rx "/*"
(* (| (not "*")
(: "*" (not "/"))))
(: (+ "*") (not (in "*/")))))
(+ "*") "/")
@end group
@end example
@ -1056,7 +1056,7 @@ or, using shorter synonyms and written more compactly,
In conventional string syntax, it would be written
@example
"/\\*\\(?:[^*]\\|\\*[^/]\\)*\\*+/"
"/\\*\\(?:[^*]\\|\\*+[^*/]\\)*\\*+/"
@end example
The @code{rx} notation is mainly useful in Lisp code; it cannot be

8
doc/lispref/tips.texi
View file

@ -1217,10 +1217,10 @@ lines. Here is a table of them:
@table @samp
@item ;;; Commentary:
This begins introductory comments that explain how the library works.
It should come right after the copying permissions, terminated by a
@samp{Change Log}, @samp{History} or @samp{Code} comment line. This
text is used by the Finder package, so it should make sense in that
context.
It should come right after the copying permissions, and is terminated by
one of the comment lines described below: @samp{Change Log},
@samp{History} or @samp{Code}. This text is used by the Finder package,
so it should make sense in that context.
@item ;;; Change Log:
This begins an optional log of changes to the file over time. Don't

45
doc/lispref/variables.texi
View file

@ -615,14 +615,6 @@ float-pi
@end example
@end defspec
@strong{Warning:} If you use a @code{defconst} or @code{defvar}
special form while the variable has a local binding (made with
@code{let}, or a function argument), it sets the local binding rather
than the global binding. This is not what you usually want. To
prevent this, use these special forms at top level in a file, where
normally no local binding is in effect, and make sure to load the file
before making a local binding for the variable.
@node Tips for Defining
@section Tips for Defining Variables Robustly
@ -1792,8 +1784,8 @@ came from or how to save it, rather than with how to edit the contents.
The global value of a variable with buffer-local bindings is also
called the @dfn{default} value, because it is the value that is in
effect whenever neither the current buffer nor the selected frame has
its own binding for the variable.
effect whenever the current buffer lacks its own binding for the
variable.
The functions @code{default-value} and @code{setq-default} access and
change a variable's default value regardless of whether the current
@ -1941,6 +1933,39 @@ global value of @var{symbol} regardless of whether your code runs in
the context of @var{symbol}'s let-binding.
@end defun
@cindex top-level buffer-local value
A variable's buffer-local value may also be shadowed by a
let-binding. Two functions allow getting and setting the
top-level buffer-local value of a variable, i.e., the value outside of
the let-binding.
@defun buffer-local-toplevel-value symbol &optional buffer
This function returns the local value for @var{symbol} in @var{buffer},
defaulting to the current buffer, outside of any let-binding. If
@var{symbol} is not local in @var{buffer}, this function signals an
error.
@end defun
@defun set-buffer-local-toplevel-value symbol value &optional buffer
This function sets the local value of @var{symbol} to @var{value} in
@var{buffer}, defaulting to the current buffer, outside of any
let-binding.
@var{symbol} is made local in @var{buffer} if it was not already. For
global variables, this means @var{symbol} will have a separate value in
@var{buffer}; for variables that are automatically buffer-local, this
function causes a local value for them to exist in @var{buffer}. If
@var{symbol} is permanently buffer-local, @var{value} will now persist
as the buffer-local value for the variable across changes of major mode.
This is useful when you want to make a change to a buffer-local value
that will persist after the command now being executed completes,
where your code may be executed with that variable let-bound. In this
case the usual way of setting buffer-local values, using @code{setq-local},
will only change the value inside the let-binding, and not the underlying
buffer-local value. This function sets the latter.
@end defun
@node File Local Variables
@section File Local Variables

3
doc/misc/eww.texi
View file

@ -259,6 +259,9 @@ to quickly kill, flip through and switch to specific EWW buffer. To
switch EWW buffers through a minibuffer prompt, press @kbd{s}
(@code{eww-switch-to-buffer}).
The @code{eww-switch-to-buffer} command will fallback to @code{eww}
when there is no EWW buffers.
@findex eww-browse-with-external-browser
@vindex browse-url-secondary-browser-function
@vindex eww-use-external-browser-for-content-type

15
doc/misc/reftex.texi
View file

@ -252,16 +252,27 @@ version 20.2.
@findex turn-on-reftex
@findex reftex-mode
@findex use-package
@vindex LaTeX-mode-hook
@vindex latex-mode-hook
To turn @RefTeX{} Mode on and off in a particular buffer, use
@kbd{M-x reftex-mode @key{RET}}. To turn on @RefTeX{} Mode for all
LaTeX files, add the following lines to your @file{.emacs} file:
@example
@lisp
(add-hook 'LaTeX-mode-hook #'turn-on-reftex) ; with AUCTeX LaTeX mode
(add-hook 'latex-mode-hook #'turn-on-reftex) ; with Emacs latex mode
@end example
@end lisp
@noindent
Users of the use-package library can achieve the same result with:
@lisp
(use-package reftex ; with AUCTeX LaTeX mode
:hook (LaTeX-mode . turn-on-reftex))
(use-package reftex ; with Emacs latex mode
:hook (latex-mode . turn-on-reftex))
@end lisp
That's all!

69
etc/NEWS
View file

@ -383,6 +383,12 @@ customize help text for tabs displayed on the tab-bar. Help text is
normally shown in the echo area or via tooltips. See the variable's
docstring for arguments passed to a help-text function.
---
*** New command 'tab-line-move-tab-forward' ('C-x M-<right>').
Together with the new command 'tab-line-move-tab-backward'
('C-x M-<left>') it can be used to move the current tab
on the tab line to a different position.
** Project
---
@ -721,6 +727,12 @@ Now 'treesit-explore-mode' (or 'treesit-explore') prompts for a parser
rather than a language, and it is now possible to select a local parser
at point to explore.
** Hideshow
*** New user option 'hs-display-lines-hidden'.
If this option is non-nil, Hideshow displays the number of hidden
lines next to the ellipsis.
** C-ts mode
+++
@ -1257,6 +1269,11 @@ content-type of Web pages which don't have a valid 'Content-Type'
header. The default value is a function that considers a page with an
HTML 'doctype' declaration to have context-type "text/html".
+++
*** 'eww-switch-to-buffer' falls back to 'eww'.
When there is no EWW buffers, 'eww-switch-to-buffer' falls back to
calling 'eww'.
** CC mode
+++
@ -1752,6 +1769,10 @@ were added, removed or edited, Emacs would refuse to proceed.
Now Emacs prompts to first register the unregistered files, so that all
files in the fileset are in a compatible state for a checkin.
+++
*** New user option 'vc-async-checkin' to enable async checkin operations.
Currently only supported by the Git and Mercurial backends.
---
*** New 'log-edit-hook' option to display diff of changes to commit.
You can customize 'log-edit-hook' to include its new
@ -1937,6 +1958,13 @@ New faces have been added to 'icomplete-vertical-mode':
This is intended for customizing directory-local variables in the
current directory's ".dir-locals.el" file.
** Pulse
--
*** New function 'pulse-faces'.
This function pulses a specified list of faces. The pulse duration is
determined by the new user option 'pulse-face-duration'.
** Miscellaneous
---
@ -1985,6 +2013,31 @@ change their face if the current line exceeds the 'fill-column'. The
new face 'display-fill-column-indicator-warning-face' is used to
highlight the fill-column indicators. By default, this is disabled.
---
*** New function 'flash-face-bell-function'.
This function flashes a face briefly.
It is intended to be used in 'ring-bell-function'.
---
*** New function 'flash-echo-area-bell-function'.
This function flashes current echo area briefly.
It is intended to be used in 'ring-bell-function'.
---
*** New user option 'flash-face-duration'.
This option controls the flash duration for 'flash-face-bell-function'
and 'flash-echo-area-bell-function'.
---
*** New user option 'flash-face-faces'.
This option tells 'flash-face-bell-function' which faces should flash.
---
*** New user option 'flash-face-attributes'
This option tells 'flash-face-bell-function' and
'flash-echo-area-bell-function' which face attributes should be used
for flash.
---
** Flymake
@ -2040,6 +2093,7 @@ DISABLE-URI non-nil.
When starting these debuggers (e.g., 'M-x pdb') while visiting a file,
pressing 'M-n' in the command prompt suggests a command line including
the file name, using the minibuffer's "future history".
** Calendar
+++
@ -2047,9 +2101,18 @@ the file name, using the minibuffer's "future history".
This command recenters the month of the date at point. By default, it
is bound to 'C-l' in the calendar buffer.
---
*** Mouse wheel bindings for scrolling the calendar.
You can now use the mouse wheel to scroll the calendar by 3 months.
With the shift modifier, it scrolls by one month. With the meta
modifier, it scrolls by year.
* New Modes and Packages in Emacs 31.1
** New minor mode 'delete-trailing-whitespace-mode'.
A simple buffer-local mode that runs 'delete-trailing-whitespace'
before saving the buffer.
** New major mode 'conf-npmrc-mode'.
A major mode based on 'conf-mode' for editing ".npmrc" files.
@ -2343,6 +2406,12 @@ sleep state.
'advertised-undo', 'advertised-widget-backward', and
'dired-advertised-find-file'.
+++
** New functions to get and set top-level buffer-local values.
'buffer-local-toplevel-value' and 'set-buffer-local-toplevel-value' get
and set the top-level buffer-local value of a variable. A top-level
value is the one that variable has outside of any let-bindings.
* Changes in Emacs 31.1 on Non-Free Operating Systems

42
lib-src/ntlib.c
View file

@ -30,6 +30,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <direct.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <math.h>
#include <errno.h>
#include <ctype.h>
#include <sys/timeb.h>
@ -256,7 +257,7 @@ static long double utc_base;
static int init = 0;
static time_t
convert_time (FILETIME ft)
convert_time (FILETIME ft, int *time_nsec)
{
long double ret;
@ -266,7 +267,8 @@ convert_time (FILETIME ft)
ret = (long double) ft.dwHighDateTime
* 4096.0L * 1024.0L * 1024.0L + ft.dwLowDateTime;
ret -= utc_base;
return (time_t) (ret * 1e-7L);
*time_nsec = (int) fmodl (ret, 1.0e7L) * 100;
return (time_t) (ret * 1.0e-7L);
}
static int
@ -373,11 +375,19 @@ stat (const char * path, struct stat * buf)
buf->st_size += wfd.nFileSizeLow;
/* Convert timestamps to Unix format. */
buf->st_mtime = convert_time (wfd.ftLastWriteTime);
buf->st_atime = convert_time (wfd.ftLastAccessTime);
if (buf->st_atime == 0) buf->st_atime = buf->st_mtime;
buf->st_ctime = convert_time (wfd.ftCreationTime);
if (buf->st_ctime == 0) buf->st_ctime = buf->st_mtime;
buf->st_mtime = convert_time (wfd.ftLastWriteTime, &buf->st_mtimensec);
buf->st_atime = convert_time (wfd.ftLastAccessTime, &buf->st_atimensec);
if (buf->st_atime == 0)
{
buf->st_atime = buf->st_mtime;
buf->st_atimensec = buf->st_mtimensec;
}
buf->st_ctime = convert_time (wfd.ftCreationTime, &buf->st_ctimensec);
if (buf->st_ctime == 0)
{
buf->st_ctime = buf->st_mtime;
buf->st_ctimensec = buf->st_mtimensec;
}
/* determine rwx permissions */
if (wfd.dwFileAttributes & FILE_ATTRIBUTE_READONLY)
@ -473,11 +483,19 @@ fstat (int desc, struct stat * buf)
buf->st_size += info.nFileSizeLow;
/* Convert timestamps to Unix format. */
buf->st_mtime = convert_time (info.ftLastWriteTime);
buf->st_atime = convert_time (info.ftLastAccessTime);
if (buf->st_atime == 0) buf->st_atime = buf->st_mtime;
buf->st_ctime = convert_time (info.ftCreationTime);
if (buf->st_ctime == 0) buf->st_ctime = buf->st_mtime;
buf->st_mtime = convert_time (info.ftLastWriteTime, &buf->st_mtimensec);
buf->st_atime = convert_time (info.ftLastAccessTime, &buf->st_atimensec);
if (buf->st_atime == 0)
{
buf->st_atime = buf->st_mtime;
buf->st_atimensec = buf->st_mtimensec;
}
buf->st_ctime = convert_time (info.ftCreationTime, &buf->st_ctimensec);
if (buf->st_ctime == 0)
{
buf->st_ctime = buf->st_mtime;
buf->st_ctimensec = buf->st_mtimensec;
}
/* determine rwx permissions */
if (info.dwFileAttributes & FILE_ATTRIBUTE_READONLY)

2
lib/cdefs.h
View file

@ -497,7 +497,7 @@
# endif
#endif
/* ISO C99 also allows to declare arrays as non-overlapping. The syntax is
/* ISO C99 also allows declaring arrays as non-overlapping. The syntax is
array_name[restrict]
GCC 3.1 and clang support this.
This syntax is not usable in C++ mode. */

68
lib/strftime.c
View file

@ -14,10 +14,14 @@
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* If FPRINTFTIME is set to 1, this file defines a function with a
'FILE *fp' parameter instead of two 'char *s, size_t max' parameters. */
#ifndef FPRINTFTIME
# define FPRINTFTIME 0
#endif
/* If USE_C_LOCALE is set to 1, this file defines a function that uses the
"C" locale, regardless of the current locale. */
#ifndef USE_C_LOCALE
# define USE_C_LOCALE 0
#endif
@ -38,6 +42,14 @@
# include "time-internal.h"
#endif
/* Whether the system supports no localized output at all, that is, whether
strftime's output does not depend on the current locale. */
#if defined __ANDROID__
# define HAVE_ONLY_C_LOCALE 1
#else
# define HAVE_ONLY_C_LOCALE 0
#endif
/* Whether to require GNU behavior for AM and PM indicators, even on
other platforms. This matters only in non-C locales.
The default is to require it; you can override this via
@ -46,12 +58,12 @@
#ifndef REQUIRE_GNUISH_STRFTIME_AM_PM
# define REQUIRE_GNUISH_STRFTIME_AM_PM true
#endif
#if USE_C_LOCALE
#if HAVE_ONLY_C_LOCALE || USE_C_LOCALE
# undef REQUIRE_GNUISH_STRFTIME_AM_PM
# define REQUIRE_GNUISH_STRFTIME_AM_PM false
#endif
#if USE_C_LOCALE
#if HAVE_ONLY_C_LOCALE || USE_C_LOCALE
# include "c-ctype.h"
#else
# include <ctype.h>
@ -302,7 +314,7 @@ enum pad_style
# define TOUPPER(Ch, L) __toupper_l (Ch, L)
# define TOLOWER(Ch, L) __tolower_l (Ch, L)
# else
# if USE_C_LOCALE
# if HAVE_ONLY_C_LOCALE || USE_C_LOCALE
# define TOUPPER(Ch, L) c_toupper (Ch)
# define TOLOWER(Ch, L) c_tolower (Ch)
# else
@ -379,7 +391,8 @@ memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, size_t len LOCALE_PARAM)
#define HAVE_NATIVE_TIME_Z \
(USE_C_LOCALE && HAVE_STRFTIME_L ? HAVE_STRFTIME_LZ : HAVE_STRFTIME_Z)
#if USE_C_LOCALE && HAVE_STRFTIME_L
#if (!HAVE_ONLY_C_LOCALE || !HAVE_STRUCT_TM_TM_ZONE) \
&& USE_C_LOCALE && HAVE_STRFTIME_L
/* Cache for the C locale object.
Marked volatile so that different threads see the same value
@ -398,7 +411,10 @@ c_locale (void)
#endif
#if HAVE_NATIVE_TIME_Z
#if !defined _LIBC \
&& (!(HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)) \
|| !HAVE_STRUCT_TM_TM_ZONE) \
&& HAVE_NATIVE_TIME_Z
/* On NetBSD a null tz has undefined behavior, so use a non-null tz.
Cache the UTC time zone object in a volatile variable for improved
@ -818,7 +834,7 @@ iso_week_days (int yday, int wday)
}
#if !defined _NL_CURRENT && (USE_C_LOCALE && !HAVE_STRFTIME_L)
#if !defined _NL_CURRENT && (HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L))
static CHAR_T const c_weekday_names[][sizeof "Wednesday"] =
{
L_("Sunday"), L_("Monday"), L_("Tuesday"), L_("Wednesday"),
@ -861,7 +877,8 @@ static size_t __strftime_internal (STREAM_OR_CHAR_T *, STRFTIME_ARG (size_t)
extra_args_spec LOCALE_PARAM);
#if !defined _LIBC \
&& (!(USE_C_LOCALE && !HAVE_STRFTIME_L) || !HAVE_STRUCT_TM_TM_ZONE)
&& (!(HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)) \
|| !HAVE_STRUCT_TM_TM_ZONE)
/* Make sure we're calling the actual underlying strftime.
In some cases, time.h contains something like
@ -1028,7 +1045,12 @@ get_tm_zone (timezone_t tz, char *ubuf, int ubufsize, int modifier,
*TP is computed with a totally different time zone.
This is bogus: though POSIX allows bad behavior like this,
POSIX does not require it. Do the right thing instead. */
return tp->tm_zone;
const char *ret = tp->tm_zone;
# if defined __ANDROID__
if (!ret)
ret = "";
# endif
return ret;
#else
if (!tz)
return "UTC";
@ -1125,7 +1147,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
# define am_len STRLEN (a_month)
# define aam_len STRLEN (a_altmonth)
# define ap_len STRLEN (ampm)
#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#elif HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
/* The English abbreviated weekday names are just the first 3 characters of the
English full weekday names. */
# define a_wkday \
@ -1383,7 +1405,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
to_uppcase = true;
to_lowcase = false;
}
#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L)
#if defined _NL_CURRENT || HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
cpy (aw_len, a_wkday);
break;
#else
@ -1398,7 +1420,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
to_uppcase = true;
to_lowcase = false;
}
#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L)
#if defined _NL_CURRENT || HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
cpy (STRLEN (f_wkday), f_wkday);
break;
#else
@ -1420,7 +1442,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
else
cpy (am_len, a_month);
break;
#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#elif HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
cpy (am_len, a_month);
break;
#else
@ -1444,7 +1466,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
else
cpy (STRLEN (f_month), f_month);
break;
#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#elif HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
cpy (STRLEN (f_month), f_month);
break;
#else
@ -1461,7 +1483,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
NLW(ERA_D_T_FMT)))
!= '\0')))
subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_T_FMT));
#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#elif HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
subfmt = L_("%a %b %e %H:%M:%S %Y");
#elif defined _WIN32 && !defined __CYGWIN__
/* On native Windows, "%c" is "%d/%m/%Y %H:%M:%S" by default. */
@ -1500,7 +1522,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
}
break;
#if !defined _LIBC && !(USE_C_LOCALE && !HAVE_STRFTIME_L)
#if !defined _LIBC && !(HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L))
underlying_strftime:
{
char ubuf[1024]; /* enough for any single format in practice */
@ -1600,7 +1622,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
# endif
break;
}
#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#elif HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
#else
goto underlying_strftime;
#endif
@ -1624,7 +1646,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
!= L_('\0'))))
subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_FMT));
goto subformat;
#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#elif HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
subfmt = L_("%m/%d/%y");
goto subformat;
#else
@ -1702,7 +1724,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
break;
}
}
#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#elif HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
#else
goto underlying_strftime;
#endif
@ -1850,7 +1872,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
to_uppcase = false;
to_lowcase = true;
}
#if defined _NL_CURRENT || (USE_C_LOCALE && !HAVE_STRFTIME_L)
#if defined _NL_CURRENT || HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
cpy (ap_len, ampm);
break;
#else
@ -1871,7 +1893,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
== L_('\0'))
subfmt = L_("%I:%M:%S %p");
goto subformat;
#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#elif HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
subfmt = L_("%I:%M:%S %p");
goto subformat;
#elif ((defined __APPLE__ && defined __MACH__) || defined __FreeBSD__ \
@ -1933,7 +1955,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
!= L_('\0'))))
subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(T_FMT));
goto subformat;
#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#elif HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
subfmt = L_("%H:%M:%S");
goto subformat;
#else
@ -2043,7 +2065,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
pad = yr_spec;
goto subformat;
}
#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#elif HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
#else
goto underlying_strftime;
#endif
@ -2067,7 +2089,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
DO_NUMBER (2, (era->offset
+ delta * era->absolute_direction));
}
#elif USE_C_LOCALE && !HAVE_STRFTIME_L
#elif HAVE_ONLY_C_LOCALE || (USE_C_LOCALE && !HAVE_STRFTIME_L)
#else
goto underlying_strftime;
#endif

3
lisp/abbrev.el
View file

@ -291,7 +291,8 @@ abbrevs have been saved."
The saved abbrevs are written to the file specified by
`abbrev-file-name'."
(interactive nil edit-abbrevs-mode)
(abbrev-edit-save-to-file abbrev-file-name))
(abbrev-edit-save-to-file abbrev-file-name)
(setq abbrevs-changed nil))
(defun add-mode-abbrev (arg)

2
lisp/autorevert.el
View file

@ -274,7 +274,7 @@ it should return non-nil to make Global Auto-Revert Mode not
revert this buffer.")
(defcustom auto-revert-remote-files nil
"If non-nil remote files are also reverted."
"If nil remote files are not reverted in Auto Revert modes."
:group 'auto-revert
:type 'boolean
:version "24.4")

2
lisp/bs.el
View file

@ -572,7 +572,7 @@ SORT-DESCRIPTION is an element of `bs-sort-functions'."
"Go to line which represents the current buffer.
Actually, it goes to the line which begins with the character
in `bs-string-current' or `bs-string-current-marked'."
(let ((regexp (concat "\\`"
(let ((regexp (concat "^"
(regexp-opt (list bs-string-current
bs-string-current-marked))))
point)

6
lisp/calendar/calendar.el
View file

@ -1587,12 +1587,18 @@ Otherwise, use the selected window of EVENT's frame."
(define-key map (vector 'remap c) 'calendar-not-implemented))
(define-key map "<" 'calendar-scroll-right)
(define-key map "\C-x<" 'calendar-scroll-right)
(define-key map [S-wheel-up] 'calendar-scroll-right)
(define-key map [prior] 'calendar-scroll-right-three-months)
(define-key map "\ev" 'calendar-scroll-right-three-months)
(define-key map [wheel-up] 'calendar-scroll-right-three-months)
(define-key map [M-wheel-up] 'calendar-backward-year)
(define-key map ">" 'calendar-scroll-left)
(define-key map "\C-x>" 'calendar-scroll-left)
(define-key map [S-wheel-down] 'calendar-scroll-left)
(define-key map [next] 'calendar-scroll-left-three-months)
(define-key map "\C-v" 'calendar-scroll-left-three-months)
(define-key map [wheel-down] 'calendar-scroll-left-three-months)
(define-key map [M-wheel-down] 'calendar-forward-year)
(define-key map "\C-l" 'calendar-recenter)
(define-key map "\C-b" 'calendar-backward-day)
(define-key map "\C-p" 'calendar-backward-week)

39
lisp/calendar/icalendar.el
View file

@ -1766,10 +1766,19 @@ entries. ENTRY-MAIN is the first line of the diary entry."
;matching, esp. with
;different forms of
;MONTH
(month (nth 1 sexp))
(month-exp (nth 1 sexp))
(months (cond ((eq month-exp t) nil) ; don't add a BYMONTH clause
((integerp month-exp) (list month-exp))
(t month-exp)))
(dayname (nth 2 sexp))
(n (nth 3 sexp))
(day (nth 4 sexp))
(dtstart
;; Start on the first day matching the rule in
;; icalendar-recurring-start-year:
(calendar-nth-named-day n dayname
(if months (apply #'min months) 1)
icalendar-recurring-start-year))
(summary
(replace-regexp-in-string
"\\(^\s+\\|\s+$\\)" ""
@ -1781,31 +1790,19 @@ entries. ENTRY-MAIN is the first line of the diary entry."
(error "Don't know if or how to implement day in `diary-float'")))
(cons (concat
;;Start today (yes this is an arbitrary choice):
"\nDTSTART;VALUE=DATE:"
(format-time-string "%Y%m%d")
;;BUT remove today if `diary-float'
;;expression does not hold true for today:
(when
(null (calendar-dlet ((date (calendar-current-date))
(entry entry-main))
(diary-float month dayname n)))
(concat
"\nEXDATE;VALUE=DATE:"
(format-time-string "%Y%m%d")))
(format "%04d%02d%02d"
(calendar-extract-year dtstart)
(calendar-extract-month dtstart)
(calendar-extract-day dtstart))
"\nRRULE:"
(if (or (numberp month) (listp month))
(if months
"FREQ=YEARLY;BYMONTH="
"FREQ=MONTHLY")
(when
(listp month)
(when months
(mapconcat
(lambda (m)
(number-to-string m))
(cadr month) ","))
(when
(numberp month)
(number-to-string month))
(lambda (m) (number-to-string m))
months ","))
";BYDAY="
(number-to-string n)
(aref icalendar--weekday-array dayname))

168
lisp/comint.el
View file

@ -434,7 +434,7 @@ This is used by `comint-watch-for-password-prompt' to reduce the amount
of time spent searching for password prompts.")
;; Here are the per-interpreter hooks.
(defvar comint-get-old-input (function comint-get-old-input-default)
(defvar comint-get-old-input #'comint-get-old-input-default
"Function that returns old text in Comint mode.
This function is called when return is typed while the point is in old
text. It returns the text to be submitted as process input. The
@ -477,7 +477,7 @@ either globally or locally.")
(defvar comint-input-sender-no-newline nil
"Non-nil directs the `comint-input-sender' function not to send a newline.")
(defvar comint-input-sender (function comint-simple-send)
(defvar comint-input-sender #'comint-simple-send
"Function to actually send to PROCESS the STRING submitted by user.
Usually this is just `comint-simple-send', but if your mode needs to
massage the input string, put a different function here.
@ -536,42 +536,42 @@ via PTYs.")
(defvar comint-mode-map
(let ((map (make-sparse-keymap)))
;; Keys:
(define-key map "\ep" 'comint-previous-input)
(define-key map "\en" 'comint-next-input)
(define-key map [C-up] 'comint-previous-input)
(define-key map [C-down] 'comint-next-input)
(define-key map "\er" 'comint-history-isearch-backward-regexp)
(define-key map [?\C-c ?\M-r] 'comint-previous-matching-input-from-input)
(define-key map [?\C-c ?\M-s] 'comint-next-matching-input-from-input)
(define-key map [?\C-x up] 'comint-complete-input-ring)
(define-key map "\e\C-l" 'comint-show-output)
(define-key map "\C-m" 'comint-send-input)
(define-key map "\C-d" 'comint-delchar-or-maybe-eof)
(define-key map "\ep" #'comint-previous-input)
(define-key map "\en" #'comint-next-input)
(define-key map [C-up] #'comint-previous-input)
(define-key map [C-down] #'comint-next-input)
(define-key map "\er" #'comint-history-isearch-backward-regexp)
(define-key map [?\C-c ?\M-r] #'comint-previous-matching-input-from-input)
(define-key map [?\C-c ?\M-s] #'comint-next-matching-input-from-input)
(define-key map [?\C-x up] #'comint-complete-input-ring)
(define-key map "\e\C-l" #'comint-show-output)
(define-key map "\C-m" #'comint-send-input)
(define-key map "\C-d" #'comint-delchar-or-maybe-eof)
;; The following two are standardly bound to delete-forward-char,
;; but they should never do EOF, just delete.
(define-key map [delete] 'delete-forward-char)
(define-key map [kp-delete] 'delete-forward-char)
(define-key map "\C-c " 'comint-accumulate)
(define-key map "\C-c\C-x" 'comint-get-next-from-history)
(define-key map "\C-c\C-a" 'comint-bol-or-process-mark)
(define-key map "\C-c\C-u" 'comint-kill-input)
(define-key map "\C-c\C-w" 'backward-kill-word)
(define-key map "\C-c\C-c" 'comint-interrupt-subjob)
(define-key map "\C-c\C-z" 'comint-stop-subjob)
(define-key map "\C-c\C-\\" 'comint-quit-subjob)
(define-key map "\C-c\C-m" 'comint-copy-old-input)
(define-key map "\C-c\C-o" 'comint-delete-output)
(define-key map "\C-c\M-o" 'comint-clear-buffer)
(define-key map "\C-c\C-r" 'comint-show-output)
(define-key map "\C-c\C-e" 'comint-show-maximum-output)
(define-key map "\C-c\C-l" 'comint-dynamic-list-input-ring)
(define-key map "\C-c\C-n" 'comint-next-prompt)
(define-key map "\C-c\C-p" 'comint-previous-prompt)
(define-key map "\C-c\C-d" 'comint-send-eof)
(define-key map "\C-c\C-s" 'comint-write-output)
(define-key map "\C-c." 'comint-insert-previous-argument)
(define-key map [delete] #'delete-forward-char)
(define-key map [kp-delete] #'delete-forward-char)
(define-key map "\C-c " #'comint-accumulate)
(define-key map "\C-c\C-x" #'comint-get-next-from-history)
(define-key map "\C-c\C-a" #'comint-bol-or-process-mark)
(define-key map "\C-c\C-u" #'comint-kill-input)
(define-key map "\C-c\C-w" #'backward-kill-word)
(define-key map "\C-c\C-c" #'comint-interrupt-subjob)
(define-key map "\C-c\C-z" #'comint-stop-subjob)
(define-key map "\C-c\C-\\" #'comint-quit-subjob)
(define-key map "\C-c\C-m" #'comint-copy-old-input)
(define-key map "\C-c\C-o" #'comint-delete-output)
(define-key map "\C-c\M-o" #'comint-clear-buffer)
(define-key map "\C-c\C-r" #'comint-show-output)
(define-key map "\C-c\C-e" #'comint-show-maximum-output)
(define-key map "\C-c\C-l" #'comint-dynamic-list-input-ring)
(define-key map "\C-c\C-n" #'comint-next-prompt)
(define-key map "\C-c\C-p" #'comint-previous-prompt)
(define-key map "\C-c\C-d" #'comint-send-eof)
(define-key map "\C-c\C-s" #'comint-write-output)
(define-key map "\C-c." #'comint-insert-previous-argument)
;; Mouse Buttons:
(define-key map [mouse-2] 'comint-insert-input)
(define-key map [mouse-2] #'comint-insert-input)
;; Menu bars:
;; completion:
(define-key map [menu-bar completion]
@ -650,7 +650,8 @@ via PTYs.")
"C-p" #'comint-previous-prompt)
;; Fixme: Is this still relevant?
(defvar comint-ptyp t
(defvar-local comint-ptyp t
;; FIXME: What bug and how does this work around that bug?
"Non-nil if communications via pty; false if by pipe. Buffer local.
This is to work around a bug in Emacs process signaling.")
@ -670,7 +671,7 @@ This is to support the command \\[comint-get-next-from-history].")
"Non-nil if you are accumulating input lines to send as input together.
The command \\[comint-accumulate] sets this.")
(defvar comint-stored-incomplete-input nil
(defvar-local comint-stored-incomplete-input nil
"Stored input for history cycling.")
(put 'comint-replace-by-expanded-history 'menu-enable 'comint-input-autoexpand)
@ -735,20 +736,10 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
;; It is ok to let the input method edit prompt text, but RET must
;; be processed by Emacs.
(setq text-conversion-style 'action)
(make-local-variable 'comint-last-prompt)
;; FIXME: Should be the responsibility of the setter to use `setq-local'!
(make-local-variable 'comint-prompt-regexp) ; Don't set; default
(make-local-variable 'comint-input-ring-size) ; ...to global val.
(make-local-variable 'comint-input-ring)
(make-local-variable 'comint-input-ring-file-name)
(or (and (boundp 'comint-input-ring) comint-input-ring)
(setq comint-input-ring (make-ring comint-input-ring-size)))
(make-local-variable 'comint-input-ring-index)
(make-local-variable 'comint-save-input-ring-index)
(or (and (boundp 'comint-input-ring-index) comint-input-ring-index)
(setq comint-input-ring-index nil))
(or (and (boundp 'comint-save-input-ring-index) comint-save-input-ring-index)
(setq comint-save-input-ring-index nil))
(make-local-variable 'comint-matching-input-from-input-string)
(make-local-variable 'comint-input-autoexpand)
(make-local-variable 'comint-input-ignoredups)
(make-local-variable 'comint-delimiter-argument-list)
@ -760,7 +751,15 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
(make-local-variable 'comint-scroll-to-bottom-on-input)
(make-local-variable 'comint-move-point-for-output)
(make-local-variable 'comint-scroll-show-maximum-output)
(make-local-variable 'comint-stored-incomplete-input)
(make-local-variable 'comint-process-echoes)
(make-local-variable 'comint-file-name-chars)
(make-local-variable 'comint-file-name-quote-list)
(or (and (boundp 'comint-input-ring) comint-input-ring)
(setq-local comint-input-ring (make-ring comint-input-ring-size)))
(or (and (boundp 'comint-input-ring-index) comint-input-ring-index)
(setq-local comint-input-ring-index nil))
(or (and (boundp 'comint-save-input-ring-index) comint-save-input-ring-index)
(setq-local comint-save-input-ring-index nil))
;; Following disabled because it seems to break the case when
;; comint-scroll-show-maximum-output is nil, and no-one can remember
;; what the original problem was. If there are problems with point
@ -769,11 +768,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
;;
;; This makes it really work to keep point at the bottom.
;; (setq-local scroll-conservatively 10000)
(add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t)
(make-local-variable 'comint-ptyp)
(make-local-variable 'comint-process-echoes)
(make-local-variable 'comint-file-name-chars)
(make-local-variable 'comint-file-name-quote-list)
(add-hook 'pre-command-hook #'comint-preinput-scroll-to-bottom t t)
;; dir tracking on remote files
(setq-local comint-file-name-prefix
(or (file-remote-p default-directory) ""))
@ -781,9 +776,9 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
(setq-local font-lock-defaults '(nil t))
(add-function :filter-return (local 'filter-buffer-substring-function)
#'comint--unmark-string-as-output)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(add-hook 'isearch-mode-hook 'comint-history-isearch-setup nil t)
(add-hook 'completion-at-point-functions 'comint-completion-at-point nil t)
(add-hook 'change-major-mode-hook #'font-lock-defontify nil t)
(add-hook 'isearch-mode-hook #'comint-history-isearch-setup nil t)
(add-hook 'completion-at-point-functions #'comint-completion-at-point nil t)
;; This behavior is not useful in comint buffers, and is annoying
(setq-local next-line-add-newlines nil))
@ -885,7 +880,7 @@ series of processes in the same Comint buffer. The hook
(if (consp command)
(open-network-stream name buffer (car command) (cdr command))
(comint-exec-1 name buffer command switches))))
(set-process-filter proc 'comint-output-filter)
(set-process-filter proc #'comint-output-filter)
(setq-local comint-ptyp process-connection-type) ; t if pty, nil if pipe.
;; Jump to the end, and set the process mark.
(goto-char (point-max))
@ -920,7 +915,7 @@ series of processes in the same Comint buffer. The hook
;; If the command has slashes, make sure we
;; first look relative to the current directory.
(cons default-directory exec-path) exec-path)))
(setq proc (apply 'start-file-process name buffer command switches)))
(setq proc (apply #'start-file-process name buffer command switches)))
;; Some file name handler cannot start a process, fe ange-ftp.
(unless (processp proc) (error "No process started"))
(let ((coding-systems (process-coding-system proc)))
@ -1167,7 +1162,7 @@ See also `comint-read-input-ring'."
(set-buffer history-buffer)
(let ((keymap (make-sparse-keymap)))
(set-keymap-parent keymap (current-local-map))
(define-key keymap "\C-m" 'comint-dynamic-list-input-ring-select)
(define-key keymap "\C-m" #'comint-dynamic-list-input-ring-select)
(use-local-map keymap))
(forward-line 3)
(while (search-backward "completion" nil 'move)
@ -1365,12 +1360,12 @@ If N is negative, search forwards for the -Nth following match."
(unless (memq last-command '(comint-previous-matching-input-from-input
comint-next-matching-input-from-input))
;; Starting a new search
(setq comint-matching-input-from-input-string
(buffer-substring
(or (marker-position comint-accum-marker)
(process-mark (get-buffer-process (current-buffer))))
(point))
comint-input-ring-index nil))
(setq-local comint-matching-input-from-input-string
(buffer-substring
(or (marker-position comint-accum-marker)
(process-mark (get-buffer-process (current-buffer))))
(point))
comint-input-ring-index nil))
(comint-previous-matching-input
(concat "^" (regexp-quote comint-matching-input-from-input-string))
n t)
@ -1499,7 +1494,7 @@ actual side-effect."
(let* ((mb1 (match-beginning 1)) (me1 (match-end 1))
(mb2 (match-beginning 2)) (me2 (match-end 2))
(exp (buffer-substring (or mb2 mb1) (or me2 me1)))
(pref (if (save-match-data (looking-at "!\\?")) "" "^"))
(pref (if (looking-at-p "!\\?") "" "^"))
(pos (save-match-data
(comint-previous-matching-input-string-position
(concat pref (regexp-quote exp)) 1))))
@ -1601,21 +1596,21 @@ Intended to be added to `isearch-mode-hook' in `comint-mode'."
(setq-local isearch-push-state-function
#'comint-history-isearch-push-state)
(setq-local isearch-lazy-count nil)
(add-hook 'isearch-mode-end-hook 'comint-history-isearch-end nil t)))
(add-hook 'isearch-mode-end-hook #'comint-history-isearch-end nil t)))
(defun comint-history-isearch-end ()
"Clean up the comint after terminating Isearch in comint."
(if comint-history-isearch-message-overlay
(delete-overlay comint-history-isearch-message-overlay))
(setq isearch-message-prefix-add nil)
(setq isearch-search-fun-function 'isearch-search-fun-default)
(setq isearch-search-fun-function #'isearch-search-fun-default)
(setq isearch-message-function nil)
(setq isearch-wrap-function nil)
(setq isearch-push-state-function nil)
;; Force isearch to not change mark.
(setq isearch-opoint (point))
(kill-local-variable 'isearch-lazy-count)
(remove-hook 'isearch-mode-end-hook 'comint-history-isearch-end t)
(remove-hook 'isearch-mode-end-hook #'comint-history-isearch-end t)
(unless isearch-suspended
(setq comint--force-history-isearch nil)))
@ -1732,9 +1727,9 @@ or to the last history element for a backward search."
;; When `comint-history-isearch-search' fails on reaching the
;; beginning/end of the history, wrap the search to the first/last
;; input history element.
(if isearch-forward
(comint-goto-input (1- (ring-length comint-input-ring)))
(comint-goto-input nil))
(comint-goto-input (if isearch-forward
(1- (ring-length comint-input-ring))
nil))
(goto-char (if isearch-forward (comint-line-beginning-position) (point-max))))
(defun comint-history-isearch-push-state ()
@ -2116,7 +2111,7 @@ either globally or locally.")
"If nil, Comint will interpret `carriage control' characters in output.
See `comint-carriage-motion' for details.")
(defvar comint-last-prompt nil
(defvar-local comint-last-prompt nil
"Markers pointing to the last prompt.
If non-nil, a cons cell containing markers. The car points to
the start, the cdr to the end of the last prompt recognized.")
@ -2789,14 +2784,15 @@ called this function are inserted into the buffer."
(if (> (point) (marker-position pmark))
(kill-region pmark (point)))))
(defun comint-delchar-or-maybe-eof (arg)
"Delete ARG characters forward or send an EOF to subprocess.
(defun comint-delchar-or-maybe-eof (&optional _arg)
"Behave like the global binding or send an EOF to subprocess.
Sends an EOF only if point is at the end of the buffer and there is no input."
(interactive "p" comint-mode)
(interactive nil comint-mode)
(let ((proc (get-buffer-process (current-buffer))))
(if (and (eobp) proc (= (point) (marker-position (process-mark proc))))
(comint-send-eof)
(delete-char arg))))
(let ((cmd (lookup-key global-map (this-command-keys))))
(call-interactively (or (command-remapping cmd) cmd))))))
(defun comint-send-eof ()
"Send an EOF to the current buffer's process."
@ -3360,7 +3356,7 @@ See `comint-word'."
(t (error "Unexpected case in comint--unquote&requote-argument!")))
(setq qpos (match-end 0)))
(funcall push (substring qstr qpos) (length qstr))
(list (mapconcat #'identity (nreverse ustrs) "")
(list (mapconcat #'identity (nreverse ustrs))
qupos #'comint-quote-filename)))
(defun comint--unquote-argument (str)
@ -3516,7 +3512,7 @@ specifying a common substring for adding the faces
`completions-first-difference' and `completions-common-part' to
the completions."
(let ((window (get-buffer-window "*Completions*" 0)))
(setq completions (sort completions 'string-lessp))
(setq completions (sort completions #'string-lessp))
(if (and (eq last-command this-command)
window (window-live-p window) (window-buffer window)
(buffer-name (window-buffer window))
@ -3811,7 +3807,7 @@ and does not normally need to be invoked by the end user or programmer."
;; Because the cleanup happens as a callback, it's not easy to guarantee
;; that it really occurs.
(defalias 'comint-redirect-remove-redirection 'comint-redirect-cleanup)
(defalias 'comint-redirect-remove-redirection #'comint-redirect-cleanup)
(defun comint-redirect-filter (orig-filter process input-string)
"Filter function which redirects output from PROCESS to a buffer or buffers.
@ -4013,11 +4009,13 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
(define-obsolete-variable-alias
'comint-osc-handlers 'ansi-osc-handlers "30.1")
(define-obsolete-function-alias
'comint-osc-directory-tracker 'ansi-osc-directory-tracker "30.1")
'comint-osc-directory-tracker #'ansi-osc-directory-tracker "30.1")
(define-obsolete-function-alias
'comint-osc-hyperlink-handler 'ansi-osc-hyperlink-handler "30.1")
(define-obsolete-function-alias
'comint-osc-hyperlink 'ansi-osc-hyperlink "30.1")
'comint-osc-hyperlink-handler #'ansi-osc-hyperlink-handler "30.1")
;; There's never been any `comint-osc-hyperlink' function (nor
;; is there a `ansi-osc-hyperlink')!
;;(define-obsolete-function-alias
;; 'comint-osc-hyperlink #'ansi-osc-hyperlink "30.1")
(define-obsolete-variable-alias
'comint-osc-hyperlink-map 'ansi-osc-hyperlink-map "30.1")

2
lisp/disp-table.el
View file

@ -177,7 +177,7 @@ Valid symbols are `truncation', `wrap', `escape', `control',
;;;###autoload
(defun standard-display-unicode-special-glyphs ()
"Display some glyps using Unicode characters.
"Display some glyphs using Unicode characters.
The glyphs being changed by this function are `vertical-border',
`box-vertical',`box-horizontal', `box-down-right', `box-down-left',
`box-up-right', `box-up-left',`box-double-vertical',

41
lisp/editorconfig.el
View file

@ -277,13 +277,13 @@ a list of settings in the form (VARIABLE . VALUE)."
:version "30.1"
:risky t)
(defcustom editorconfig-trim-whitespaces-mode nil
(defcustom editorconfig-trim-whitespaces-mode #'delete-trailing-whitespace-mode
"Buffer local minor-mode to use to trim trailing whitespaces.
If set, enable that mode when `trim_trailing_whitespace` is set to true.
Otherwise, use `delete-trailing-whitespace'."
:version "30.1"
:type 'symbol)
:type 'function)
(defvar-local editorconfig-properties-hash nil
"Hash object of EditorConfig properties that was enabled for current buffer.
@ -542,33 +542,17 @@ This function will revert buffer when the coding-system has been changed."
"Call `delete-trailing-whitespace' unless the buffer is read-only."
(unless buffer-read-only (delete-trailing-whitespace)))
;; Arrange for our (eval . (add-hook ...)) "local var" to be considered safe.
(defun editorconfig--add-hook-safe-p (exp)
(equal exp '(add-hook 'before-save-hook
#'editorconfig--delete-trailing-whitespace nil t)))
(let ((predicates (get 'add-hook 'safe-local-eval-function)))
(when (functionp predicates)
(setq predicates (list predicates)))
(unless (memq #'editorconfig--add-hook-safe-p predicates)
(put 'add-hook 'safe-local-eval-function #'editorconfig--add-hook-safe-p)))
(defun editorconfig--get-trailing-ws (props)
"Get vars to trim of trailing whitespace according to PROPS."
(pcase (gethash 'trim_trailing_whitespace props)
("true"
`((eval
. ,(if editorconfig-trim-whitespaces-mode
`(,editorconfig-trim-whitespaces-mode 1)
'(add-hook 'before-save-hook
#'editorconfig--delete-trailing-whitespace nil t)))))
("false"
;; Just do it right away rather than return a (VAR . VAL), which
;; would be probably more trouble than it's worth.
(when editorconfig-trim-whitespaces-mode
(funcall editorconfig-trim-whitespaces-mode 0))
(remove-hook 'before-save-hook
#'editorconfig--delete-trailing-whitespace t)
nil)))
(let ((fun (or editorconfig-trim-whitespaces-mode
#'delete-trailing-whitespace-mode)))
(pcase (gethash 'trim_trailing_whitespace props)
("true" `((eval . (,fun 1))))
("false"
;; Just do it right away rather than return a (VAR . VAL), which
;; would be probably more trouble than it's worth.
(funcall fun 0)
nil))))
(defun editorconfig--get-line-length (props)
"Get the max line length (`fill-column') to PROPS."
@ -725,7 +709,8 @@ Meant to be used on `auto-coding-functions'."
Meant to be used on `hack-dir-local-get-variables-functions'."
(when (stringp buffer-file-name)
(let* ((props (editorconfig-call-get-properties-function buffer-file-name))
(alist (editorconfig--get-local-variables props)))
(alist (if (< 0 (hash-table-count props))
(editorconfig--get-local-variables props))))
;; FIXME: If there's `/foo/.editorconfig', `/foo/bar/.dir-locals.el',
;; and `/foo/bar/baz/.editorconfig', it would be nice to return two
;; pairs here, so that hack-dir-local can give different priorities

176
lisp/elec-pair.el
View file

@ -1,4 +1,4 @@
;;; elec-pair.el --- Automatic parenthesis pairing -*- lexical-binding:t -*-
;;; elec-pair.el --- Automatically insert matching delimiters -*- lexical-binding:t -*-
;; Copyright (C) 2013-2025 Free Software Foundation, Inc.
@ -21,6 +21,11 @@
;;; Commentary:
;; This library provides a way to easily insert pairs of matching
;; delimiters (parentheses, braces, brackets, quotes, etc.) and
;; optionally preserve or override the balance of delimiters. It is
;; documented in the Emacs user manual node "(emacs) Matching".
;;; Code:
(require 'electric)
@ -59,15 +64,16 @@ defined in `electric-pair-text-syntax-table'."
(defcustom electric-pair-skip-self #'electric-pair-default-skip-self
"If non-nil, skip char instead of inserting a second closing paren.
When inserting a closing paren character right before the same character,
just skip that character instead, so that hitting ( followed by ) results
in \"()\" rather than \"())\".
When inserting a closing delimiter right before the same character, just
skip that character instead, so that, for example, consecutively
typing `(' and `)' results in \"()\" rather than \"())\".
This can be convenient for people who find it easier to hit ) than \\[forward-char].
This can be convenient for people who find it easier to type `)' than
\\[forward-char].
Can also be a function of one argument (the closer char just
inserted), in which case that function's return value is
considered instead."
Can also be a function of one argument (the closing delimiter just
inserted), in which case that function's return value is considered
instead."
:version "24.1"
:group 'electricity
:type '(choice
@ -80,9 +86,9 @@ considered instead."
#'electric-pair-default-inhibit
"Predicate to prevent insertion of a matching pair.
The function is called with a single char (the opening char just inserted).
If it returns non-nil, then `electric-pair-mode' will not insert a matching
closer."
The function is called with a single char (the opening delimiter just
inserted). If it returns non-nil, then `electric-pair-mode' will not
insert a matching closing delimiter."
:version "24.4"
:group 'electricity
:type '(choice
@ -92,22 +98,32 @@ closer."
function))
(defcustom electric-pair-preserve-balance t
"Non-nil if default pairing and skipping should help balance parentheses.
"Whether to keep matching delimiters balanced.
When non-nil, typing a delimiter inserts only this character if there is
a unpaired matching delimiter later (if the latter is a closing
delimiter) or earlier (if the latter is a opening delimiter) in the
buffer. When nil, inserting a delimiter disregards unpaired matching
delimiters.
The default values of `electric-pair-inhibit-predicate' and
`electric-pair-skip-self' check this variable before delegating to other
predicates responsible for making decisions on whether to pair/skip some
characters based on the actual state of the buffer's parentheses and
quotes."
Whether this variable takes effect depends on the variables
`electric-pair-inhibit-predicate' and `electric-pair-skip-self', which
check the value of this variable before delegating to other predicates
responsible for making decisions on whether to pair/skip some characters
based on the actual state of the buffer's delimiters. In addition, this
variable has no effect if there is an active region."
:version "24.4"
:group 'electricity
:type 'boolean)
(defcustom electric-pair-delete-adjacent-pairs t
"If non-nil, backspacing an open paren also deletes adjacent closer.
"Whether to automatically delete a matching delimiter.
If non-nil, then when an opening delimiter immediately precedes a
matching closing delimiter and point is between them, typing DEL (the
backspace key) deletes both delimiters. If nil, only the opening
delimiter is deleted.
Can also be a function of no arguments, in which case that function's
return value is considered instead."
The value of this variable can also be a function of no arguments, in
which case that function's return value is considered instead."
:version "24.4"
:group 'electricity
:type '(choice
@ -116,10 +132,14 @@ return value is considered instead."
function))
(defcustom electric-pair-open-newline-between-pairs t
"If non-nil, a newline between adjacent parentheses opens an extra one.
"Whether to insert an extra newline between matching delimiters.
If non-nil, then when an opening delimiter immediately precedes a
matching closing delimiter and point is between them, typing a newline
automatically inserts an extra newline after point. If nil, just one
newline is inserted before point.
Can also be a function of no arguments, in which case that function's
return value is considered instead."
The value of this variable can also be a function of no arguments, in
which case that function's return value is considered instead."
:version "24.4"
:group 'electricity
:type '(choice
@ -128,16 +148,19 @@ return value is considered instead."
function))
(defcustom electric-pair-skip-whitespace t
"If non-nil skip whitespace when skipping over closing parens.
"Whether typing a closing delimiter moves point over whitespace.
If non-nil and point is separated from a closing delimiter only by
whitespace, then typing a closing delimiter of the same type does not
insert that character but instead moves point to immediately after the
already present closing delimiter. If the value of this variable is set
tothe symbol `chomp', then the whitespace moved over is deleted. If the
value is nil, typing a closing delimiter simply inserts it at point.
The specific kind of whitespace skipped is given by the variable
`electric-pair-skip-whitespace-chars'.
The symbol `chomp' specifies that the skipped-over whitespace
should be deleted.
Can also be a function of no arguments, in which case that function's
return value is considered instead."
The value of this variable can also be a function of no arguments, in
which case that function's return value is considered instead."
:version "24.4"
:group 'electricity
:type '(choice
@ -157,16 +180,16 @@ return value is considered instead."
(defvar-local electric-pair-skip-whitespace-function
#'electric-pair--skip-whitespace
"Function to use to skip whitespace forward.
"Function to use to move point forward over whitespace.
Before attempting a skip, if `electric-pair-skip-whitespace' is
non-nil, this function is called. It move point to a new buffer
non-nil, this function is called. It moves point to a new buffer
position, presumably skipping only whitespace in between.")
(defun electric-pair-analyze-conversion (string)
"Notice that STRING has been deleted by an input method.
"Delete delimiters enclosing the STRING deleted by an input method.
If the last character of STRING is an electric pair character,
and the character after point is too, then delete that other
character."
character. Called by `analyze-text-conversion'."
(let* ((prev (aref string (1- (length string))))
(next (char-after))
(syntax-info (electric-pair-syntax-info prev))
@ -177,7 +200,8 @@ character."
(delete-char 1))))
(defun electric-pair--skip-whitespace ()
"Skip whitespace forward, not crossing comment or string boundaries."
"Move point forward over whitespace.
But do not move point if doing so crosses comment or string boundaries."
(let ((saved (point))
(string-or-comment (nth 8 (syntax-ppss))))
(skip-chars-forward (apply #'string electric-pair-skip-whitespace-chars))
@ -187,9 +211,9 @@ character."
(defvar electric-pair-text-syntax-table prog-mode-syntax-table
"Syntax table used when pairing inside comments and strings.
`electric-pair-mode' considers this syntax table only when point in inside
quotes or comments. If lookup fails here, `electric-pair-text-pairs' will
be considered.")
`electric-pair-mode' considers this syntax table only when point is
within text marked as a comment or enclosed within quotes. If lookup
fails here, `electric-pair-text-pairs' will be considered.")
(defun electric-pair-conservative-inhibit (char)
(or
@ -206,7 +230,7 @@ be considered.")
"Run BODY with appropriate syntax table active.
STRING-OR-COMMENT is the start position of the string/comment
in which we are, if applicable.
Uses the text-mode syntax table if within a string or a comment."
Uses the `text-mode' syntax table if within a string or a comment."
(declare (debug t) (indent 1))
`(electric-pair--with-syntax-1 ,string-or-comment (lambda () ,@body)))
@ -229,11 +253,11 @@ Uses the text-mode syntax table if within a string or a comment."
(defun electric-pair-syntax-info (command-event)
"Calculate a list (SYNTAX PAIR UNCONDITIONAL STRING-OR-COMMENT-START).
SYNTAX is COMMAND-EVENT's syntax character. PAIR is
COMMAND-EVENT's pair. UNCONDITIONAL indicates the variables
`electric-pair-pairs' or `electric-pair-text-pairs' were used to
lookup syntax. STRING-OR-COMMENT-START indicates that point is
inside a comment or string."
SYNTAX is COMMAND-EVENT's syntax character. PAIR is COMMAND-EVENT's
pair. UNCONDITIONAL indicates that the variables `electric-pair-pairs'
or `electric-pair-text-pairs' were used to look up syntax.
STRING-OR-COMMENT-START indicates that point is inside a comment or
string."
(let* ((pre-string-or-comment (or (bobp)
(nth 8 (save-excursion
(syntax-ppss (1- (point)))))))
@ -264,20 +288,20 @@ inside a comment or string."
(let ((last-command-event char)
(blink-matching-paren nil)
(electric-pair-mode nil)
;; When adding the "closer" delimiter, a job his function is
;; When adding a closing delimiter, a job this function is
;; frequently used for, we don't want to munch any extra
;; newlines above us. That would be the default behavior of
;; `electric-layout-mode', which potentially kicked in before
;; us to add these newlines, and is probably about to kick in
;; again after we add the closer.
;; `electric-layout-mode', which potentially kicked in before us
;; to add these newlines, and is probably about to kick in again
;; after we add the closer.
(electric-layout-allow-duplicate-newlines t))
(self-insert-command times)))
(defun electric-pair--syntax-ppss (&optional pos where)
"Like `syntax-ppss', but sometimes fallback to `parse-partial-sexp'.
"Like `syntax-ppss', but maybe fall back to `parse-partial-sexp'.
WHERE is a list defaulting to \\='(string comment) and indicates
when to fallback to `parse-partial-sexp'."
when to fall back to `parse-partial-sexp'."
(let* ((pos (or pos (point)))
(where (or where '(string comment)))
(quick-ppss (syntax-ppss pos))
@ -298,12 +322,12 @@ when to fallback to `parse-partial-sexp'."
(parse-partial-sexp (point-min) pos)
quick-ppss))))
;; Balancing means controlling pairing and skipping of parentheses
;; Balancing means controlling pairing and skipping of delimiters
;; so that, if possible, the buffer ends up at least as balanced as
;; before, if not more. The algorithm is slightly complex because
;; some situations like "()))" need pairing to occur at the end but
;; not at the beginning. Balancing should also happen independently
;; for different types of parentheses, so that having your {}'s
;; for different types of delimiter, so that having your {}'s
;; unbalanced doesn't keep `electric-pair-mode' from balancing your
;; ()'s and your []'s.
(defun electric-pair--balance-info (direction string-or-comment)
@ -322,7 +346,7 @@ If point is not enclosed by any lists, return ((t) . (t))."
(let* (innermost
outermost
(at-top-level-or-equivalent-fn
;; called when `scan-sexps' ran perfectly, when it found
;; Called when `scan-sexps' ran perfectly, when it found
;; a parenthesis pointing in the direction of travel.
;; Also when travel started inside a comment and exited it.
(lambda ()
@ -330,7 +354,7 @@ If point is not enclosed by any lists, return ((t) . (t))."
(unless innermost
(setq innermost (list t)))))
(ended-prematurely-fn
;; called when `scan-sexps' crashed against a parenthesis
;; Called when `scan-sexps' crashed against a parenthesis
;; pointing opposite the direction of travel. After
;; traversing that character, the idea is to travel one sexp
;; in the opposite direction looking for a matching
@ -381,7 +405,7 @@ If point is not enclosed by any lists, return ((t) . (t))."
(funcall at-top-level-or-equivalent-fn))
(scan-error
(cond ((or
;; some error happened and it is not of the "ended
;; Some error happened and it is not of the "ended
;; prematurely" kind...
(not (string-match "ends prematurely" (nth 1 err)))
;; ... or we were in a comment and just came out of
@ -390,7 +414,7 @@ If point is not enclosed by any lists, return ((t) . (t))."
(not (nth 8 (syntax-ppss)))))
(funcall at-top-level-or-equivalent-fn))
(t
;; exit the sexp
;; Exit the sexp.
(goto-char (nth 3 err))
(funcall ended-prematurely-fn)))))))
(cons innermost outermost)))
@ -440,7 +464,7 @@ strings."
(unwind-protect (progn ,@body) (goto-char ,point)))))
(defun electric-pair-inhibit-if-helps-balance (char)
"Return non-nil if auto-pairing of CHAR would hurt parentheses' balance.
"Return non-nil if auto-pairing of CHAR unbalances delimiters.
Works by first removing the character from the buffer, then doing
some list calculations, finally restoring the situation as if nothing
@ -471,7 +495,7 @@ happened."
(electric-pair--unbalanced-strings-p char)))))))))
(defun electric-pair-skip-if-helps-balance (char)
"Return non-nil if skipping CHAR would benefit parentheses' balance.
"Return non-nil if skipping CHAR preserves balance of delimiters.
Works by first removing the character from the buffer, then doing
some list calculations, finally restoring the situation as if nothing
happened."
@ -507,7 +531,10 @@ happened."
(electric-pair-conservative-inhibit char)))
(defun electric-pair-post-self-insert-function ()
"Member of `post-self-insert-hook'. Do main work for `electric-pair-mode'.
"Do main work for `electric-pair-mode'.
This function is added to `post-self-insert-hook' when
`electric-pair-mode' is enabled.
If the newly inserted character C has delimiter syntax, this
function may decide to insert additional paired delimiters, or
skip the insertion of the new character altogether by jumping
@ -567,14 +594,18 @@ The decision is taken by order of preference:
(if (functionp electric-pair-skip-self)
(electric-pair--save-literal-point-excursion
(goto-char pos)
(funcall electric-pair-skip-self last-command-event))
(funcall electric-pair-skip-self
last-command-event))
electric-pair-skip-self))
(save-excursion
(when (and (not (and unconditional
(eq syntax ?\")))
(setq skip-whitespace-info
(if (and (not (eq electric-pair-skip-whitespace 'chomp))
(functionp electric-pair-skip-whitespace))
(when (and
(not (and unconditional (eq syntax ?\")))
(setq skip-whitespace-info
(if (and
(not
(eq electric-pair-skip-whitespace
'chomp))
(functionp electric-pair-skip-whitespace))
(funcall electric-pair-skip-whitespace)
electric-pair-skip-whitespace)))
(funcall electric-pair-skip-whitespace-function))
@ -602,7 +633,8 @@ The decision is taken by order of preference:
(defun electric-pair-open-newline-between-pairs-psif ()
"Honor `electric-pair-open-newline-between-pairs'.
Member of `post-self-insert-hook' if `electric-pair-mode' is on."
This function is added to `post-self-insert-hook' when
`electric-pair-mode' is enabled."
(when (and (if (functionp electric-pair-open-newline-between-pairs)
(funcall electric-pair-open-newline-between-pairs)
electric-pair-open-newline-between-pairs)
@ -653,15 +685,15 @@ ARG and KILLP are passed directly to
;;;###autoload
(define-minor-mode electric-pair-mode
"Toggle automatic parens pairing (Electric Pair mode).
"Toggle automatic pairing of delimiters (Electric Pair mode).
Electric Pair mode is a global minor mode. When enabled, typing
an open parenthesis automatically inserts the corresponding
closing parenthesis, and vice versa. (Likewise for brackets, etc.).
If the region is active, the parentheses (brackets, etc.) are
inserted around the region instead.
Electric Pair mode is a global minor mode. When enabled, typing an
opening delimiter (parenthesis, bracket, etc.) automatically inserts the
corresponding closing delimiter. If the region is active, the
delimiters are inserted around the region instead.
To toggle the mode in a single buffer, use `electric-pair-local-mode'."
To toggle the mode only in the current buffer, use
`electric-pair-local-mode'."
:global t :group 'electricity
(if electric-pair-mode
(progn

9
lisp/emacs-lisp/cl-extra.el
View file

@ -1082,6 +1082,15 @@ TYPES is an internal argument."
;;;###autoload
(defun cl--derived-type-generalizers (type)
;; Make sure this derived type can be used without arguments.
(let ((expander (or (get type 'cl-deftype-handler)
(error "Type %S lacks cl-deftype-handler" type))))
;; Check that the type can be used without arguments.
(funcall expander)
;; Check that we have a precomputed predicate since that's what
;; `cl-types-of' uses.
(unless (get type 'cl-deftype-satisfies)
(error "Type %S lacks cl-deftype-satisfies" type)))
;; Add a new dispatch type to the dispatch list, then
;; synchronize with `cl--derived-type-list' so that both lists follow
;; the same type precedence order.

5
lisp/emacs-lisp/cl-lib.el
View file

@ -568,10 +568,7 @@ If ALIST is non-nil, the new pairs are prepended to it."
(declare-function cl--derived-type-generalizers "cl-extra" (type))
(cl-defmethod cl-generic-generalizers :extra "derived-types" (type)
"Support for dispatch on derived types, i.e. defined with `cl-deftype'."
(if (and (symbolp type) (cl-derived-type-class-p (cl--find-class type))
;; Make sure this derived type can be used without arguments.
(let ((expander (get type 'cl-deftype-handler)))
(and expander (with-demoted-errors "%S" (funcall expander)))))
(if (and (symbolp type) (cl-derived-type-class-p (cl--find-class type)))
(cl--derived-type-generalizers type)
(cl-call-next-method))))

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

@ -3817,38 +3817,40 @@ If PARENTS is non-nil, ARGLIST must be nil."
;; loaded before `cl-preloaded.el' is defined.
(put 'list 'cl-deftype-satisfies #'listp)
(static-if (not (fboundp 'cl--define-derived-type))
nil ;; Can't define them yet!
(cl-deftype natnum () (declare (parents integer)) '(satisfies natnump))
(cl-deftype character () (declare (parents fixnum natnum))
'(and fixnum natnum))
(cl-deftype base-char () (declare (parents character))
'(satisfies characterp))
(cl-deftype extended-char () (declare (parents character))
'(and character (not base-char)))
(cl-deftype keyword () (declare (parents symbol)) '(satisfies keywordp))
(cl-deftype command ()
;; FIXME: Can't use `function' as parent because of arrays as
;; keyboard macros, which are redundant since `kmacro.el'!!
;;(declare (parents function))
'(satisfies commandp))
;; Thanks to `eval-and-compile', `cl--define-derived-type' is needed
;; both at compile-time and at runtime, so we need to double-check.
(static-if (not (fboundp 'cl--define-derived-type)) nil
(when (fboundp 'cl--define-derived-type)
(cl-deftype natnum () (declare (parents integer)) '(satisfies natnump))
(cl-deftype character () (declare (parents fixnum natnum))
'(and fixnum natnum))
(cl-deftype base-char () (declare (parents character))
'(satisfies characterp))
(cl-deftype extended-char () (declare (parents character))
'(and character (not base-char)))
(cl-deftype keyword () (declare (parents symbol)) '(satisfies keywordp))
(cl-deftype command ()
;; FIXME: Can't use `function' as parent because of arrays as
;; keyboard macros, which are redundant since `kmacro.el'!!
;;(declare (parents function))
'(satisfies commandp))
(eval-when-compile
(defmacro cl--defnumtype (type base)
`(cl-deftype ,type (&optional min max)
(list 'and ',base
(if (memq min '(* nil)) t
(if (consp min)
`(satisfies . ,(lambda (val) (> val (car min))))
`(satisfies . ,(lambda (val) (>= val min)))))
(if (memq max '(* nil)) t
(if (consp max)
`(satisfies . ,(lambda (val) (< val (car max))))
`(satisfies . ,(lambda (val) (<= val max)))))))))
;;(cl--defnumtype integer ??)
;;(cl--defnumtype float ??)
;;(cl--defnumtype number ??)
(cl--defnumtype real number))
(eval-when-compile
(defmacro cl--defnumtype (type base)
`(cl-deftype ,type (&optional min max)
(list 'and ',base
(if (memq min '(* nil)) t
(if (consp min)
`(satisfies . ,(lambda (val) (> val (car min))))
`(satisfies . ,(lambda (val) (>= val min)))))
(if (memq max '(* nil)) t
(if (consp max)
`(satisfies . ,(lambda (val) (< val (car max))))
`(satisfies . ,(lambda (val) (<= val max)))))))))
;;(cl--defnumtype integer ??)
;;(cl--defnumtype float ??)
;;(cl--defnumtype number ??)
(cl--defnumtype real number)))
;; Additional functions that we can now define because we've defined
;; `cl-defsubst' and `cl-typep'.

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

@ -505,37 +505,29 @@ PARENTS is a list of types NAME is a subtype of, or nil."
;; "complement" another declaration of the same type,
;; so maybe we should turn this into a warning (and
;; not overwrite the `cl--find-class' in that case)?
(error "Type in another class: %S" (type-of class))))
(error "Type %S already in another class: %S" name (type-of class))))
;; Setup a type descriptor for NAME.
(setf (cl--find-class name)
(cl--derived-type-class-make name (function-documentation expander)
parents))
(cl--derived-type-class-make
name
(and (fboundp 'function-documentation) ;Bootstrap corner case.
(function-documentation expander))
parents))
(define-symbol-prop name 'cl-deftype-handler expander)
(when predicate
(define-symbol-prop name 'cl-deftype-satisfies predicate))
;; Record new type. The constructor of the class
;; `cl-type-class' already ensures that parent types must be
;; defined before their "child" types (i.e. already added to
;; the `cl--derived-type-list' for types defined with `cl-deftype').
;; So it is enough to simply push a new type at the beginning
;; of the list.
;; Redefinition is more complicated, because child types may
;; be in the list, so moving the type to the head can be
;; incorrect. The "cheap" solution is to leave the list
;; unchanged (and hope the redefinition doesn't change the
;; hierarchy too much).
;; Side note: Redefinitions introduce other problems as well
;; because the class object's `parents` slot contains
;; references to `cl--class` objects, so after a redefinition
;; via (setf (cl--find-class FOO) ...), the children's
;; `parents` slots point to the old class object. That's a
;; problem that affects all types and that we don't really try
;; to solve currently.
(or (memq name cl--derived-type-list)
;; Exclude types that can't be used without arguments.
;; They'd signal errors in `cl-types-of'!
(not predicate)
(push name cl--derived-type-list))))
(define-symbol-prop name 'cl-deftype-satisfies predicate)
;; If the type can be used without arguments, record it for
;; use by `cl-types-of'.
;; The order in `cl--derived-type-list' is important, but the
;; constructor of the class `cl-type-class' already ensures that
;; parent types must be defined before their "child" types
;; (i.e. already added to the `cl--derived-type-list' for types
;; defined with `cl-deftype'). So it is enough to simply push
;; a new type at the beginning of the list.
;; Redefinition is a can of worms anyway, so we don't try to be clever
;; in that case.
(or (memq name cl--derived-type-list)
(push name cl--derived-type-list)))))
;; Make sure functions defined with cl-defsubst can be inlined even in
;; packages which do not require CL. We don't put an autoload cookie

16
lisp/emacs-lisp/comp.el
View file

@ -3743,12 +3743,22 @@ variable \"NATIVE_DISABLED\" is set, only byte compile."
;;;###autoload
(defun native-compile-prune-cache ()
"Remove .eln files that aren't applicable to the current Emacs invocation."
"Remove *.eln files that aren't usable by the current Emacs build.
This command removes all the *.eln files in `native-comp-eln-load-path'
which are incompatible with the Emacs session in which you invoke this
command. This includes the *.eln files compiled by all the Emacs
sessions where `comp-native-version-dir' had a value different from the
current session.
Note that this command does not prune the *.eln files in the last
directory in `native-comp-eln-load-path', which holds *.eln files
compiled during the Emacs build process."
(interactive)
(unless (featurep 'native-compile)
(user-error "This Emacs isn't built with native-compile support"))
;; The last item in native-comp-eln-load-path is assumed to be a system
;; directory, so don't try to delete anything there (bug#59658).
;; The last directory in 'native-comp-eln-load-path' is assumed to be a
;; system directory, so don't try to delete anything there (bug#59658).
(dolist (dir (butlast native-comp-eln-load-path))
;; If a directory is non absolute it is assumed to be relative to
;; `invocation-directory'.

32
lisp/emacs-lisp/find-func.el
View file

@ -197,20 +197,9 @@ for completion."
:version "29.1"
:group 'find-function)
(defcustom find-function-mode-lower-precedence nil
"If non-nil, `find-function-mode' defines keys in the global map.
This is for compatibility with the historical behavior of
the old `find-function-setup-keys'."
:type 'boolean
:version "31.1"
:group 'find-function
:set (lambda (symbol value)
;; Toggle the mode off before changing this setting in order to
;; avoid getting into an inconsistent state.
(let ((already-on find-function-mode))
(when already-on (find-function-mode -1))
(set-default symbol value)
(when already-on (find-function-mode 1)))))
;; Compiler defvars. The variable will be defined later with
;; `defcustom' when everything used in the :set functions is defined.
(defvar find-function-mode-lower-precedence)
;;; Functions:
@ -891,6 +880,21 @@ See `find-function-on-key'."
(find-function-mode 1))
(make-obsolete 'find-function-setup-keys 'find-function-mode "31.1")
;; Custom variables with :set requires everything be defined
(defcustom find-function-mode-lower-precedence nil
"If non-nil, `find-function-mode' defines keys in the global map.
This is for compatibility with the historical behavior of
the old `find-function-setup-keys'."
:type 'boolean
:version "31.1"
:set (lambda (symbol value)
;; Toggle the mode off before changing this setting in order to
;; avoid getting into an inconsistent state.
(let ((already-on find-function-mode))
(when already-on (find-function-mode -1))
(set-default symbol value)
(when already-on (find-function-mode 1)))))
(provide 'find-func)
;;; find-func.el ends here

18
lisp/find-lisp.el
View file

@ -304,14 +304,16 @@ FILE is a file or a directory name.
This function heeds `dired-actual-switches'."
(set-buffer buffer)
(insert find-lisp-line-indent
(find-lisp-format
(propertize file 'dired-filename t)
(file-attributes file 'string)
(or (and dired-actual-switches
(split-string-and-unquote dired-actual-switches))
(list ""))
nil)))
(let ((pt (point)))
(insert find-lisp-line-indent
(find-lisp-format
(propertize file 'dired-filename t)
(file-attributes file 'string)
(or (and dired-actual-switches
(split-string-and-unquote dired-actual-switches))
(list ""))
nil))
(dired-insert-set-properties pt (point))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Lifted from ls-lisp. We don't want to require it, because that

84
lisp/frame.el
View file

@ -1226,10 +1226,11 @@ recently selected windows nor the buffer list."
(set-mouse-position frame (1- (frame-width frame)) 0))))
(defun other-frame (arg)
"Select the ARGth different visible frame on current display, and raise it.
All frames are arranged in a cyclic order.
This command selects the frame ARG steps away in that order.
A negative ARG moves in the opposite order.
"Select the ARGth visible frame on current display, and raise it.
All frames are arranged in a cyclic order. This command selects the
frame ARG steps away from the selected frame in that order. A negative
ARG moves in the opposite order. It does not select a minibuffer-only
frame.
To make this command work properly, you must tell Emacs how the
system (or the window manager) generally handles focus-switching
@ -1291,18 +1292,38 @@ Calls `suspend-emacs' if invoked from the controlling tty device,
(suspend-tty)))
(t (suspend-emacs))))
(defun make-frame-names-alist ()
;; Only consider the frames on the same display.
(let* ((current-frame (selected-frame))
(falist
(cons
(cons (frame-parameter current-frame 'name) current-frame) nil))
(frame (next-frame nil 0)))
(while (not (eq frame current-frame))
(progn
(push (cons (frame-parameter frame 'name) frame) falist)
(setq frame (next-frame frame 0))))
falist))
(defun frame-list-1 (&optional frame)
"Return list of all live frames starting with FRAME.
The optional argument FRAME must specify a live frame and defaults to
the selected frame. Tooltip frames are not included."
(let* ((frame (window-normalize-frame frame))
(frames (frame-list)))
(unless (eq (car frames) frame)
(let ((tail frames))
(while tail
(if (eq (cadr tail) frame)
(let ((head (cdr tail)))
(setcdr tail nil)
(setq frames (nconc head frames))
(setq tail nil))
(setq tail (cdr tail))))))
frames))
(defun make-frame-names-alist (&optional frame)
"Return alist of frame names and frames starting with FRAME.
Only visible or iconified frames on the same terminal as FRAME are
listed. Frames with a non-nil `no-other-frame' parameter are not
listed. The optional argument FRAME must specify a live frame and
defaults to the selected frame."
(let ((frames (frame-list-1 frame))
(terminal (frame-parameter frame 'terminal))
alist)
(dolist (frame frames)
(when (and (frame-visible-p frame)
(eq (frame-parameter frame 'terminal) terminal)
(not (frame-parameter frame 'no-other-frame)))
(push (cons (frame-parameter frame 'name) frame) alist)))
(nreverse alist)))
(defvar frame-name-history nil)
(defun select-frame-by-name (name)
@ -2816,32 +2837,29 @@ deleting them."
(interactive "i\nP")
(setq frame (window-normalize-frame frame))
(let ((minibuffer-frame (window-frame (minibuffer-window frame)))
(this (next-frame frame t))
(parent (frame-parent frame))
next)
(frames (frame-list)))
;; In a first round consider minibuffer-less frames only.
(while (not (eq this frame))
(setq next (next-frame this t))
(unless (or (eq (window-frame (minibuffer-window this)) this)
(dolist (this frames)
(unless (or (eq this frame)
(eq this minibuffer-frame)
(eq (window-frame (minibuffer-window this)) this)
;; When FRAME is a child frame, delete its siblings
;; only.
(and parent (not (eq (frame-parent this) parent)))
;; Do not delete a child frame of FRAME.
(eq (frame-parent this) frame))
(if iconify (iconify-frame this) (delete-frame this)))
(setq this next))
;; Do not delete frame descending from FRAME.
(frame-ancestor-p frame this))
(if iconify (iconify-frame this) (delete-frame this))))
;; In a second round consider all remaining frames.
(setq this (next-frame frame t))
(while (not (eq this frame))
(setq next (next-frame this t))
(unless (or (eq this minibuffer-frame)
(dolist (this frames)
(unless (or (eq this frame)
(eq this minibuffer-frame)
;; When FRAME is a child frame, delete its siblings
;; only.
(and parent (not (eq (frame-parent this) parent)))
;; Do not delete a child frame of FRAME.
(eq (frame-parent this) frame))
(if iconify (iconify-frame this) (delete-frame this)))
(setq this next))))
;; Do not delete frame descending from FRAME.
(frame-ancestor-p frame this))
(if iconify (iconify-frame this) (delete-frame this))))))
(defvar undelete-frame--deleted-frames nil
"Internal variable used by `undelete-frame--save-deleted-frame'.")

4
lisp/gnus/mail-source.el
View file

@ -201,8 +201,8 @@ Leave mails for this many days" :value 14)))))
(string :tag "Program"))
(group :inline t
(const :format ""
:value :authenticator)
(choice :tag "Authenticator"
:value :authentication)
(choice :tag "Authentication"
:value login
,@mail-source-imap-authenticators))
(group :inline t

9
lisp/help-fns.el
View file

@ -624,8 +624,15 @@ the C sources, too."
(let ((start (point)))
(help-fns--insert-menu-bindings
menus
(concat "It can " (and keys "also ")
(concat "It " (if remapped "could " "can ") (and keys "also ")
"be invoked from the menu: "))
(when remapped
(princ ", but that was remapped to ")
(princ (if (symbolp remapped)
(format-message "`%s'" remapped)
"an anonymous command"))
(princ "as well.\n"))
(or remapped (princ "."))
(fill-region-as-paragraph start (point))))
(ensure-empty-lines)))))))

9
lisp/help.el
View file

@ -305,6 +305,8 @@ specifies what to do when the user exits the help buffer.
Do not call this in the scope of `with-help-window'."
(and (not (get-buffer-window standard-output))
;; FIXME: Call this code *after* we display the buffer, so we can
;; detect reliably whether it's been put in its own frame or what.
(let ((first-message
(cond ((or
pop-up-frames
@ -331,7 +333,7 @@ Do not call this in the scope of `with-help-window'."
(list (selected-window) (window-buffer)
(window-start) (window-point)))
"Type \\[switch-to-buffer] RET to remove help window."))))
(funcall (or function 'message)
(funcall (or function #'message)
(concat
(if first-message
(substitute-command-keys first-message))
@ -1396,10 +1398,10 @@ Otherwise, return a new string."
;; overriding-local-map, or from a \\<mapname> construct in STRING
;; itself.
(let ((keymap overriding-local-map)
(inhibit-modification-hooks t)
(inhibit-read-only t)
(orig-buf (current-buffer)))
(with-temp-buffer
(setq-local inhibit-modification-hooks t) ;; For speed.
(insert string)
(goto-char (point-min))
(while (< (point) (point-max))
@ -2170,8 +2172,7 @@ The `temp-buffer-window-setup-hook' hook is called."
buffer-file-name nil)
(setq-local help-mode--current-data nil)
(buffer-disable-undo)
(let ((inhibit-read-only t)
(inhibit-modification-hooks t))
(let ((inhibit-read-only t))
(erase-buffer)
(delete-all-overlays)
(prog1

19
lisp/ls-lisp.el
View file

@ -208,10 +208,15 @@ Otherwise they are treated as Emacs regexps (for backward compatibility)."
'("%b %e %H:%M"
"%b %e %Y")
"List of `format-time-string' specs to display file time stamps.
These specs are used ONLY if a valid locale can not be determined.
These specs are used ONLY if a valid locale can not be determined,
or if the locale is \"C\" or \"POSIX\". If a valid non-\"C\" locale
can be determined, file time stamps are displayed using hardcoded
formats \"%m-%d %H:%M\" for new files and \"%Y-%m-%d\" for old files.
If `ls-lisp-use-localized-time-format' is non-nil, these specs are used
regardless of whether the locale can be determined.
If `ls-lisp-use-localized-time-format' is non-nil, the specs specified
by this option are used regardless of whether the locale can be determined.
The locale is determined by `ls-lisp-format-time', which see.
Syntax: (EARLY-TIME-FORMAT OLD-TIME-FORMAT)
@ -228,7 +233,7 @@ current year. The OLD-TIME-FORMAT is used for older files. To use ISO
(defcustom ls-lisp-use-localized-time-format nil
"Non-nil means to always use `ls-lisp-format-time-list' for time stamps.
This applies even if a valid locale is specified.
This applies even if a valid locale is determined by `ls-lisp-format-time'.
WARNING: Using localized date/time format might cause Dired columns
to fail to line up, e.g. if month names are not all of the same length."
@ -827,7 +832,11 @@ Return nil if no time switch found."
"Format time for file with attributes FILE-ATTR according to TIME-INDEX.
Use the same method as ls to decide whether to show time-of-day or year,
depending on distance between file date and the current time.
All ls time options, namely c, t and u, are handled."
All ls time options, namely c, t and u, are handled.
This function determines as side effect the locale relevant for
displaying times, by using `system-time-locale' if non-nil, and
falling back to environment variables LC_ALL, LC_TIME, and LANG."
(let* ((time (nth (or time-index 5) file-attr)) ; default is last modtime
(diff (time-subtract time nil))
;; Consider a time to be recent if it is within the past six

2
lisp/mh-e/mh-e.el
View file

@ -26,6 +26,8 @@
;; MH-E is an Emacs interface to the MH mail system.
;; To learn about MH-E, read The MH-E Manual at info node '(mh-e)'.
;; MH-E is compatible with MH versions 6.8.4 and higher, all versions
;; of nmh, and GNU mailutils 1.0 and higher.

28
lisp/minibuffer.el
View file

@ -3536,6 +3536,16 @@ except that it passes the file name through `substitute-in-file-name'."
(if (eq (car-safe action) 'boundaries)
(cons 'boundaries (completion--sifn-boundaries orig table pred (cdr action)))
(let* ((sifned (substitute-in-file-name orig))
(orig-start (car (completion--sifn-boundaries orig table pred "")))
(sifned-start (car (completion-boundaries sifned table pred "")))
(orig-in-bounds (substring orig orig-start))
(sifned-in-bounds (substring sifned sifned-start))
(only-need-double-dollars
;; If true, sifn only un-doubled $s in ORIG, so we can fix a
;; completion to match ORIG by just doubling $s again. This
;; preserves more text from the completion, behaving better with
;; non-nil `completion-ignore-case'.
(string-equal orig-in-bounds (minibuffer--double-dollars sifned-in-bounds)))
(result
(let ((completion-regexp-list
;; Regexps are matched against the real file names after
@ -3550,21 +3560,21 @@ except that it passes the file name through `substitute-in-file-name'."
(if (stringp result)
;; Extract the newly added text, quote any dollar signs, and
;; append it to ORIG.
(let ((new-text (substring result (length sifned))))
(concat orig (minibuffer--double-dollars new-text)))
(if only-need-double-dollars
(concat (substring orig nil orig-start)
(minibuffer--double-dollars (substring result sifned-start)))
(let ((new-text (substring result (length sifned))))
(concat orig (minibuffer--double-dollars new-text))))
result))
((eq action t) ; all-completions
(mapcar
(let ((orig-prefix
(substring orig (car (completion--sifn-boundaries orig table pred ""))))
(sifned-prefix-length
(- (length sifned)
(car (completion-boundaries sifned table pred "")))))
(if only-need-double-dollars
#'minibuffer--double-dollars
;; Extract the newly added text, quote any dollar signs, and append
;; it to the part of ORIG inside the completion boundaries.
(lambda (compl)
(let ((new-text (substring compl sifned-prefix-length)))
(concat orig-prefix (minibuffer--double-dollars new-text)))))
(let ((new-text (substring compl (length sifned-in-bounds))))
(concat orig-in-bounds (minibuffer--double-dollars new-text)))))
result))
(t result))))))

3
lisp/net/browse-url.el
View file

@ -713,8 +713,7 @@ This function returns a list (URL NEW-WINDOW-FLAG) for use in
`interactive'. NEW-WINDOW-FLAG is the prefix arg; if
`browse-url-new-window-flag' is non-nil, invert the prefix arg
instead."
(let ((event (elt (this-command-keys) 0)))
(mouse-set-point event))
(mouse-set-point last-nonmenu-event)
(list (read-string prompt (or (and transient-mark-mode mark-active
;; rfc2396 Appendix E.
(replace-regexp-in-string

191
lisp/net/eww.el
View file

@ -35,6 +35,7 @@
(require 'url-file)
(require 'vtable)
(require 'xdg)
(require 'track-changes)
(eval-when-compile (require 'subr-x))
(defgroup eww nil
@ -49,7 +50,6 @@
- %t is replaced by the title.
- %u is replaced by the URL."
:version "24.4"
:group 'eww
:type 'string)
(defcustom eww-search-confirm-send-region t
@ -60,13 +60,11 @@ default to mitigate the risk of accidental data leak. Set this
variable to nil to send the region to the search engine
straight away."
:version "31.1"
:group 'eww
:type 'boolean)
(defcustom eww-search-prefix "https://duckduckgo.com/html/?q="
"Prefix URL to search engine."
:version "24.4"
:group 'eww
:type 'string)
(defcustom eww-use-browse-url "\\`mailto:"
@ -80,7 +78,6 @@ The action to be taken can be further customized via
"Default directory where `eww' saves downloaded files.
Used by `eww--download-directory', which see."
:version "29.1"
:group 'eww
:type 'directory)
(defun eww--download-directory ()
@ -99,7 +96,6 @@ is defined, use the latter instead."
This should either be a directory name or a function (called with
no parameters) that returns a directory name."
:version "28.1"
:group 'eww
:type '(choice directory function))
;;;###autoload
@ -113,7 +109,6 @@ Each of the elements is a function returning either a string or a list
of strings. The results will be joined into a single list with
duplicate entries (if any) removed."
:version "30.1"
:group 'eww
:type 'hook
:options '(eww-links-at-point
thing-at-point-url-at-point
@ -131,13 +126,11 @@ complete response of the server from which the page was requested.
If the list of the functions is exhausted without any non-nil value,
EWW assumes content-type is \"application/octet-stream\", per RFC-9110."
:version "31.1"
:group 'eww
:type '(repeat function))
(defcustom eww-bookmarks-directory user-emacs-directory
"Directory where bookmark files will be stored."
:version "25.1"
:group 'eww
:type 'directory)
(defcustom eww-desktop-remove-duplicates t
@ -146,7 +139,6 @@ If non-nil, repetitive EWW history entries (comprising of the URI, the
title, and the point position) will not be saved as part of the Emacs
desktop. Otherwise, such entries will be retained."
:version "25.1"
:group 'eww
:type 'boolean)
(defcustom eww-restore-desktop nil
@ -156,7 +148,6 @@ If nil, buffers will require manual reload, and will contain the text
specified in `eww-restore-reload-prompt' instead of the actual Web
page contents."
:version "25.1"
:group 'eww
:type '(choice (const :tag "Restore all automatically" t)
(const :tag "Require manual reload" nil)))
@ -167,13 +158,11 @@ This prompt will be used if `eww-restore-desktop' is nil.
The string will be passed through `substitute-command-keys'."
:version "25.1"
:group 'eww
:type 'string)
(defcustom eww-history-limit 50
"Maximum number of entries to retain in the history."
:version "25.1"
:group 'eww
:type '(choice (const :tag "Unlimited" nil)
integer))
@ -192,7 +181,6 @@ the first item is the program, and the rest are the arguments."
"\\`\\(video/\\|audio/\\|application/ogg\\)"
"Always use external browser for specified content-type."
:version "24.4"
:group 'eww
:type '(choice (const :tag "Never" nil)
regexp))
@ -203,7 +191,6 @@ If t, then open the URL in a new tab rather than a new buffer if
If `tab-bar', then open the URL in a new tab only when
the tab bar is enabled."
:version "27.1"
:group 'eww
:type '(choice (const :tag "Always open URL in new tab" t)
(const :tag "Open new tab when tab bar is enabled" tab-bar)
(const :tag "Never open URL in new tab" nil)))
@ -226,7 +213,6 @@ EWW provides the following values for this option:
You can also set this to any other function you wish."
:version "30.1"
:group 'eww
:type '(choice (function-item :tag "Delete future history"
eww-delete-future-history)
(function-item :tag "Clone previous history"
@ -238,7 +224,6 @@ You can also set this to any other function you wish."
(defcustom eww-after-render-hook nil
"A hook called after eww has finished rendering the buffer."
:version "25.1"
:group 'eww
:type 'hook)
(defcustom eww-auto-rename-buffer nil
@ -266,20 +251,17 @@ of `eww-buffer-name-length'."
(const :tag "Do not rename buffers (default)" nil)
(const :tag "Rename buffer to web page title" title)
(const :tag "Rename buffer to web page URL" url)
(function :tag "A user-defined function to rename the buffer"))
:group 'eww)
(function :tag "A user-defined function to rename the buffer")))
(defcustom eww-buffer-name-length 40
"Length of renamed buffer name, per `eww-auto-rename-buffer'."
:type 'natnum
:version "29.1"
:group 'eww)
:version "29.1")
(defcustom eww-form-checkbox-selected-symbol "[X]"
"Symbol used to represent a selected checkbox.
See also `eww-form-checkbox-symbol'."
:version "24.4"
:group 'eww
:type '(choice (const "[X]")
(const "☒") ; Unicode BALLOT BOX WITH X
(const "☑") ; Unicode BALLOT BOX WITH CHECK
@ -289,7 +271,6 @@ See also `eww-form-checkbox-symbol'."
"Symbol used to represent a checkbox.
See also `eww-form-checkbox-selected-symbol'."
:version "24.4"
:group 'eww
:type '(choice (const "[ ]")
(const "☐") ; Unicode BALLOT BOX
string))
@ -327,62 +308,54 @@ by default."
:box (:line-width 2 :style released-button)
:background "#808080" :foreground "black"))
"Face for eww buffer buttons."
:version "24.4"
:group 'eww)
:version "24.4")
(defface eww-form-file
'((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "#808080" :foreground "black"))
"Face for eww buffer buttons."
:version "25.1"
:group 'eww)
:version "25.1")
(defface eww-form-checkbox
'((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
"Face for eww buffer buttons."
:version "24.4"
:group 'eww)
:version "24.4")
(defface eww-form-select
'((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
"Face for eww buffer buttons."
:version "24.4"
:group 'eww)
:version "24.4")
(defface eww-form-text
'((t :background "#505050"
:foreground "white"
:box (:line-width 1)))
"Face for eww text inputs."
:version "24.4"
:group 'eww)
:version "24.4")
(defface eww-form-textarea
'((t :background "#C0C0C0"
:foreground "black"
:box (:line-width 1)))
"Face for eww textarea inputs."
:version "24.4"
:group 'eww)
:version "24.4")
(defface eww-invalid-certificate
'((default :weight bold)
(((class color)) :foreground "red"))
"Face for web pages with invalid certificates."
:version "25.1"
:group 'eww)
:version "25.1")
(defface eww-valid-certificate
'((default :weight bold)
(((class color)) :foreground "ForestGreen"))
"Face for web pages with valid certificates."
:version "25.1"
:group 'eww)
:version "25.1")
(defvar eww-data nil)
(defvar eww-history nil)
@ -811,9 +784,11 @@ Use CODING-SYSTEM to decode the region; if nil, decode as UTF-8.
This replaces the region with the preprocessed HTML."
(setq coding-system (or coding-system 'utf-8))
(with-restriction start end
(condition-case nil
(decode-coding-region (point-min) (point-max) coding-system)
(coding-system-error nil))
(unless (and (not enable-multibyte-characters)
(eq coding-system 'utf-8))
(condition-case nil
(decode-coding-region (point-min) (point-max) coding-system)
(coding-system-error nil)))
;; Remove CRLF and replace NUL with &#0; before parsing.
(while (re-search-forward "\\(\r$\\)\\|\0" nil t)
(replace-match (if (match-beginning 1) "" "&#0;") t t))
@ -840,7 +815,6 @@ This replaces the region with the preprocessed HTML."
(setq bidi-paragraph-direction nil)
(plist-put eww-data :dom document)
(let ((inhibit-read-only t)
(inhibit-modification-hooks t)
;; Possibly set by the caller, e.g., `eww-render' which
;; preserves the old URL #target before chasing redirects.
(shr-target-id (or shr-target-id
@ -876,6 +850,10 @@ This replaces the region with the preprocessed HTML."
(while (and (not (eobp))
(get-text-property (point) 'eww-form))
(forward-line 1)))))
;; We used to enable this in `eww-mode', but it cause tracking
;; of changes while we insert the document, whereas we only care about
;; changes performed afterwards.
(track-changes-register #'eww--track-changes :nobefore t)
(eww-size-text-inputs))))
(defun eww-display-html (charset url &optional document point buffer)
@ -1058,7 +1036,7 @@ This replaces the region with the preprocessed HTML."
(erase-buffer)
(insert data)
(condition-case nil
(decode-coding-region (point-min) (1+ (length data)) encode)
(decode-coding-region (point-min) (point) encode)
(coding-system-error nil)))
(goto-char (point-min)))))
@ -1378,14 +1356,11 @@ within text input fields."
;; Autoload cookie needed by desktop.el.
;;;###autoload
(define-derived-mode eww-mode special-mode "eww"
"Mode for browsing the web.
\\{eww-mode-map}"
"Mode for browsing the web."
:interactive nil
(setq-local eww-data (list :title ""))
(setq-local browse-url-browser-function #'eww-browse-url)
(add-hook 'after-change-functions #'eww-process-text-input nil t)
(add-hook 'context-menu-functions 'eww-context-menu 5 t)
(add-hook 'context-menu-functions #'eww-context-menu 5 t)
(setq-local eww-history nil)
(setq-local eww-history-position 0)
(when (boundp 'tool-bar-map)
@ -1410,7 +1385,7 @@ within text input fields."
(setq-local shr-url-transformer #'eww--transform-url)
;; Also rescale images when rescaling the text.
(add-hook 'text-scale-mode-hook #'eww--rescale-images nil t)
(setq-local outline-search-function 'shr-outline-search
(setq-local outline-search-function #'shr-outline-search
outline-level 'shr-outline-level)
(add-hook 'post-command-hook #'eww-check-text-conversion nil t)
(setq buffer-read-only t)
@ -1513,7 +1488,6 @@ instead of `browse-url-new-window-flag'."
(defun eww-restore-history (elem)
(let ((inhibit-read-only t)
(inhibit-modification-hooks t)
(text (plist-get elem :text)))
(setq eww-data elem)
(if (null text)
@ -1784,16 +1758,34 @@ Interactively, EVENT is the value of `last-nonmenu-event'."
"List of input types which represent a text input.
See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-process-text-input (beg end replace-length)
(when-let* ((pos (field-beginning (point))))
(let* ((form (get-text-property pos 'eww-form))
(properties (text-properties-at pos))
(defun eww--track-changes (tracker-id)
(track-changes-fetch
tracker-id
(lambda (beg end len)
(eww--process-text-input beg end len)
;; Disregard our own changes.
(track-changes-fetch tracker-id #'ignore))))
(defun eww--process-text-input (beg end replace-length)
(when-let* ((_ (integerp replace-length))
(pos end)
(form (or (get-text-property pos 'eww-form)
(progn
(setq pos (max (point-min) (1- beg)))
(get-text-property pos 'eww-form)))))
(let* ((properties (text-properties-at pos))
(buffer-undo-list t)
(inhibit-read-only t)
(length (- end beg replace-length))
(type (plist-get form :type)))
(when (and form
(member type eww-text-input-types))
(when (member type eww-text-input-types)
;; Make sure the new text has the right properties, which also
;; integrates the new text into the "current field".
(set-text-properties beg end properties)
;; FIXME: This tries to preserve the "length" of the input field,
;; but we should try to preserve the *width* instead.
;; FIXME: Maybe instead of inserting/deleting spaces, we should
;; have a single stretch-space character at the end.
(cond
((> length 0)
;; Delete some space at the end.
@ -1809,18 +1801,21 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
((< length 0)
;; Add padding.
(save-excursion
(goto-char end)
(goto-char
(if (equal type "textarea")
(1- (line-end-position))
(1+ (eww-end-of-field))))
(let ((start (point)))
(insert (make-string (abs length) ? ))
(set-text-properties start (point) properties))
(goto-char (1- end)))))
(set-text-properties (cdr (assq :start form))
(cdr (assq :end form))
properties)
(goto-char pos)
(let* ((field-length (- (eww-end-of-field)
(eww-beginning-of-field)))
(ideal-length (cdr (assq :length form))))
;; FIXME: This test isn't right for multiline fields.
(when (or (null ideal-length) (> ideal-length field-length))
(goto-char
(if (equal type "textarea")
(1- (line-end-position))
(1+ (eww-end-of-field))))
(let ((start (point)))
(insert (make-string (min (abs length)
(- ideal-length field-length))
? ))
(set-text-properties start (point) properties)))))))
(let ((value (buffer-substring-no-properties
(eww-beginning-of-field)
(eww-end-of-field))))
@ -2042,11 +2037,11 @@ Interactively, EVENT is the value of `last-nonmenu-event'."
(< start (point-max)))
(when (or (get-text-property start 'eww-form)
(setq start (next-single-property-change start 'eww-form)))
(let ((props (get-text-property start 'eww-form)))
(nconc props (list (cons :start start)))
(let ((props (get-text-property start 'eww-form))
(beg start))
(setq start (next-single-property-change
start 'eww-form nil (point-max)))
(nconc props (list (cons :end start))))))))
(nconc props (list (cons :length (- start beg)))))))))
(defun eww-input-value (input)
(let ((type (plist-get input :type))
@ -2320,26 +2315,32 @@ If CHARSET is nil then use UTF-8."
(eww-reload nil 'utf-8)
(eww-reload nil charset)))
(defun eww--buffer-p (buf)
(provided-mode-derived-p (buffer-local-value 'major-mode buf)
'eww-mode))
(defun eww-switch-to-buffer ()
"Prompt for an EWW buffer to display in the selected window."
"Prompt for an EWW buffer to display in the selected window.
If no such buffer exist, fallback to calling `eww'."
(interactive nil eww-mode)
(let ((completion-extra-properties
`(:annotation-function
,(lambda (buf)
(with-current-buffer buf
(format " %s" (eww-current-url))))))
(curbuf (current-buffer)))
(pop-to-buffer-same-window
(read-buffer "Switch to EWW buffer: "
(cl-loop for buf in (nreverse (buffer-list))
if (with-current-buffer buf (derived-mode-p 'eww-mode))
return buf)
t
(lambda (bufn)
(setq bufn (if (consp bufn) (cdr bufn) (get-buffer bufn)))
(and (with-current-buffer bufn
(derived-mode-p 'eww-mode))
(not (eq bufn curbuf))))))))
(let ((list (cl-loop for buf in (nreverse (buffer-list))
if (and (eww--buffer-p buf)
(not (eq buf (current-buffer))))
collect (buffer-name buf))))
(if list
(pop-to-buffer-same-window
(if (length= list 1)
(car list)
(completing-read "Switch to EWW buffer: "
(completion-table-with-metadata
list
`((category . buffer)
(annotation-function
. ,(lambda (buf)
(with-current-buffer buf
(format " %s" (eww-current-url)))))))
nil t)))
(call-interactively #'eww))))
(defun eww-toggle-fonts ()
"Toggle whether to use monospaced or font-enabled layouts."
@ -2713,15 +2714,17 @@ see)."
(defun eww-buffer-list ()
"Return a list of all live eww buffers."
(match-buffers '(derived-mode . eww-mode)))
(match-buffers #'eww--buffer-p))
(defun eww-list-buffers ()
"Pop a buffer with a list of eww buffers."
(interactive)
(with-current-buffer (get-buffer-create "*eww buffers*")
(eww-buffers-mode)
(eww--list-buffers-display-table))
(pop-to-buffer "*eww buffers*"))
(if (null (eww-buffer-list))
(message "No EWW buffers.")
(with-current-buffer (get-buffer-create "*eww buffers*")
(eww-buffers-mode)
(eww--list-buffers-display-table))
(pop-to-buffer "*eww buffers*")))
(defun eww--list-buffers-display-table (&optional _ignore-auto _noconfirm)
"Display a table with the list of eww buffers.

3
lisp/net/network-stream.el
View file

@ -249,7 +249,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(ignore-errors
(car (auth-source-search :max 1
:host host
:port (format "%s" service)))))
:port (format "%s" service)
:require '(:key :cert)))))
(key (plist-get auth-info :key))
(cert (plist-get auth-info :cert)))
(and key cert (file-readable-p key) (file-readable-p cert)

7
lisp/net/tramp-sh.el
View file

@ -3117,7 +3117,9 @@ will be used."
(let ((pid (tramp-send-command-and-read v "echo $$")))
(setq p (tramp-get-connection-process v))
(process-put p 'remote-pid pid))
(when (memq connection-type '(nil pipe))
(when
(or (memq connection-type '(nil pipe))
(tramp-check-remote-uname v tramp-sunos-unames))
;; Disable carriage return to newline
;; translation. This does not work on
;; macOS, see Bug#50748.
@ -3133,6 +3135,9 @@ will be used."
;; should set a timeout
;; instead. See `tramp-pipe-stty-settings'.
;; (Bug#62093)
;; On Solaris, the maximum line length
;; depends also on MAX_CANON (256). So we
;; disable buffering as well.
;; FIXME: Shall we rather use "stty raw"?
(tramp-send-command
v (format

2
lisp/nxml/nxml-mode.el
View file

@ -1523,6 +1523,8 @@ of the line. This expects the xmltok-* variables to be set up as by
((progn
(goto-char pos)
(forward-line -1)
(while (looking-at "^[[:blank:]]*$")
(forward-line -1))
(<= (point) xmltok-start))
(goto-char (+ xmltok-start (length open-delim)))
(when (and (string= open-delim "<!--")

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

@ -531,7 +531,10 @@
(re-search-forward c-cpp-messages-re limit t))
(let ((beg (match-beginning c-cpp-message-match-no))
(end (match-end c-cpp-message-match-no)))
(c-put-font-lock-string-face beg end)
;; Don't use c-put-font-lock-string-face here, since in XEmacs that
;; would fail to fontify the first and last characters - We don't have
;; any string delimiters in this construction.
(c-put-font-lock-face beg end 'font-lock-string-face)
;; We replace '(1) (punctuation) syntax-table text properties on ' by
;; '(3) (symbol), so that these characters won't later get the warning
;; face.
@ -2413,7 +2416,7 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'."
;; Fontify basic types.
,(let ((re (c-make-keywords-re nil
(cl-delete-duplicates
(c--delete-duplicates
(append (c-lang-const c-primitive-type-kwds)
(c-lang-const c-type-with-paren-kwds))
:test #'equal))))

43
lisp/progmodes/eglot.el
View file

@ -1165,7 +1165,8 @@ object."
;; Remove the leading "/" for local MS Windows-style paths.
(normalized (if (and (not remote-prefix)
(eq system-type 'windows-nt)
(cl-plusp (length retval)))
(cl-plusp (length retval))
(eq (aref retval 0) ?/))
(w32-long-file-name (substring retval 1))
retval)))
(concat remote-prefix normalized))
@ -4167,8 +4168,8 @@ at point. With prefix argument, prompt for ACTION-KIND."
'display
`((margin left-margin)
,tooltip)))))
(setq eglot--suggestion-overlay ov)))))
(when use-text-p (funcall cb blurb)))
(setq eglot--suggestion-overlay ov))))
(when use-text-p (funcall cb blurb))))
:hint :textDocument/codeAction)
(and use-text-p t))))
@ -4601,7 +4602,7 @@ If NOERROR, return predicate, else erroring function."
map)
"Keymap active in labels Eglot hierarchy buffers.")
(defun eglot--hierarchy-label (node)
(defun eglot--hierarchy-label (node parent-uri)
(eglot--dbind ((HierarchyItem) name uri _detail ((:range item-range))) node
(with-temp-buffer
(insert (propertize
@ -4617,13 +4618,22 @@ If NOERROR, return predicate, else erroring function."
'keymap eglot-hierarchy-label-map
'action
(lambda (_btn)
(pop-to-buffer (find-file-noselect (eglot-uri-to-path uri)))
(eglot--goto
(or
(elt
(get-text-property 0 'eglot--hierarchy-call-sites name)
0)
item-range))))
(let* ((method
(get-text-property 0 'eglot--hierarchy-method name))
(target-uri
(if (eq method :callHierarchy/outgoingCalls)
;; We probably want `parent-uri' for this edge case
;; because that's where the call site we want
;; lives. (bug#78250, bug#78367).
(or parent-uri uri)
uri)))
(pop-to-buffer (find-file-noselect (eglot-uri-to-path target-uri)))
(eglot--goto
(or
(elt
(get-text-property 0 'eglot--hierarchy-call-sites name)
0)
item-range)))))
(buffer-string))))
(defun eglot--hierarchy-1 (name provider preparer specs)
@ -4657,20 +4667,21 @@ If NOERROR, return predicate, else erroring function."
(cl-labels ((expander-for (node)
(lambda (_widget)
(mapcar
#'convert
(lambda (child)
(convert child (plist-get node :uri)))
(eglot--hierarchy-children node))))
(convert (node)
(convert (node parent-uri)
(let ((w (widget-convert
'tree-widget
:tag (eglot--hierarchy-label node)
:tag (eglot--hierarchy-label node parent-uri)
:expander (expander-for node))))
(widget-put w :empty-icon
(widget-get w :leaf-icon))
w)))
(let ((inhibit-read-only t))
(erase-buffer)
(mapc (lambda (r)
(let ((w (widget-create (convert r))))
(mapc (lambda (root)
(let ((w (widget-create (convert root nil))))
(widget-apply-action w)))
eglot--hierarchy-roots)
(goto-char (point-min))))

8
lisp/progmodes/elixir-ts-mode.el
View file

@ -792,9 +792,15 @@ Return nil if NODE is not a defun node or doesn't have a name."
heex-ts--font-lock-feature-list)))
(treesit-major-mode-setup)
(setq-local syntax-propertize-function #'elixir-ts--syntax-propertize)
;; Enable the 'sexp' navigation by default
(treesit-cycle-sexp-type)))
(setq-local forward-sexp-function #'treesit-forward-sexp
treesit-sexp-type-regexp 'sexp
;; But still use 'list' for `down-list' and `up-list'
treesit-sexp-type-down-list 'list
treesit-sexp-type-up-list 'list)))
(derived-mode-add-parents 'elixir-ts-mode '(elixir-mode))

10
lisp/progmodes/flymake.el
View file

@ -2376,11 +2376,11 @@ some of this variable's contents the diagnostic listings.")
for height-to-clear = 0 then ret
for i from 0
for adjust = (* i 2)
for face = `(:inherit default
:foreground
,(face-attribute
(get-text-property 0 'face text)
:foreground nil t))
for face = `(:foreground
,(face-attribute
(or (get-text-property 0 'face text)
'flymake-error)
:foreground nil t))
for text-beg-col = (max (- (max 30 (+ line-beg-col 5)) adjust) (+ line-beg-col 1))
for text-end-col = (max 100 (+ text-beg-col 40))
for ret = (flymake--eol-draw-fancy-1

57
lisp/progmodes/hideshow.el
View file

@ -219,6 +219,7 @@
;; unbundles state save and restore, and includes more isearch support.
;;; Code:
(require 'mule-util) ; For `truncate-string-ellipsis'
;;---------------------------------------------------------------------------
;; user-configurable variables
@ -228,10 +229,22 @@
:prefix "hs-"
:group 'languages)
(defface hs-ellipsis
'((t :height 0.80 :box (:line-width -1) :inherit default))
"Face used for hideshow ellipsis.
Note: If `selective-display' ellipsis already has a face, hideshow will
use that face for the ellipsis instead."
:version "31.1")
(defcustom hs-hide-comments-when-hiding-all t
"Hide the comments too when you do an `hs-hide-all'."
:type 'boolean)
(defcustom hs-display-lines-hidden nil
"If non-nil, display the number of hidden lines next to the ellipsis."
:type 'boolean
:version "31.1")
(defcustom hs-minor-mode-hook nil
"Hook called when hideshow minor mode is activated or deactivated."
:type 'hook
@ -528,8 +541,17 @@ to call with the newly initialized overlay."
(io (if (eq 'block hs-isearch-open)
;; backward compatibility -- `block'<=>`code'
'code
hs-isearch-open)))
hs-isearch-open))
(map (make-sparse-keymap)))
(overlay-put ov 'invisible 'hs)
(define-key map (kbd "<mouse-1>") #'hs-show-block)
(overlay-put ov 'display
(propertize
(hs--get-ellipsis b e)
'mouse-face
'highlight
'help-echo "mouse-1: show hidden lines"
'keymap map))
(overlay-put ov 'hs kind)
(overlay-put ov 'hs-b-offset b-offset)
(overlay-put ov 'hs-e-offset e-offset)
@ -540,6 +562,39 @@ to call with the newly initialized overlay."
(when hs-set-up-overlay (funcall hs-set-up-overlay ov))
ov))
(defun hs--get-ellipsis (b e)
"Helper function for `hs-make-overlay'.
This returns the ellipsis string to use and its face."
(let* ((standard-display-table
(or standard-display-table (make-display-table)))
(d-t-ellipsis
(display-table-slot standard-display-table 'selective-display))
;; Convert ellipsis vector to a propertized string
(string
(if (and (vectorp d-t-ellipsis)
;; Ensure the vector is not empty
(not (length= d-t-ellipsis 0)))
(mapconcat
(lambda (g)
(apply #'propertize (char-to-string (glyph-char g))
(if (glyph-face g) (list 'face (glyph-face g)))))
d-t-ellipsis)))
(string-face (if string (get-text-property 0 'face string)))
(lines (if-let* (hs-display-lines-hidden
(l (1- (count-lines b e)))
(l-str (concat (number-to-string l)
(if (= l 1) " line" " lines"))))
(apply #'propertize l-str
(if string-face
(list 'face string-face))))))
(if string-face
;; Return STRING and LINES if STRING has no face
(concat lines string)
;; Otherwise propertize both with `hs-ellipsis'
(propertize
(concat lines (or string (truncate-string-ellipsis)))
'face 'hs-ellipsis))))
(defun hs-isearch-show (ov)
"Delete overlay OV, and set `hs-headline' to nil.

13
lisp/progmodes/js.el
View file

@ -4038,6 +4038,17 @@ See `treesit-thing-settings' for more information.")
(rx bos (or "comment" "line_comment" "block_comment" "description") eos)
"Regexp for `c-ts-common--comment-regexp'.")
(defvar-local js--treesit-comment-jsx 'undefined)
(defun js--treesit-comment-setup ()
(let ((jsx (not (null (treesit-parent-until
(treesit-node-at (point)) "jsx")))))
(unless (eq js--treesit-comment-jsx jsx)
(setq js--treesit-comment-jsx jsx)
(cond (jsx (setq-local comment-start "{/* ")
(setq-local comment-end " */}"))
(t (c-ts-common-comment-setup))))))
;;;###autoload
(define-derived-mode js-ts-mode js-base-mode "JavaScript"
"Major mode for editing JavaScript.
@ -4052,7 +4063,7 @@ See `treesit-thing-settings' for more information.")
;; Which-func.
(setq-local which-func-imenu-joiner-function #'js--which-func-joiner)
;; Comment.
(c-ts-common-comment-setup)
(setq-local comment-setup-function #'js--treesit-comment-setup)
(setq-local comment-multi-line t)
;; Electric-indent.

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

@ -3369,7 +3369,11 @@ See `sh-mode--treesit-other-keywords' and
:language 'bash
:override t
'((command_substitution) @sh-quoted-exec
(string (expansion (variable_name) @font-lock-variable-use-face)))
(expansion (variable_name) @font-lock-variable-use-face)
(expansion ["${" "}"] @font-lock-bracket-face)
(simple_expansion
"$" @font-lock-bracket-face
(variable_name) @font-lock-variable-use-face))
:feature 'heredoc
:language 'bash

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

@ -162,7 +162,7 @@ Argument LANGUAGE is either `typescript' or `tsx'."
((and (parent-is "comment") c-ts-common-looking-at-star)
c-ts-common-comment-start-after-first-star -1)
((parent-is "comment") prev-adaptive-prefix 0)
((parent-is "ternary_expression") parent-bol typescript-ts-mode-indent-offset)
((parent-is "ternary_expression") standalone-parent typescript-ts-mode-indent-offset)
((parent-is "member_expression") parent-bol typescript-ts-mode-indent-offset)
((parent-is "named_imports") parent-bol typescript-ts-mode-indent-offset)
((parent-is "statement_block") parent-bol typescript-ts-mode-indent-offset)
@ -610,7 +610,7 @@ This mode is intended to be inherited by concrete major modes."
:syntax-table typescript-ts-mode--syntax-table
;; Comments.
(c-ts-common-comment-setup)
(setq-local comment-setup-function #'js--treesit-comment-setup)
;; Electric
(setq-local electric-indent-chars

8
lisp/progmodes/xref.el
View file

@ -1252,7 +1252,9 @@ Return an alist of the form ((GROUP . (XREF ...)) ...)."
(dd default-directory)
buf)
(with-current-buffer (get-buffer-create xref-buffer-name)
(xref--ensure-default-directory dd (current-buffer))
(if (fboundp 'set-buffer-local-toplevel-value)
(set-buffer-local-toplevel-value 'default-directory dd)
(xref--ensure-default-directory dd (current-buffer)))
(xref--xref-buffer-mode)
(xref--show-common-initialize xref-alist fetcher alist)
(setq mode-line-process (list xref-mode-line-matches))
@ -1378,7 +1380,9 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'."
(setq xref-alist (xref--analyze xrefs))
(with-current-buffer (get-buffer-create xref-buffer-name)
(xref--ensure-default-directory dd (current-buffer))
(if (fboundp 'set-buffer-local-toplevel-value)
(set-buffer-local-toplevel-value 'default-directory dd)
(xref--ensure-default-directory dd (current-buffer)))
(xref--transient-buffer-mode)
(xref--show-common-initialize xref-alist fetcher alist)
(pop-to-buffer (current-buffer)

44
lisp/pulse.el
View file

@ -227,6 +227,50 @@ Only pulses the line if `pulse-command-advice-flag' is non-nil."
(when pulse-command-advice-flag
(pulse-momentary-highlight-one-line (point))))
;;; Pulse faces
;; Functions for pulsing any defined face(s).
(require 'face-remap)
(defcustom pulse-face-duration pulse-delay
"Time (in seconds) used for `pulse-faces' duration."
:type 'number
:group 'pulse
:version "31.1")
;; FIXME: The pulse's smooth effect cannot be achieved here because
;; the face-remaping will not work well for that.
(defun pulse-faces (faces &optional with-face)
"Briefly pulse FACES by using attributes of face WITH-FACE (if defined).
FACES should be a list of faces to pulse.
WITH-FACE is optional, it can be a defined face or a list
of face properties to apply. If nil or omitted, it defaults
to `pulse-highlight-face'."
(when-let* (((numberp pulse-face-duration)) ; Ensure time is a number
(with-face (or with-face 'pulse-highlight-face))
(in-buffer (current-buffer))
(cookies (mapcar (lambda (f)
(if (consp with-face)
(apply #'face-remap-add-relative
f with-face)
(face-remap-add-relative f with-face)))
faces)))
;; Use run-with-timer if the duration is very long, so as to avoid
;; blocking emacs; otherwise fall back to 'sleep-for'.
(if (> pulse-face-duration 0.1)
(run-with-timer pulse-face-duration 0
(lambda ()
;; Remove the face remaping in the buffer
;; where `pulse-faces' was called.
(if (buffer-live-p in-buffer)
(with-current-buffer in-buffer
(mapc #'face-remap-remove-relative cookies)))))
(unwind-protect
(progn
;; Redisplay to apply the face remapping.
(redisplay)
(sleep-for pulse-face-duration))
(mapc #'face-remap-remove-relative cookies)))))
(provide 'pulse)
;;; pulse.el ends here

81
lisp/ring-bell-fns.el Normal file
View file

@ -0,0 +1,81 @@
;;; ring-bell-fns.el --- Collection of functions for ring-bell -*- lexical-binding: t; -*-
;; Copyright (C) 2025 Free Software Foundation, Inc.
;; Author: Elijah Gabe Pérez <eg642616@gmail.com>
;; Keywords: faces
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Collection of functions intended to be used with `ring-bell-function'.
;; as alternatives to `visible-bell'
;;; Code:
(require 'pulse)
(defgroup ring-bell nil
"Customization options for ring bell."
:version "31.1"
:group 'emacs)
(defcustom flash-face-attributes
'(:background "red" :foreground "white")
"Face attributes to use in any function from `ring-bell-fns'.
This is intended to be used in any function from `ring-bell-fns' such as
`flash-face-bell-function' and `flash-echo-area-bell-function' to make
the flash face more noticeable."
:type 'plist
:version "31.1")
(defcustom flash-face-faces
'(mode-line-active)
"A list of faces to be flashed by `flash-face-bell-function'."
:type '(repeat face)
:version "31.1")
;;;###autoload
(defun flash-face-bell-function ()
"Indicate ringing the bell by flashing some faces.
Intended to be used in `ring-bell-function'."
(pulse-faces flash-face-faces flash-face-attributes))
;;;###autoload
(defun flash-echo-area-bell-function ()
"Indicate ringing the bell by flashing the echo area.
Intended to be used in `ring-bell-function'."
;; pulse-faces uses run-with-timer if `pulse-face-duration'
;; is long, which makes the flashing in the echo area not visible.
;; for fix this then apply the flashing to *Echo Area 0*
;; and minibuffer buffer for the `run-with-timer',
;; and fallback to minibuffer buffer due performance.
(if (> pulse-face-duration 0.1)
(dolist (buf `(,(window-buffer (minibuffer-window))
;; get or create the echo area for flash it too.
,(get-buffer-create" *Echo Area 0*")))
(redisplay)
(with-current-buffer buf
(pulse-faces '(default) flash-face-attributes)))
(with-current-buffer (window-buffer (minibuffer-window))
;; For make the flash effect take effect in the
;; minibuffer/echo area, insert a space only if it is empty.
(if (= (buffer-size) 0)
(insert ?\s))
(pulse-faces '(default) flash-face-attributes))))
(provide 'ring-bell-fns)
;;; ring-bell-fns.el ends here

7
lisp/ses.el
View file

@ -504,7 +504,7 @@ This can alter PLIST."
(setq ses--ses-buffer-list (delq buf ses--ses-buffer-list)))
(t
(with-current-buffer buf
(when (gethash name ses--named-cell-hashmap)
(when (and ses--named-cell-hashmap (gethash name ses--named-cell-hashmap))
(setq used-elsewhere t
buffer-list nil))))))
(unless used-elsewhere
@ -3452,7 +3452,7 @@ while in the SES buffer."
((minibufferp) ses--completion-table)
((derived-mode-p 'help-mode) nil)
(t (user-error "Not in a SES buffer")))))
(when named-cell-hashmap
(if named-cell-hashmap
(let ((ses--list-orig-buffer (or ses--list-orig-buffer (current-buffer))))
(help-setup-xref
(list (lambda (named-cell-hashmap buffer)
@ -3474,7 +3474,8 @@ while in the SES buffer."
(princ "\n"))
named-cell-hashmap))
(with-current-buffer standard-output
(buffer-string)))))))
(buffer-string)))))
(message "No named cell found")))
;;----------------------------------------------------------------------------

15
lisp/simple.el
View file

@ -888,6 +888,21 @@ buffer if the variable `delete-trailing-lines' is non-nil."
;; Return nil for the benefit of `write-file-functions'.
nil)
(defun delete-trailing-whitespace-if-possible ()
"Call `delete-trailing-whitespace' unless the buffer is read-only."
(unless buffer-read-only (delete-trailing-whitespace)))
(define-minor-mode delete-trailing-whitespace-mode
"Delete trailing whitespace before saving the current buffer."
:global nil
(cond
(delete-trailing-whitespace-mode
(add-hook 'before-save-hook
#'delete-trailing-whitespace-if-possible nil t))
(t
(remove-hook 'before-save-hook
#'delete-trailing-whitespace-if-possible t))))
(defun newline-and-indent (&optional arg)
"Insert a newline, then indent according to major mode.
Indentation is done using the value of `indent-line-function'.

16
lisp/subr.el
View file

@ -174,6 +174,9 @@ of VARIABLEs set by earlier pairs.
The return value of the `setq-local' form is the VALUE of the last
pair.
In some corner cases you may need to resort to
`set-buffer-local-toplevel-value' instead, which see.
\(fn [VARIABLE VALUE]...)"
(declare (debug setq))
(unless (evenp (length pairs))
@ -330,7 +333,8 @@ the value of the last one, or nil if there are none."
(cons 'progn body)
nil)
(macroexp-warn-and-return (format-message "`static-when' with empty body")
(list 'progn nil nil) '(empty-body static-when) t)))
nil '(empty-body static-when) t
condition)))
(defmacro unless (cond &rest body)
"If COND yields nil, do BODY, else return nil.
@ -7436,11 +7440,11 @@ TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
(declare (important-return-value t))
(string-trim-left (string-trim-right string trim-right) trim-left))
(defsubst hash-table-contains-p (key table)
"Return non-nil if TABLE has an element with KEY."
(declare (side-effect-free t)
(important-return-value t))
(let ((missing (make-symbol "missing")))
(let ((missing (make-symbol "missing")))
(defsubst hash-table-contains-p (key table)
"Return non-nil if TABLE has an element with KEY."
(declare (side-effect-free t)
(important-return-value t))
(not (eq (gethash key table missing) missing))))
;; The initial anchoring is for better performance in searching matches.

52
lisp/tab-line.el
View file

@ -1004,7 +1004,7 @@ is possible when `tab-line-switch-cycling' is non-nil."
(switch-to-buffer buffer))))))))
(defun tab-line-mouse-move-tab (event)
"Move a tab to a different position on the tab line.
"Move a tab to a different position on the tab line using mouse.
This command should be bound to a drag event. It moves the tab
at the mouse-down event to the position at mouse-up event.
It can be used only when `tab-line-tabs-function' is
@ -1028,6 +1028,46 @@ customized to `tab-line-tabs-fixed-window-buffers'."
(set-window-parameter window1 'tab-line-cache nil)
(with-selected-window window1 (force-mode-line-update))))))
(defun tab-line-move-tab-forward (&optional arg)
"Move a tab to a different position on the tab line.
ARG specifies the number of positions to move:
- When positive, move the current tab ARG positions to the right.
- When negative, move the current tab -ARG positions to the left.
- When nil, act as if ARG is 1, moving one position to the right.
It can be used only when `tab-line-tabs-function' is
customized to `tab-line-tabs-fixed-window-buffers'."
(interactive "p")
(when (eq tab-line-tabs-function #'tab-line-tabs-fixed-window-buffers)
(let* ((window (selected-window))
(buffers (window-parameter window 'tab-line-buffers))
(buffer (current-buffer))
(pos (seq-position buffers buffer))
(len (length buffers))
(new-pos (+ pos (or arg 1))))
(when (and pos (> len 1))
(setq new-pos (if tab-line-switch-cycling
(mod new-pos len)
(max 0 (min new-pos (1- len)))))
(setq buffers (delq buffer buffers))
(setq buffers (append
(seq-take buffers new-pos)
(list buffer)
(seq-drop buffers new-pos)))
(set-window-parameter window 'tab-line-buffers buffers)
(set-window-parameter window 'tab-line-cache nil)
(force-mode-line-update)))))
(defun tab-line-move-tab-backward (&optional arg)
"Move a tab to a different position on the tab line.
ARG specifies the number of positions to move:
- When positive, move the current tab ARG positions to the left.
- When negative, move the current tab -ARG positions to the right.
- When nil, act as if ARG is 1, moving one position to the left.
It can be used only when `tab-line-tabs-function' is
customized to `tab-line-tabs-fixed-window-buffers'."
(interactive "p")
(tab-line-move-tab-forward (- (or arg 1))))
(defcustom tab-line-close-tab-function 'bury-buffer
"What to do upon closing a tab on the tab line.
@ -1133,14 +1173,18 @@ However, return the correct mouse position list if EVENT is a
:doc "Keymap for keys of `tab-line-mode'."
"C-x <left>" #'tab-line-switch-to-prev-tab
"C-x C-<left>" #'tab-line-switch-to-prev-tab
"C-x M-<left>" #'tab-line-move-tab-backward
"C-x <right>" #'tab-line-switch-to-next-tab
"C-x C-<right>" #'tab-line-switch-to-next-tab)
"C-x C-<right>" #'tab-line-switch-to-next-tab
"C-x M-<right>" #'tab-line-move-tab-forward)
(defvar-keymap tab-line-switch-repeat-map
:doc "Keymap to repeat tab/buffer cycling. Used in `repeat-mode'."
:repeat t
"<left>" #'tab-line-switch-to-prev-tab
"<right>" #'tab-line-switch-to-next-tab)
"<left>" #'tab-line-switch-to-prev-tab
"M-<left>" #'tab-line-move-tab-backward
"<right>" #'tab-line-switch-to-next-tab
"M-<right>" #'tab-line-move-tab-forward)
;;;###autoload
(define-minor-mode tab-line-mode

56
lisp/treesit.el
View file

@ -839,6 +839,11 @@ those inside are kept."
if (<= start (car range) (cdr range) end)
collect range))
(defvar treesit--parser-overlay-offset 0
"Defines at which position to get the parser overlay.
The commands that move backward need to set it to -1 to be
able to use the range that ends immediately before point.")
(defun treesit-parsers-at (&optional pos language with-host only)
"Return all parsers at POS.
@ -869,7 +874,8 @@ That is, the deepest embedded parser comes first."
(let ((res nil))
;; Refer to (ref:local-parser-overlay) for more explanation of local
;; parser overlays.
(dolist (ov (overlays-at (or pos (point))))
(dolist (ov (overlays-at (+ (or pos (point))
treesit--parser-overlay-offset)))
(when-let* ((parser (overlay-get ov 'treesit-parser))
(host-parser (or (null with-host)
(overlay-get ov 'treesit-host-parser)))
@ -2524,14 +2530,12 @@ the function."
;; `functionp'.
((alist-get exp treesit-simple-indent-presets))
((functionp exp) exp)
((symbolp exp)
(if (null exp)
exp
;; Matchers only return lambdas, anchors only return
;; integer, so we should never see a variable.
(signal 'treesit-indent-error
(list "Couldn't find the preset corresponding to expression"
exp))))
;; There are higher-order presets that take arguments, like
;; (nth-sibling 1 t), so it's possible for exp to be something
;; other than numbers and functions. Don't signal an error if
;; exp isn't a function nor a number. In fact, allow exp to be
;; any symbol or keyword, so users can define higher-order
;; presets that takes keyword or symbol as arguments.
(t exp)))
;; This variable might seem unnecessary: why split
@ -2977,6 +2981,14 @@ delimits medium sized statements in the source code. It is,
however, smaller in scope than sentences. This is used by
`treesit-forward-sexp' and friends.")
(defvar-local treesit-sexp-type-down-list nil
"A regexp that matches the sexp nodes for `down-list'.
This is used by `treesit-down-list'.")
(defvar-local treesit-sexp-type-up-list nil
"A regexp that matches the sexp nodes for `up-list'.
This is used by `treesit-up-list'.")
;; Avoid interpreting the symbol `list' as a function.
(put 'list 'treesit-thing-symbol t)
@ -3021,7 +3033,8 @@ across atoms (such as symbols or words) inside the list."
t)
(if (> arg 0)
(treesit-end-of-thing pred (abs arg) 'restricted)
(treesit-beginning-of-thing pred (abs arg) 'restricted))
(let ((treesit--parser-overlay-offset -1))
(treesit-beginning-of-thing pred (abs arg) 'restricted)))
;; If we couldn't move, we should signal an error and report
;; the obstacle, like `forward-sexp' does. If we couldn't
;; find a parent, we simply return nil without moving point,
@ -3036,6 +3049,7 @@ the boundaries of the list.
ARG is described in the docstring of `forward-list'."
(let* ((pred (or treesit-sexp-type-regexp 'list))
(arg (or arg 1))
(treesit--parser-overlay-offset (if (> arg 0) 0 -1))
(cnt arg)
(inc (if (> arg 0) 1 -1)))
(while (/= cnt 0)
@ -3120,7 +3134,9 @@ redefined by the variable `down-list-function'.
ARG is described in the docstring of `down-list'."
(interactive "^p")
(let* ((pred (or treesit-sexp-type-regexp 'list))
(let* ((pred (or treesit-sexp-type-down-list
treesit-sexp-type-regexp
'list))
(arg (or arg 1))
(cnt arg)
(inc (if (> arg 0) 1 -1)))
@ -3136,7 +3152,8 @@ ARG is described in the docstring of `down-list'."
(treesit-thing-prev (point) pred)))
(child (when sibling
(treesit-node-child sibling (if (> arg 0) 0 -1)))))
(or (when (and (null treesit-sexp-type-regexp)
(or (when (and (null (or treesit-sexp-type-down-list
treesit-sexp-type-regexp))
default-pos
(or (null child)
(if (> arg 0)
@ -3161,8 +3178,11 @@ redefined by the variable `up-list-function'.
ARG is described in the docstring of `up-list'."
(interactive "^p")
(let* ((pred (or treesit-sexp-type-regexp 'list))
(let* ((pred (or treesit-sexp-type-up-list
treesit-sexp-type-regexp
'list))
(arg (or arg 1))
(treesit--parser-overlay-offset -1)
(cnt arg)
(inc (if (> arg 0) 1 -1)))
(while (/= cnt 0)
@ -3188,7 +3208,8 @@ ARG is described in the docstring of `up-list'."
(treesit-node-at (point) (car parsers)) pred)
parsers (cdr parsers)))))
(or (when (and (null treesit-sexp-type-regexp)
(or (when (and (null (or treesit-sexp-type-up-list
treesit-sexp-type-regexp))
default-pos
(or (null parent)
(if (> arg 0)
@ -3971,8 +3992,9 @@ by `treesit-simple-imenu-settings'."
(lambda (entry)
(let* ((lang (car entry))
(settings (cdr entry))
(global-parser (car (treesit-parsers-at nil lang nil '(primary global))))
(local-parsers (treesit-local-parsers-at nil lang)))
(global-parser (car (treesit-parser-list nil lang)))
(local-parsers
(treesit-parser-list nil lang 'embedded)))
(cons (treesit-language-display-name lang)
;; No one says you can't have both global and local
;; parsers for the same language. E.g., Rust uses
@ -4289,7 +4311,7 @@ instead of emitting a warning."
(pcase-let ((`(,available . ,err)
(treesit-language-available-p lang t)))
(when (not available)
(setq msg (format "language grammar for %s is unavailable (%s): %s"
(setq msg (format "language grammar for %s failed to load (%s): %s"
lang (nth 0 err)
(string-join
(mapcar (lambda (x) (format "%s" x))

14
lisp/url/url-cookie.el
View file

@ -349,22 +349,24 @@ i.e. 1970-1-1) are loaded as expiring one year from now instead."
(defvar url-cookie-timer nil)
(defcustom url-cookie-save-interval 3600
"The number of seconds between automatic saves of cookies.
Default is 1 hour. Note that if you change this variable outside of
the `customize' interface after `url-do-setup' has been run, you need
to run the `url-cookie-setup-save-timer' function manually."
"If non-nil, the number of seconds between automatic saves of cookies.
Default is 1 hour; set to nil to disable automatic saving of cookies.
Note that if you change this variable outside of the `customize'
interface after `url-do-setup' has been run, you need to run
the `url-cookie-setup-save-timer' function manually."
:set (lambda (var val)
(set-default var val)
(if (bound-and-true-p url-setup-done)
(url-cookie-setup-save-timer)))
:type 'natnum)
:type '(choice (const :tag "Disable automatic saving of cookies" :value nil)
(natnum :tag "Interval in seconds for auto-saving cookies")))
(defun url-cookie-setup-save-timer ()
"Reset the cookie saver timer."
(interactive)
(ignore-errors (cancel-timer url-cookie-timer))
(setq url-cookie-timer nil)
(if url-cookie-save-interval
(if (natnump url-cookie-save-interval)
(setq url-cookie-timer (run-at-time url-cookie-save-interval
url-cookie-save-interval
#'url-cookie-write-file))))

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

@ -180,7 +180,10 @@ The default \"-b\" means to ignore whitespace-only changes,
;;;;
(defvar-keymap diff-mode-shared-map
:parent special-mode-map
:doc "Additional bindings for read-only `diff-mode' buffers.
These bindings are also available with an ESC prefix
(i.e. a \\=`M-' prefix) in read-write `diff-mode' buffers,
and with a `diff-minor-mode-prefix' prefix in `diff-minor-mode'."
"n" #'diff-hunk-next
"N" #'diff-file-next
"p" #'diff-hunk-prev
@ -207,7 +210,7 @@ The default \"-b\" means to ignore whitespace-only changes,
;; We want to inherit most bindings from
;; `diff-mode-shared-map', but not all since they may hide
;; useful `M-<foo>' global bindings when editing.
(dolist (key '("A" "r" "R" "g" "q" "W" "w" "z"))
(dolist (key '("A" "r" "R" "W" "w"))
(keymap-set map key nil))
map)
;; From compilation-minor-mode.
@ -1598,7 +1601,9 @@ else cover the whole buffer."
;; It should be lower than `outline-minor-mode' and `view-mode'.
(or (assq 'diff-mode-read-only minor-mode-map-alist)
(nconc minor-mode-map-alist
(list (cons 'diff-mode-read-only diff-mode-shared-map))))
(list (cons 'diff-mode-read-only
(make-composed-keymap diff-mode-shared-map
special-mode-map)))))
(defvar whitespace-style)
(defvar whitespace-trailing-regexp)

97
lisp/vc/vc-dispatcher.el
View file

@ -199,19 +199,7 @@ Another is that undo information is not kept."
(setq-local vc-parent-buffer-name
(concat " from " (buffer-name camefrom))))
;; We want to set the buffer-local value of `default-directory' to
;; olddir. This `setq' alone ought to be sufficient. But if there
;; is a let-binding of `default-directory' in effect, such as the
;; one established by `vc-print-root-log', then all we are able to
;; do is change the let-binding, and not affect the underlying
;; buffer-local cell. Work around this using `run-with-timer'.
;; See bug#53626 and bug#77306.
(setq default-directory olddir)
(run-with-timer 0 nil (lambda ()
(when (buffer-live-p buf)
(with-current-buffer buf
(setq default-directory olddir)))))
(set-buffer-local-toplevel-value 'default-directory olddir)
(let ((buffer-undo-list t)
(inhibit-read-only t))
(erase-buffer))))
@ -256,15 +244,18 @@ Another is that undo information is not kept."
'help-echo
"A command is in progress in this buffer"))))
(defun vc-exec-after (code &optional success)
"Eval CODE when the current buffer's process is done.
If the current buffer has no process, just evaluate CODE.
Else, add CODE to the process' sentinel.
(defun vc-exec-after (code &optional success proc)
"Execute CODE when PROC, or the current buffer's process, is done.
CODE should be a function of no arguments.
If SUCCESS, it should be a process object. Only run CODE if the
SUCCESS process has a zero exit code."
(let ((proc (get-buffer-process (current-buffer))))
The optional PROC argument specifies the process Emacs should wait for
before executing CODE. It defaults to the current buffer's process.
If PROC is nil and the current buffer has no process, just evaluate
CODE. Otherwise, add CODE to the process's sentinel.
If SUCCESS, it should be a process object.
Only run CODE if the SUCCESS process has a zero exit code."
(let ((proc (or proc (get-buffer-process (current-buffer)))))
(cond
;; If there's no background process, just execute the code.
;; We used to explicitly call delete-process on exited processes,
@ -291,6 +282,41 @@ SUCCESS process has a zero exit code."
(declare (indent 0) (debug (def-body)))
`(vc-exec-after (lambda () ,@body)))
(defun vc-wait-for-process-before-save (proc message)
"Make Emacs wait for PROC before saving buffers under current VC tree.
If waiting for PROC takes more than a second, display MESSAGE.
This is used to implement `vc-async-checkin'. It effectively switches
to a synchronous checkin in the case that the user asks to save a buffer
under the tree in which the checkin operation is running.
The hook installed by this function will make Emacs unconditionally wait
for PROC if the root of the current VC tree couldn't be determined, and
whenever writing out a buffer which doesn't have any `buffer-file-name'
yet."
(letrec ((root (vc-root-dir))
(hook
(lambda ()
(cond ((not (process-live-p proc))
(remove-hook 'before-save-hook hook))
((or (and buffer-file-name
(or (not root)
(file-in-directory-p buffer-file-name
root)))
;; No known buffer file name but we are saving:
;; perhaps writing out a `special-mode' buffer.
;; A `before-save-hook' cannot know whether or
;; not it'll be written out under ROOT.
;; Err on the side of switching to synchronous.
(not buffer-file-name))
(with-delayed-message (1 message)
(while (process-live-p proc)
(when (input-pending-p)
(discard-input))
(sit-for 0.05)))
(remove-hook 'before-save-hook hook))))))
(add-hook 'before-save-hook hook)))
(defvar vc-filter-command-function #'list
"Function called to transform VC commands before execution.
The function is called inside the buffer in which the command
@ -522,23 +548,24 @@ asynchronous VC command has completed. PROCESS-BUFFER is the
buffer for the asynchronous VC process.
If the current buffer is a VC Dir buffer, call `vc-dir-refresh'.
If the current buffer is a Dired buffer, revert it."
If the current buffer is a Dired buffer, revert it.
If the current buffer visits a file, call `vc-refresh-state'."
(let* ((buf (current-buffer))
(tick (buffer-modified-tick buf)))
(cond
((derived-mode-p 'vc-dir-mode)
(with-current-buffer process-buffer
(vc-run-delayed
(if (buffer-live-p buf)
(with-current-buffer buf
(vc-dir-refresh))))))
((derived-mode-p 'dired-mode)
(with-current-buffer process-buffer
(vc-run-delayed
(and (buffer-live-p buf)
(= (buffer-modified-tick buf) tick)
(with-current-buffer buf
(revert-buffer)))))))))
(cl-macrolet ((run-delayed (&rest body)
`(with-current-buffer process-buffer
(vc-run-delayed
(when (buffer-live-p buf)
(with-current-buffer buf
,@body))))))
(cond ((derived-mode-p 'vc-dir-mode)
(run-delayed (vc-dir-refresh)))
((derived-mode-p 'dired-mode)
(run-delayed
(when (= (buffer-modified-tick buf) tick)
(revert-buffer))))
(buffer-file-name
(run-delayed (vc-refresh-state)))))))
;; These functions are used to ensure that the view the user sees is up to date
;; even if the dispatcher client mode has messed with file contents (as in,

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

@ -1111,6 +1111,19 @@ It is based on `log-edit-mode', and has Git-specific extensions."
("Sign-Off" . ,(boolean-arg-fn "--signoff")))
comment)))
(defmacro vc-git--with-apply-temp-to-staging (temp &rest body)
(declare (indent 1) (debug (symbolp body)))
`(let ((,temp (make-nearby-temp-file ,(format "git-%s" temp))))
(unwind-protect (progn ,@body
;; This uses `file-local-name' to strip the
;; TRAMP prefix, not `file-relative-name',
;; because we've had at least one problem
;; report where relativizing the file name
;; meant that Git failed to find it.
(vc-git-command nil 0 nil "apply" "--cached"
(file-local-name ,temp)))
(delete-file ,temp))))
(defun vc-git-checkin (files comment &optional _rev)
(let* ((file1 (or (car files) default-directory))
(root (vc-git-root file1))
@ -1194,8 +1207,7 @@ It is based on `log-edit-mode', and has Git-specific extensions."
(t (push file-name to-stash)))
(setq pos (point))))))
(unless (string-empty-p vc-git-patch-string)
(let ((patch-file (make-nearby-temp-file "git-patch"))
;; Temporarily countermand the let-binding at the
(let (;; Temporarily countermand the let-binding at the
;; beginning of this function.
(coding-system-for-write
(coding-system-change-eol-conversion
@ -1203,38 +1215,48 @@ It is based on `log-edit-mode', and has Git-specific extensions."
;; to have the Unix EOL format, because Git expects
;; that, even on Windows.
(or pcsw vc-git-commits-coding-system) 'unix)))
(with-temp-file patch-file
(insert vc-git-patch-string))
(unwind-protect
(vc-git-command nil 0 nil "apply" "--cached" patch-file)
(delete-file patch-file))))
(vc-git--with-apply-temp-to-staging patch
(with-temp-file patch
(insert vc-git-patch-string)))))
(when to-stash (vc-git--stash-staged-changes to-stash)))
;; When operating on the whole tree, better pass "-a" than ".",
;; since "." fails when we're committing a merge.
(apply #'vc-git-command nil 0
(if (and only (not vc-git-patch-string)) files)
(nconc (if msg-file (list "commit" "-F"
(file-local-name msg-file))
(list "commit" "-m"))
(let ((args
(vc-git--log-edit-extract-headers comment)))
(when msg-file
(let ((coding-system-for-write
(or pcsw vc-git-commits-coding-system)))
(write-region (car args) nil msg-file))
(setq args (cdr args)))
args)
(unless vc-git-patch-string
(if only (list "--only" "--") '("-a")))))
(if (and msg-file (file-exists-p msg-file)) (delete-file msg-file))
(when to-stash
(let ((cached (make-nearby-temp-file "git-cached")))
(unwind-protect
(progn (with-temp-file cached
(vc-git-command t 0 nil "stash" "show" "-p"))
(vc-git-command nil 0 nil "apply" "--cached" cached))
(delete-file cached))
(vc-git-command nil 0 nil "stash" "drop")))))
(let ((files (and only (not vc-git-patch-string) files))
(args (vc-git--log-edit-extract-headers comment))
(buffer (format "*vc-git : %s*" (expand-file-name root)))
(post
(lambda ()
(when (and msg-file (file-exists-p msg-file))
(delete-file msg-file))
(when to-stash
(vc-git--with-apply-temp-to-staging cached
(with-temp-file cached
(vc-git-command t 0 nil "stash" "show" "-p")))))))
(when msg-file
(let ((coding-system-for-write
(or pcsw vc-git-commits-coding-system)))
(write-region (car args) nil msg-file))
(setq args (cdr args)))
(setq args (nconc (if msg-file
(list "commit" "-F"
(file-local-name msg-file))
(list "commit" "-m"))
args
;; When operating on the whole tree, better pass
;; "-a" than ".", since "." fails when we're
;; committing a merge.
(and (not vc-git-patch-string)
(if only (list "--only" "--") '("-a")))))
(if vc-async-checkin
(progn (vc-wait-for-process-before-save
(apply #'vc-do-async-command buffer root
vc-git-program (nconc args files))
"Finishing checking in files...")
(with-current-buffer buffer
(vc-run-delayed
(vc-compilation-mode 'git)
(funcall post)))
(vc-set-async-update buffer))
(apply #'vc-git-command nil 0 files args)
(funcall post)))))
(defun vc-git--stash-staged-changes (files)
"Stash only the staged changes to FILES."
@ -1263,8 +1285,10 @@ It is based on `log-edit-mode', and has Git-specific extensions."
(unwind-protect
(progn
(vc-git-command nil 0 nil "read-tree" "HEAD")
;; See `vc-git--with-apply-temp-to-staging'
;; regarding use of `file-local-name'.
(vc-git-command nil 0 nil "apply" "--cached"
cached)
(file-local-name cached))
(setq tree (git-string "write-tree")))
(delete-file index))))
(delete-file cached))

84
lisp/vc/vc-hg.el
View file

@ -1181,25 +1181,42 @@ If toggling on, also insert its message into the buffer."
"Major mode for editing Hg log messages.
It is based on `log-edit-mode', and has Hg-specific extensions.")
(autoload 'vc-wait-for-process-before-save "vc-dispatcher")
(defun vc-hg-checkin (files comment &optional _rev)
"Hg-specific version of `vc-backend-checkin'.
REV is ignored."
(apply #'vc-hg-command nil 0 files
(nconc (list "commit" "-m")
(vc-hg--extract-headers comment))))
(let ((args (nconc (list "commit" "-m")
(vc-hg--extract-headers comment))))
(if vc-async-checkin
(let ((buffer (vc-hg--async-buffer)))
(vc-wait-for-process-before-save
(apply #'vc-hg--async-command buffer (nconc args files))
"Finishing checking in files...")
(with-current-buffer buffer
(vc-run-delayed
(vc-compilation-mode 'hg)))
(vc-set-async-update buffer))
(apply #'vc-hg-command nil 0 files args))))
(defun vc-hg-checkin-patch (patch-string comment)
(let ((patch-file (make-temp-file "hg-patch")))
(write-region patch-string nil patch-file)
(unwind-protect
(progn
(let ((args (list "update"
"--merge" "--tool" "internal:local"
"tip")))
(apply #'vc-hg-command nil 0 nil
(nconc (list "import" "--bypass" patch-file "-m")
(vc-hg--extract-headers comment)))
(vc-hg-command nil 0 nil
"update"
"--merge" "--tool" "internal:local"
"tip"))
(if vc-async-checkin
(let ((buffer (vc-hg--async-buffer)))
(apply #'vc-hg--async-command buffer args)
(with-current-buffer buffer
(vc-run-delayed
(vc-compilation-mode 'hg)))
(vc-set-async-update buffer))
(apply #'vc-hg-command nil 0 nil args)))
(delete-file patch-file))))
(defun vc-hg--extract-headers (comment)
@ -1381,7 +1398,7 @@ REV is the revision to check out into WORKFILE."
;; Follows vc-hg-command (or vc-do-async-command), which uses vc-do-command
;; from vc-dispatcher.
(declare-function vc-exec-after "vc-dispatcher" (code &optional success))
(declare-function vc-exec-after "vc-dispatcher" (code &optional success proc))
;; Follows vc-exec-after.
(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
@ -1543,15 +1560,14 @@ call \"hg push -r REVS\" to push the specified revisions REVS."
(defun vc-hg-merge-branch ()
"Prompt for revision and merge it into working directory.
This runs the command \"hg merge\"."
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root)))
;; Disable pager.
(process-environment (cons "HGPLAIN=1" process-environment))
(branch (vc-read-revision "Revision to merge: ")))
(apply #'vc-do-async-command buffer root vc-hg-program
(let ((buffer (vc-hg--async-buffer))
(branch (vc-read-revision "Revision to merge: ")))
(apply #'vc-hg--async-command buffer
(append '("--config" "ui.report_untrusted=0" "merge")
(unless (string= branch "") (list branch))))
(with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg)))
(and (not (string-empty-p branch)) (list branch))))
(with-current-buffer buffer
(vc-run-delayed
(vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))
(defun vc-hg-prepare-patch (rev)
@ -1571,15 +1587,33 @@ This runs the command \"hg merge\"."
"A wrapper around `vc-do-command' for use in vc-hg.el.
This function differs from `vc-do-command' in that it invokes
`vc-hg-program', and passes `vc-hg-global-switches' to it before FLAGS."
(vc-hg--command-1 #'vc-do-command
(list (or buffer "*vc*")
okstatus vc-hg-program file-or-list)
flags))
(defun vc-hg--async-command (buffer &rest args)
"Wrapper around `vc-do-async-command' like `vc-hg-command'."
(vc-hg--command-1 #'vc-do-async-command
(list buffer (vc-hg-root default-directory)
vc-hg-program)
args))
(defun vc-hg--async-buffer ()
"Buffer passed to `vc-do-async-command' by vg-hg.el commands.
Intended for use via the `vc-hg--async-command' wrapper."
(format "*vc-hg : %s*"
(expand-file-name (vc-hg-root default-directory))))
(defun vc-hg--command-1 (fun args flags)
;; Disable pager.
(let ((process-environment (cons "HGPLAIN=1" process-environment))
(flags (append '("--config" "ui.report_untrusted=0") flags)))
(apply #'vc-do-command (or buffer "*vc*")
okstatus vc-hg-program file-or-list
(if (stringp vc-hg-global-switches)
(cons vc-hg-global-switches flags)
(append vc-hg-global-switches
flags)))))
(let ((process-environment (cons "HGPLAIN=1" process-environment)))
(apply fun (append args
'("--config" "ui.report_untrusted=0")
(if (stringp vc-hg-global-switches)
(cons vc-hg-global-switches flags)
(append vc-hg-global-switches
flags))))))
(defun vc-hg-root (file)
(vc-find-root file ".hg"))

67
lisp/vc/vc.el
View file

@ -29,7 +29,9 @@
;;
;; Per Cederqvist <ceder@lysator.liu.se>
;; Paul Eggert <eggert@twinsun.com>
;; Dmitry Gutov <dmitry@gutov.dev>
;; Sebastian Kremer <sk@thp.uni-koeln.de>
;; Juri Linkov <juri@linkov.net>
;; Martin Lorentzson <martinl@gnu.org>
;; Dave Love <fx@gnu.org>
;; Stefan Monnier <monnier@cs.yale.edu>
@ -38,8 +40,6 @@
;; J.D. Smith <jdsmith@alum.mit.edu>
;; Andre Spiegel <spiegel@gnu.org>
;; Richard Stallman <rms@gnu.org>
;; Dmitry Gutov <dmitry@gutov.dev>
;; Juri Linkov <juri@linkov.net>
;; Sean Whitton <spwhitton@spwhitton.name>
;;
;; In July 2007 ESR returned and redesigned the mode to cope better
@ -1002,6 +1002,24 @@ the URL-REGEXP of the association."
:value-type ,vc-cloneable-backends-custom-type)
:version "31.1")
(defcustom vc-async-checkin nil
"If non-nil, checkin operations should be done asynchronously.
This is useful to set as a directory local variable in repositories
where the VCS in use performs checkin operations slowly.
For example, Git is slow when committing changes to very large files,
and Mercurial can be slow when there is a very large number of files.
While an asynchronous checkin operation is in progress, Emacs installs a
`before-save-hook' to switch back to a synchronous checkin if you ask to
save buffers under the current VC tree. This is to avoid nondeterminism
regarding exactly what changes get checked in.
Not supported by all backends."
:type 'boolean
:safe #'booleanp
:version "31.1")
;; File property caching
@ -1857,26 +1875,33 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(lambda ()
(vc-call-backend backend 'log-edit-mode))
(lambda (files comment)
(message "Checking in %s..." (vc-delistify files))
;; "This log message intentionally left almost blank".
;; RCS 5.7 gripes about white-space-only comments too.
(or (and comment (string-match "[^\t\n ]" comment))
(setq comment "*** empty log message ***"))
(with-vc-properties
files
;; We used to change buffers to get local value of
;; vc-checkin-switches, but 'the' local buffer is
;; not a well-defined concept for filesets.
(progn
(if patch-string
(vc-call-backend backend 'checkin-patch patch-string comment)
(vc-call-backend backend 'checkin files comment rev))
(mapc #'vc-delete-automatic-version-backups files))
`((vc-state . up-to-date)
(vc-checkout-time . ,(file-attribute-modification-time
(file-attributes file)))
(vc-working-revision . nil)))
(message "Checking in %s...done" (vc-delistify files)))
;; RCS 5.7 gripes about whitespace-only comments too.
(unless (and comment (string-match "[^\t\n ]" comment))
(setq comment "*** empty log message ***"))
(cl-labels ((do-it ()
;; We used to change buffers to get local value of
;; `vc-checkin-switches', but the (singular) local
;; buffer is not well defined for filesets.
(if patch-string
(vc-call-backend backend 'checkin-patch
patch-string comment)
(vc-call-backend backend 'checkin
files comment rev))
(mapc #'vc-delete-automatic-version-backups files)))
(if (and vc-async-checkin
;; Backends which support `vc-async-checkin'.
(memq backend '(Git Hg)))
;; Rely on `vc-set-async-update' to update properties.
(do-it)
(message "Checking in %s..." (vc-delistify files))
(with-vc-properties files (do-it)
`((vc-state . up-to-date)
(vc-checkout-time
. ,(file-attribute-modification-time
(file-attributes file)))
(vc-working-revision . nil)))
(message "Checking in %s...done" (vc-delistify files)))))
'vc-checkin-hook
backend
patch-string))

16
lisp/window.el
View file

@ -10153,14 +10153,14 @@ for `fit-frame-to-buffer'."
;; this may cause lines getting wrapped. To avoid that, round
;; sizes up here which will, however, leave a blank space at the
;; end of the longest line(s).
(setq text-minus-body-width
(+ text-minus-body-width
(- char-width
(% text-minus-body-width char-width))))
(setq text-minus-body-height
(+ text-minus-body-height
(- char-height
(% text-minus-body-height char-height)))))
(let ((remainder (% text-minus-body-width char-width)))
(unless (zerop remainder)
(setq text-minus-body-width
(+ text-minus-body-width (- char-width remainder)))))
(let ((remainder (% text-minus-body-height char-height)))
(unless (zerop remainder)
(setq text-minus-body-height
(+ text-minus-body-height(- char-height remainder))))))
(setq text-width
(if width
(+ width text-minus-body-width)

4
m4/gnulib-common.m4
View file

@ -1630,7 +1630,7 @@ dnl
dnl This macro sets two variables:
dnl - gl_cv_onwards_func_<func> to yes / no / "future OS version"
dnl - ac_cv_func_<func> to yes / no / no
dnl The first variable allows to distinguish all three cases.
dnl The first variable allows distinguishing all three cases.
dnl The second variable is set, so that an invocation
dnl gl_CHECK_FUNCS_ANDROID([func], [[#include <foo.h>]])
dnl can be used as a drop-in replacement for
@ -1683,7 +1683,7 @@ dnl
dnl This macro sets two variables:
dnl - gl_cv_onwards_func_<func> to yes / no / "future OS version"
dnl - ac_cv_func_<func> to yes / no / no
dnl The first variable allows to distinguish all three cases.
dnl The first variable allows distinguishing all three cases.
dnl The second variable is set, so that an invocation
dnl gl_CHECK_FUNCS_MACOS([func], [[#include <foo.h>]])
dnl can be used as a drop-in replacement for

3
nt/inc/sys/stat.h
View file

@ -108,6 +108,9 @@ struct stat {
time_t st_ctime;
char st_uname[260];
char st_gname[260];
int st_atimensec;
int st_mtimensec;
int st_ctimensec;
};
/* These are here to avoid compiler warnings when using wchar.h. */

4
src/buffer.c
View file

@ -1277,8 +1277,8 @@ is first appended to NAME, to speed up finding a non-existent buffer. */)
genbase = name;
else
{
enum { bug_52711 = true }; /* https://bugs.gnu.org/57211 */
char number[bug_52711 ? INT_BUFSIZE_BOUND (int) + 1 : sizeof "-999999"];
enum { bug_57211 = true }; /* https://bugs.gnu.org/57211 */
char number[bug_57211 ? INT_BUFSIZE_BOUND (int) + 1 : sizeof "-999999"];
EMACS_INT r = get_random ();
eassume (0 <= r);
int i = r % 1000000;

78
src/eval.c
View file

@ -757,22 +757,39 @@ Internal use only. */)
static union specbinding *
default_toplevel_binding (Lisp_Object symbol)
{
union specbinding *binding = NULL;
union specbinding *pdl = specpdl_ptr;
while (pdl > specpdl)
for (union specbinding *pdl = specpdl; pdl < specpdl_ptr; ++pdl)
{
switch ((--pdl)->kind)
switch (pdl->kind)
{
case SPECPDL_LET_DEFAULT:
case SPECPDL_LET:
if (EQ (specpdl_symbol (pdl), symbol))
binding = pdl;
return pdl;
break;
default: break;
}
}
return binding;
return NULL;
}
static union specbinding *
local_toplevel_binding (Lisp_Object symbol, Lisp_Object buf)
{
for (union specbinding *pdl = specpdl; pdl < specpdl_ptr; ++pdl)
{
switch (pdl->kind)
{
case SPECPDL_LET_LOCAL:
if (BASE_EQ (specpdl_where (pdl), buf)
&& EQ (specpdl_symbol (pdl), symbol))
return pdl;
break;
default: break;
}
}
return NULL;
}
/* Look for a lexical-binding of SYMBOL somewhere up the stack.
@ -829,6 +846,53 @@ DEFUN ("set-default-toplevel-value", Fset_default_toplevel_value,
return Qnil;
}
DEFUN ("buffer-local-toplevel-value",
Fbuffer_local_toplevel_value,
Sbuffer_local_toplevel_value, 1, 2, 0,
doc: /* Return SYMBOL's toplevel buffer-local value in BUFFER.
"Toplevel" means outside of any let binding.
BUFFER defaults to the current buffer.
If SYMBOL has no local value in BUFFER, signals an error. */)
(Lisp_Object symbol, Lisp_Object buffer)
{
if (NILP (buffer))
buffer = Fcurrent_buffer ();
if (NILP (Flocal_variable_p (symbol, buffer)))
xsignal1 (Qvoid_variable, symbol);
union specbinding *binding = local_toplevel_binding (symbol, buffer);
return binding
? specpdl_old_value (binding)
: Fbuffer_local_value (symbol, buffer);
}
DEFUN ("set-buffer-local-toplevel-value",
Fset_buffer_local_toplevel_value,
Sset_buffer_local_toplevel_value, 2, 3, 0,
doc: /* Set SYMBOL's toplevel buffer-local value in BUFFER to VALUE.
"Toplevel" means outside of any let-binding.
BUFFER defaults to the current buffer.
Makes SYMBOL buffer-local in BUFFER if it was not already. */)
(Lisp_Object symbol, Lisp_Object value, Lisp_Object buffer)
{
Lisp_Object buf = !NILP (buffer) ? buffer : Fcurrent_buffer ();
union specbinding *binding = local_toplevel_binding (symbol, buf);
if (binding)
set_specpdl_old_value (binding, value);
else if (NILP (buffer))
Fset (Fmake_local_variable (symbol), value);
else
{
specpdl_ref count = SPECPDL_INDEX ();
record_unwind_current_buffer ();
Fset_buffer (buffer);
Fset (Fmake_local_variable (symbol), value);
unbind_to (count, Qnil);
}
return Qnil;
}
DEFUN ("internal--define-uninitialized-variable",
Finternal__define_uninitialized_variable,
Sinternal__define_uninitialized_variable, 1, 2, 0,
@ -4574,6 +4638,8 @@ alist of active lexical bindings. */);
defsubr (&Smake_interpreted_closure);
defsubr (&Sdefault_toplevel_value);
defsubr (&Sset_default_toplevel_value);
defsubr (&Sbuffer_local_toplevel_value);
defsubr (&Sset_buffer_local_toplevel_value);
defsubr (&Sdefvar);
defsubr (&Sdefvar_1);
defsubr (&Sdefvaralias);

89
src/frame.c
View file

@ -2206,24 +2206,39 @@ candidate_frame (Lisp_Object candidate, Lisp_Object frame, Lisp_Object minibuf)
static Lisp_Object
next_frame (Lisp_Object frame, Lisp_Object minibuf)
{
Lisp_Object f, tail;
int passed = 0;
Lisp_Object f, tail, next = Qnil;
bool passed = false;
eassume (CONSP (Vframe_list));
while (passed < 2)
FOR_EACH_FRAME (tail, f)
{
if (passed)
{
f = candidate_frame (f, frame, minibuf);
if (!NILP (f))
return f;
}
if (EQ (frame, f))
passed++;
}
return frame;
FOR_EACH_FRAME (tail, f)
{
if (EQ (f, frame))
/* If we encounter FRAME, set PASSED to true. */
passed = true;
else
{
f = candidate_frame (f, frame, minibuf);
if (!NILP (f))
{
if (passed)
/* If we passed FRAME already, return first suitable
candidate following it. */
return f;
else if (NILP (next))
/* If we didn't pass FRAME and have no suitable
candidate yet, set NEXT to the first suitable
candidate preceding FRAME. */
next = f;
}
}
}
/* We have scanned all frames. Return first candidate preceding FRAME
if we have found one. Otherwise return FRAME regardless of whether
it is a suitable candidate or not. */
return NILP (next) ? frame : next;
}
/* Return the previous frame in the frame list before FRAME. */
@ -2238,21 +2253,26 @@ prev_frame (Lisp_Object frame, Lisp_Object minibuf)
FOR_EACH_FRAME (tail, f)
{
if (EQ (frame, f) && !NILP (prev))
/* If we encounter FRAME and already have found a suitable
candidate preceding it, return that candidate. */
return prev;
f = candidate_frame (f, frame, minibuf);
if (!NILP (f))
/* PREV is always the last suitable candidate we found. */
prev = f;
}
/* We've scanned the entire list. */
if (NILP (prev))
/* We went through the whole frame list without finding a single
acceptable frame. Return the original frame. */
acceptable frame. Return FRAME. */
return frame;
else
/* There were no acceptable frames in the list before FRAME; otherwise,
we would have returned directly from the loop. Since PREV is the last
acceptable frame in the list, return it. */
/* There were no acceptable frames in the list before FRAME;
otherwise, we would have returned directly from the loop. Since
PREV is the last suitable frame in the list, return it. */
return prev;
}
@ -2260,7 +2280,7 @@ prev_frame (Lisp_Object frame, Lisp_Object minibuf)
DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
doc: /* Return the next frame in the frame list after FRAME.
Only frames on the same terminal as FRAME are included in the list
of candidate frames. If omitted, FRAME defaults to the selected frame.
of candidate frames. FRAME defaults to the selected frame.
If MINIFRAME is nil (the default), include all frames except
minibuffer-only frames.
@ -2272,7 +2292,9 @@ If MINIFRAME is `visible', include only visible frames.
If MINIFRAME is 0, include only visible and iconified frames.
If MINIFRAME is any other value, include all frames. */)
If MINIFRAME is any other value, include all frames.
Return FRAME if no suitable next frame is found. */)
(Lisp_Object frame, Lisp_Object miniframe)
{
if (NILP (frame))
@ -2283,15 +2305,22 @@ If MINIFRAME is any other value, include all frames. */)
DEFUN ("previous-frame", Fprevious_frame, Sprevious_frame, 0, 2, 0,
doc: /* Return the previous frame in the frame list before FRAME.
It considers only frames on the same terminal as FRAME.
By default, skip minibuffer-only frames.
If omitted, FRAME defaults to the selected frame.
If optional argument MINIFRAME is nil, exclude minibuffer-only frames.
If MINIFRAME is a window, include only its own frame
and any frame now using that window as the minibuffer.
If MINIFRAME is `visible', include all visible frames.
If MINIFRAME is 0, include all visible and iconified frames.
Otherwise, include all frames. */)
Only frames on the same terminal as FRAME are included in the list
of candidate frames. FRAME defaults to the selected frame.
If MINIFRAME is nil (the default), include all frames except
minibuffer-only frames.
If MINIFRAME is a window, include only its own frame and any frame now
using that window as the minibuffer.
If MINIFRAME is `visible', include only visible frames.
If MINIFRAME is 0, include only visible and iconified frames.
If MINIFRAME is any other value, include all frames.
Return FRAME if no suitable previous frame is found. */)
(Lisp_Object frame, Lisp_Object miniframe)
{
if (NILP (frame))

33
src/haikufont.c
View file

@ -890,25 +890,32 @@ haikufont_close (struct font *font)
return;
block_input ();
if (info && info->be_font)
if (info->be_font)
BFont_close (info->be_font);
for (i = 0; i < info->metrics_nrows; i++)
{
if (info->metrics[i])
xfree (info->metrics[i]);
}
if (info->metrics)
xfree (info->metrics);
for (i = 0; i < 0x100; ++i)
{
if (info->glyphs[i])
xfree (info->glyphs[i]);
for (i = 0; i < info->metrics_nrows; i++)
{
if (info->metrics[i])
xfree (info->metrics[i]);
}
xfree (info->metrics);
}
xfree (info->glyphs);
if (info->glyphs)
{
for (i = 0; i < 0x100; ++i)
{
if (info->glyphs[i])
xfree (info->glyphs[i]);
}
xfree (info->glyphs);
}
info->metrics = NULL;
info->glyphs = NULL;
info->be_font = NULL;
unblock_input ();
}

3
src/lisp.h
View file

@ -3752,7 +3752,7 @@ extern void defvar_kboard (struct Lisp_Fwd const *, char const *);
These are used in the syms_of_FILENAME functions.
An ordinary (not in buffer_defaults, per-buffer, or per-keyboard)
lisp variable is actually a field in `struct emacs_globals'. The
Lisp variable is actually a field in `struct emacs_globals'. The
field's name begins with "f_", which is a convention enforced by
these macros. Each such global has a corresponding #define in
globals.h; the plain name should be used in the code.
@ -3799,6 +3799,7 @@ extern void defvar_kboard (struct Lisp_Fwd const *, char const *);
- The specpdl stack keeps track of backtraces, unwind-protects and
dynamic let-bindings. It is allocated from the 'specpdl' array,
a manually managed stack.
("pdl" stands for "push-down list" which just means "stack".)
- The handler stack keeps track of active catch tags and condition-case
handlers. It is allocated in a manually managed stack implemented by a
doubly-linked list allocated via xmalloc and never freed. */

2
src/lread.c
View file

@ -4214,7 +4214,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
if (c == 'r' || c == 'R')
{
/* #NrDIGITS -- radix-N number */
if (n < 0 || n > 36)
if (n < 2 || n > 36)
invalid_radix_integer (n, readcharfun);
obj = read_integer (readcharfun, n);
break;

18
src/treesit.c
View file

@ -757,6 +757,7 @@ treesit_load_language (Lisp_Object language_symbol,
error = NULL;
handle = NULL;
Lisp_Object loaded_lib = Qnil;
FOR_EACH_TAIL (tail)
{
char *library_name = SSDATA (XCAR (tail));
@ -764,7 +765,10 @@ treesit_load_language (Lisp_Object language_symbol,
handle = dynlib_open (library_name);
error = dynlib_error ();
if (error == NULL)
break;
{
loaded_lib = XCAR (tail);
break;
}
else
error_list = Fcons (build_string (error), error_list);
}
@ -808,9 +812,15 @@ treesit_load_language (Lisp_Object language_symbol,
ts_parser_delete (parser);
if (!success)
{
Lisp_Object fmt =
build_string ("%s's ABI version is %d, but supported versions are %d-%d");
Lisp_Object formatted_msg =
CALLN (Fformat_message, fmt, loaded_lib,
make_fixnum (ts_language_version (lang)),
make_fixnum (TREE_SITTER_MIN_COMPATIBLE_LANGUAGE_VERSION),
make_fixnum (TREE_SITTER_LANGUAGE_VERSION));
*signal_symbol = Qtreesit_load_language_error;
*signal_data = list2 (Qversion_mismatch,
make_fixnum (ts_language_version (lang)));
*signal_data = list2 (Qlang_version_mismatch, formatted_msg);
return loaded_lang;
}
@ -5091,7 +5101,7 @@ syms_of_treesit (void)
DEFSYM (Qnot_found, "not-found");
DEFSYM (Qsymbol_error, "symbol-error");
DEFSYM (Qversion_mismatch, "version-mismatch");
DEFSYM (Qlang_version_mismatch, "language-grammar-version-mismatch");
DEFSYM (Qtreesit_error, "treesit-error");
DEFSYM (Qtreesit_query_error, "treesit-query-error");

170
src/w32.c
View file

@ -4108,6 +4108,69 @@ logon_network_drive (const char *path)
}
}
/* Subroutine of faccessat. Determines attributes of FILE (which is
assumed to be in UTF-8 and after map_w32_filename) as reported by
GetFileAttributes. Returns -1 if it fails (meaning the file doesn't
exist or cannot be accessed by the current user), otherwise returns
the bitmap of file's attributes. */
static DWORD
access_attrs (const char *file)
{
DWORD attrs;
if (w32_unicode_filenames)
{
wchar_t file_w[MAX_PATH];
filename_to_utf16 (file, file_w);
attrs = GetFileAttributesW (file_w);
}
else
{
char file_a[MAX_PATH];
filename_to_ansi (file, file_a);
attrs = GetFileAttributesA (file_a);
}
if (attrs == -1)
{
DWORD w32err = GetLastError ();
switch (w32err)
{
case ERROR_INVALID_NAME:
case ERROR_BAD_PATHNAME:
if (is_unc_volume (file))
{
attrs = unc_volume_file_attributes (file);
if (attrs == -1)
{
errno = EACCES;
return -1;
}
return attrs;
}
/* FALLTHROUGH */
FALLTHROUGH;
case ERROR_FILE_NOT_FOUND:
case ERROR_PATH_NOT_FOUND:
case ERROR_INVALID_DRIVE:
case ERROR_NOT_READY:
case ERROR_BAD_NETPATH:
case ERROR_BAD_NET_NAME:
errno = ENOENT;
break;
default:
errno = EACCES;
break;
}
return -1;
}
return attrs;
}
/* Emulate faccessat(2). */
int
faccessat (int dirfd, const char * path, int mode, int flags)
@ -4142,65 +4205,26 @@ faccessat (int dirfd, const char * path, int mode, int flags)
/* MSVCRT implementation of 'access' doesn't recognize D_OK, and its
newer versions blow up when passed D_OK. */
path = map_w32_filename (path, NULL);
attributes = access_attrs (path);
if (attributes == -1) /* PATH doesn't exist or is inaccessible */
return -1;
/* If the last element of PATH is a symlink, we need to resolve it
to get the attributes of its target file. Note: any symlinks in
PATH elements other than the last one are transparently resolved
by GetFileAttributes below. */
int not_a_symlink = ((attributes & FILE_ATTRIBUTE_REPARSE_POINT) == 0);
if ((volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) != 0
&& (flags & AT_SYMLINK_NOFOLLOW) == 0)
path = chase_symlinks (path);
if (w32_unicode_filenames)
&& (flags & AT_SYMLINK_NOFOLLOW) == 0
&& !not_a_symlink)
{
wchar_t path_w[MAX_PATH];
filename_to_utf16 (path, path_w);
attributes = GetFileAttributesW (path_w);
}
else
{
char path_a[MAX_PATH];
filename_to_ansi (path, path_a);
attributes = GetFileAttributesA (path_a);
path = chase_symlinks (path);
attributes = access_attrs (path);
if (attributes == -1)
return -1;
}
if (attributes == -1)
{
DWORD w32err = GetLastError ();
switch (w32err)
{
case ERROR_INVALID_NAME:
case ERROR_BAD_PATHNAME:
if (is_unc_volume (path))
{
attributes = unc_volume_file_attributes (path);
if (attributes == -1)
{
errno = EACCES;
return -1;
}
goto check_attrs;
}
/* FALLTHROUGH */
FALLTHROUGH;
case ERROR_FILE_NOT_FOUND:
case ERROR_PATH_NOT_FOUND:
case ERROR_INVALID_DRIVE:
case ERROR_NOT_READY:
case ERROR_BAD_NETPATH:
case ERROR_BAD_NET_NAME:
errno = ENOENT;
break;
default:
errno = EACCES;
break;
}
return -1;
}
check_attrs:
if ((mode & X_OK) != 0
&& !(is_exec (path) || (attributes & FILE_ATTRIBUTE_DIRECTORY) != 0))
{
@ -5076,9 +5100,10 @@ initialize_utc_base (void)
}
static time_t
convert_time (FILETIME ft)
convert_time (FILETIME ft, int *time_nsec)
{
ULONGLONG tmp;
time_t time_sec;
if (!init)
{
@ -5090,7 +5115,10 @@ convert_time (FILETIME ft)
return 0;
FILETIME_TO_U64 (tmp, ft);
return (time_t) ((tmp - utc_base) / 10000000L);
tmp -= utc_base;
time_sec = (time_t) (tmp / 10000000L);
*time_nsec = (tmp - (ULONGLONG) time_sec * 10000000L) * 100L;
return time_sec;
}
static void
@ -5707,11 +5735,19 @@ stat_worker (const char * path, struct stat * buf, int follow_symlinks)
buf->st_nlink = nlinks;
/* Convert timestamps to Unix format. */
buf->st_mtime = convert_time (wtime);
buf->st_atime = convert_time (atime);
if (buf->st_atime == 0) buf->st_atime = buf->st_mtime;
buf->st_ctime = convert_time (ctime);
if (buf->st_ctime == 0) buf->st_ctime = buf->st_mtime;
buf->st_mtime = convert_time (wtime, &buf->st_mtimensec);
buf->st_atime = convert_time (atime, &buf->st_atimensec);
if (buf->st_atime == 0)
{
buf->st_atime = buf->st_mtime;
buf->st_atimensec = buf->st_mtimensec;
}
buf->st_ctime = convert_time (ctime, &buf->st_ctimensec);
if (buf->st_ctime == 0)
{
buf->st_ctime = buf->st_mtime;
buf->st_ctimensec = buf->st_mtimensec;
}
/* determine rwx permissions */
if (is_a_symlink && !follow_symlinks)
@ -5853,11 +5889,19 @@ fstat (int desc, struct stat * buf)
buf->st_size += info.nFileSizeLow;
/* Convert timestamps to Unix format. */
buf->st_mtime = convert_time (info.ftLastWriteTime);
buf->st_atime = convert_time (info.ftLastAccessTime);
if (buf->st_atime == 0) buf->st_atime = buf->st_mtime;
buf->st_ctime = convert_time (info.ftCreationTime);
if (buf->st_ctime == 0) buf->st_ctime = buf->st_mtime;
buf->st_mtime = convert_time (info.ftLastWriteTime, &buf->st_mtimensec);
buf->st_atime = convert_time (info.ftLastAccessTime, &buf->st_atimensec);
if (buf->st_atime == 0)
{
buf->st_atime = buf->st_mtime;
buf->st_atimensec = buf->st_mtimensec;
}
buf->st_ctime = convert_time (info.ftCreationTime, &buf->st_ctimensec);
if (buf->st_ctime == 0)
{
buf->st_ctime = buf->st_mtime;
buf->st_ctimensec = buf->st_mtimensec;
}
/* determine rwx permissions */
if (info.dwFileAttributes & FILE_ATTRIBUTE_READONLY)

3
test/Makefile.in
View file

@ -273,7 +273,8 @@ SUBDIR_TARGETS =
define subdir_template
SUBDIR_TARGETS += check-$(subst /,-,$(1))
.PHONY: check-$(subst /,-,$(1))
check-$(subst /,-,$(1)):
check-$(subst /,-,$(1)): \
$(patsubst %,check-%,$(subst /,-,$(wildcard $(1)/*-tests)))
@${MAKE} check LOGFILES="$(patsubst %.el,%.log, \
$(patsubst $(srcdir)/%,%,$(wildcard ${srcdir}/$(1)/*.el)))"
endef

6
test/README
View file

@ -53,9 +53,9 @@ following targets:
Like "make check", but run all tests.
* make check-<dirname>
Like "make check", but run only the tests in test/<dirname>/*.el.
<dirname> is a relative directory path, which has replaced "/" by "-",
like in "check-src" or "check-lisp-net".
Like "make check", but run only the tests in test/<dirname>/*.el and
test/<dirname>/*-tests/*.el. <dirname> is a relative directory path,
which has replaced "/" by "-", like in "check-src" or "check-lisp-net".
* make <filename> -or- make <filename>.log
Run all tests declared in <filename>.el. This includes expensive

8
test/infra/Dockerfile.emba
View file

@ -140,7 +140,13 @@ RUN src/emacs -Q --batch \
--eval '(message "treesit-language-source-alist\n%s" \
(pp-to-string treesit-language-source-alist))' \
--eval '(dolist (lang (sort (mapcar (quote car) treesit-language-source-alist))) \
(message "%s ABI version %d" lang (treesit-language-abi-version lang)))'
(message "%s ABI version %d" lang (treesit-language-abi-version lang)))' \
-l admin/tree-sitter/treesit-admin.el \
--eval '(setq treesit-admin--builtin-language-sources treesit-language-source-alist)' \
-f treesit-admin-check-manual-coverage \
--eval '(treesit-admin--generate-compatibility-report \
(list (expand-file-name "src/emacs")) treesit-admin--builtin-modes \
(expand-file-name "compatibility-report.html"))'
FROM emacs-base as emacs-gnustep

18
test/infra/Makefile.in
View file

@ -53,14 +53,6 @@ define subdir_template
@echo ' - changes:' >>$(FILE)
@echo ' - $(1)/*.{h,c}' >>$(FILE)
endef
else ifeq ($(findstring eieio, $(1)), eieio)
define changes
@echo ' - lisp/emacs-lisp/eieio*.el' >>$(FILE)
endef
else ifeq ($(findstring faceup, $(1)), faceup)
define changes
@echo ' - lisp/emacs-lisp/faceup*.el' >>$(FILE)
endef
else ifeq ($(findstring progmodes, $(1)), progmodes)
define changes
@echo ' - $(1)/eglot.el' >>$(FILE)
@ -72,10 +64,6 @@ define subdir_template
@echo ' - changes:' >>$(FILE)
@echo ' - $(1)/*.el' >>$(FILE)
endef
else ifeq ($(findstring so-long, $(1)), so-long)
define changes
@echo ' - lisp/so-long*.el' >>$(FILE)
endef
else ifeq ($(findstring textmodes, $(1)), textmodes)
define changes
@echo ' - $(1)/*-ts-mode.el' >>$(FILE)
@ -108,6 +96,9 @@ define subdir_template
@echo ' when: never' >>$(FILE)
@echo ' - changes:' >>$(FILE)
$(changes)
$(foreach subdir, $(notdir $(wildcard ../$(1)/*-tests)),
@echo ' - test/$(1)/$(subdir)/*resources/**' >>$(FILE)
@echo ' - test/$(1)/$(subdir)/*.el' >>$(FILE))
@echo ' - test/$(1)/*resources/**' >>$(FILE)
@echo ' - test/$(1)/*.el' >>$(FILE)
@echo ' variables:' >>$(FILE)
@ -115,7 +106,8 @@ define subdir_template
@echo ' make_params: -C test $(target)' >>$(FILE)
endef
$(foreach subdir, $(SUBDIRS), $(eval $(call subdir_template,$(subdir))))
$(foreach subdir, $(filter-out %-tests,$(SUBDIRS)), \
$(eval $(call subdir_template,$(subdir))))
TREE-SITTER-FILES ?= $(shell cd .. ; \
find lisp src -name "*-tests.el" | xargs grep -El "treesit.*-p" | \

5
test/infra/gitlab-ci.yml
View file

@ -110,9 +110,10 @@ default:
# - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export ${test_name} | tar -tvf - )
# Prepare test artifacts.
- test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name}
- test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/configure.log ${test_name}
- test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/configure.log ${test_name} || true
- test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/compatibility-report.html ${test_name} || true
- test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name}
- find ${test_name} ! \( -name "*.log" -o -name ${EMACS_TEST_JUNIT_REPORT} \) -type f -delete
- find ${test_name} ! \( -name "*.log" -o -name ${EMACS_TEST_JUNIT_REPORT} -o -name compatibility-report.html \) -type f -delete
# BusyBox find does not know -empty.
- find ${test_name} -type d -depth -exec rmdir {} + 2>/dev/null

59
test/infra/test-jobs.yml
View file

@ -28,6 +28,8 @@ test-lisp-inotify:
when: never
- changes:
- lisp/*.el
- test/lisp/so-long-tests/*resources/**
- test/lisp/so-long-tests/*.el
- test/lisp/*resources/**
- test/lisp/*.el
variables:
@ -147,46 +149,16 @@ test-lisp-emacs-lisp-inotify:
when: never
- changes:
- lisp/emacs-lisp/*.el
- test/lisp/emacs-lisp/eieio-tests/*resources/**
- test/lisp/emacs-lisp/eieio-tests/*.el
- test/lisp/emacs-lisp/faceup-tests/*resources/**
- test/lisp/emacs-lisp/faceup-tests/*.el
- test/lisp/emacs-lisp/*resources/**
- test/lisp/emacs-lisp/*.el
variables:
target: emacs-igc
make_params: -C test check-lisp-emacs-lisp
test-lisp-emacs-lisp-eieio-tests-inotify:
stage: normal
extends: [.job-template, .test-template]
needs:
- job: build-image-inotify
optional: true
rules:
- if: '$CI_PIPELINE_SOURCE == "schedule"'
when: never
- changes:
- lisp/emacs-lisp/eieio*.el
- test/lisp/emacs-lisp/eieio-tests/*resources/**
- test/lisp/emacs-lisp/eieio-tests/*.el
variables:
target: emacs-igc
make_params: -C test check-lisp-emacs-lisp-eieio-tests
test-lisp-emacs-lisp-faceup-tests-inotify:
stage: normal
extends: [.job-template, .test-template]
needs:
- job: build-image-inotify
optional: true
rules:
- if: '$CI_PIPELINE_SOURCE == "schedule"'
when: never
- changes:
- lisp/emacs-lisp/faceup*.el
- test/lisp/emacs-lisp/faceup-tests/*resources/**
- test/lisp/emacs-lisp/faceup-tests/*.el
variables:
target: emacs-igc
make_params: -C test check-lisp-emacs-lisp-faceup-tests
test-lisp-emulation-inotify:
stage: normal
extends: [.job-template, .test-template]
@ -432,23 +404,6 @@ test-lisp-progmodes-inotify:
target: emacs-igc
make_params: -C test check-lisp-progmodes
test-lisp-so-long-tests-inotify:
stage: normal
extends: [.job-template, .test-template]
needs:
- job: build-image-inotify
optional: true
rules:
- if: '$CI_PIPELINE_SOURCE == "schedule"'
when: never
- changes:
- lisp/so-long*.el
- test/lisp/so-long-tests/*resources/**
- test/lisp/so-long-tests/*.el
variables:
target: emacs-igc
make_params: -C test check-lisp-so-long-tests
test-lisp-term-inotify:
stage: normal
extends: [.job-template, .test-template]
@ -533,6 +488,8 @@ test-lisp-vc-inotify:
when: never
- changes:
- lisp/vc/*.el
- test/lisp/vc/vc-tests/*resources/**
- test/lisp/vc/vc-tests/*.el
- test/lisp/vc/*resources/**
- test/lisp/vc/*.el
variables:

16
test/lisp/calendar/icalendar-tests.el
View file

@ -132,6 +132,22 @@
(car result)))
(should (string= "Sommerferien" (cdr result)))))
(ert-deftest icalendar--convert-float-to-ical ()
"Test method for `icalendar--convert-float-to-ical'."
;; See Bug#78085
(let* ((calendar-date-style 'iso)
(icalendar-recurring-start-year 2025)
(first-saturday-date "20250104") ; first Sat. in 2025
result)
(setq result (icalendar--convert-float-to-ical
"" "%%(diary-float t 6 1) 1st Sat/month"))
(should (consp result))
(should (string= (concat
"\nDTSTART;VALUE=DATE:" first-saturday-date
"\nRRULE:FREQ=MONTHLY;BYDAY=1SA")
(car result)))
(should (string= "1st Sat/month" (cdr result)))))
(ert-deftest icalendar--convert-yearly-to-ical ()
"Test method for `icalendar--convert-yearly-to-ical'."
(let* ((calendar-date-style 'iso)

4
test/lisp/emacs-lisp/cl-extra-tests.el
View file

@ -351,7 +351,7 @@
;;;; Method dispatch for derived types.
(cl-deftype multiples-of (&optional m)
(let ((multiplep (if (eq m '*)
(let ((multiplep (if (memq m '(nil *))
#'ignore
(lambda (n) (= 0 (% n m))))))
`(and integer (satisfies ,multiplep))))
@ -368,7 +368,7 @@
(cl-deftype unsigned-byte (&optional bits)
"Unsigned integer."
`(integer 0 ,(if (eq bits '*) bits (1- (ash 1 bits)))))
`(integer 0 ,(if (memq bits '(nil *)) bits (1- (ash 1 bits)))))
(cl-deftype unsigned-16bits ()
"Unsigned 16-bits integer."

31
test/lisp/emacs-lisp/lisp-tests.el
View file

@ -238,6 +238,37 @@
(ert-deftest core-elisp-tests-3-backquote ()
(should (eq 3 (eval ``,,'(+ 1 2) t))))
(defvar-local c-e-l 'foo)
(ert-deftest core-elisp-tests-4-toplevel-values ()
(setq-default c-e-l 'foo)
(let ((c-e-l 'bar))
(let ((c-e-l 'baz))
(setq-default c-e-l 'bar)
(should (eq c-e-l 'bar))
(should (eq (default-toplevel-value 'c-e-l) 'foo))
(set-default-toplevel-value 'c-e-l 'baz)
(should (eq c-e-l 'bar))
(should (eq (default-toplevel-value 'c-e-l) 'baz))))
(let ((c-e-u 'foo))
(should (condition-case _
(default-toplevel-value 'c-e-u)
(void-variable t))))
(with-temp-buffer
(setq-local c-e-l 'bar)
(should (eq (buffer-local-toplevel-value 'c-e-l) 'bar))
(let ((c-e-l 'baz))
(let ((c-e-l 'quux))
(setq-local c-e-l 'baz)
(should (eq c-e-l 'baz))
(should (eq (buffer-local-toplevel-value 'c-e-l) 'bar))
(set-buffer-local-toplevel-value 'c-e-l 'foo)
(should (eq c-e-l 'baz))
(should (eq (buffer-local-toplevel-value 'c-e-l) 'foo)))))
(with-temp-buffer
(should (condition-case _
(buffer-local-toplevel-value 'c-e-l)
(void-variable t)))))
;; Test up-list and backward-up-list.
(defun lisp-run-up-list-test (fn data start instructions)
(cl-labels ((posof (thing)

21
test/lisp/minibuffer-tests.el
View file

@ -108,7 +108,26 @@
(should (equal (completion-try-completion input
#'completion--file-name-table
nil (length input))
(cons output (length output)))))))
(cons output (length output)))))
;; Everything also works with `completion-ignore-case'.
(let ((completion-ignore-case t))
(pcase-dolist (`(,input ,output)
'(
("data/M-CTTQ" "data/minibuffer-test-cttq$$tion")
("data/M-CTTQ$$t" "data/minibuffer-test-cttq$$tion")
;; When an env var is in the completion bounds, try-completion
;; won't change letter case.
("lisp/c${CTTQ1}E" "lisp/c${CTTQ1}Et/")
("lisp/ced${CTTQ2}SE-U" "lisp/ced${CTTQ2}SEmantic-utest")
;; If the env var is before the completion bounds, try-completion
;; *will* change letter case.
("lisp/c${CTTQ1}et/SE-U" "lisp/c${CTTQ1}et/semantic-utest")
("lis/c${CTTQ1}/SE-U" "lisp/c${CTTQ1}et/semantic-utest")
))
(should (equal (car (completion-try-completion input
#'completion--file-name-table
nil (length input)))
output))))))
(ert-deftest completion--insert-strings-faces ()
(with-temp-buffer

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

@ -5054,14 +5054,20 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
ipv6-postfix tramp-postfix-host-format)))
;; The hop string fits only the initial syntax.
(hop (and (eq tramp-syntax orig-syntax) hop))
;; Needed for host name completion.
(default-user
(file-remote-p
(concat tramp-prefix-format hop method-string host-string)
'user))
(default-user-string
(unless (tramp-string-empty-or-nil-p default-user)
(concat default-user tramp-postfix-user-format)))
test result completions)
(dolist
(test-and-result
;; These are triples of strings (TEST-STRING
;; RESULT-CHECK COMPLETION-CHECK). RESULT-CHECK
;; could be not unique, in this case it is a list
;; (RESULT1 RESULT2 ...).
;; RESULT-CHECK COMPLETION-CHECK).
(append
;; Complete method name.
(unless (string-empty-p tramp-method-regexp)
@ -5087,11 +5093,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
ipv6-prefix
(substring-no-properties
host 0 (min 2 (length host))))
(,(concat
tramp-prefix-format hop method-string host-string)
,(concat
tramp-prefix-format hop method-string
user-string host-string))
,(concat
tramp-prefix-format hop method-string
default-user-string host-string)
,host-string)))
;; Complete user and host name.
(unless (or (tramp-string-empty-or-nil-p user)
@ -5132,14 +5136,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; (tramp--test-message
;; "syntax: %s style: %s test: %s result: %s"
;; syntax style test result)
(if (stringp (cadr test-and-result))
(should
(string-prefix-p (cadr test-and-result) result))
(should
(let (res)
(dolist (elem (cadr test-and-result) res)
(setq
res (or res (string-prefix-p elem result))))))))
(should (string-prefix-p (cadr test-and-result) result)))
(with-current-buffer "*Completions*"
;; We must remove leading `default-directory'.
@ -5393,6 +5390,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
;; Some `cat' implementations do not support the `cat -'
;; call. We skip then.
(skip-unless
(not
(string-match-p (rx "cat: -: input file is output file\n")
(buffer-string))))
(should (string-match-p "foo" (buffer-string))))
;; Cleanup.
@ -5587,6 +5590,12 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
;; Some `cat' implementations do not support the `cat -'
;; call. We skip then.
(skip-unless
(not
(string-match-p (rx "cat: -: input file is output file\n")
(buffer-string))))
(should (string-match-p "foo" (buffer-string))))
;; Cleanup.
@ -7336,7 +7345,7 @@ This does not support external Emacs calls."
(tramp-method-out-of-band-p tramp-test-vec 1))
(defun tramp--test-putty-p ()
"Check, whether the method method usaes PuTTY.
"Check, whether the method uses PuTTY.
This does not support connection share for more than two connections."
(member
(file-remote-p ert-remote-temporary-file-directory 'method)
@ -7353,6 +7362,15 @@ This does not support special file names."
(string-equal
"rsync" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-scp-p ()
"Check, whether an scp method is used.
This does not support quoted special characters in recent sshd
implementations."
;; Detected with OpenSSH_9.9p1.
(member
(file-remote-p ert-remote-temporary-file-directory 'method)
'("pscp" "scp" "scpx")))
(defun tramp--test-sh-p ()
"Check, whether the remote host runs a based method from tramp-sh.el."
(tramp-sh-file-name-handler-p tramp-test-vec))
@ -7725,6 +7743,7 @@ This requires restrictions of file name syntax."
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s
(skip-unless (not (tramp--test-container-p)))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-scp-p)))
(skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-gdrive-p)))

9
test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
View file

@ -93,6 +93,15 @@ const foo = () => {
};
=-=-=
Name: Chained ternary expressions
=-=
const a = cond1 ? 1
: cond2 ? 2
: cond3 ? 3
: 4;
=-=-=
Code:
(lambda ()
(setq tsx-ts-mode-indent-offset 2)

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

@ -122,7 +122,7 @@ agnostic of init.defaultbranch."
(write-region "hello" nil "README")
(vc-git-test--run "add" "README")
(vc-git-test--run "commit" "-mFirst")
(string-trim (vc-git-test--run "branch" "--show-current")))
(string-trim (vc-git-test--run "rev-parse" "--abbrev-ref" "HEAD")))
(defun vc-git-test--dir-headers (headers)
"Return an alist of header values as they would appear in `vc-dir'.

6
test/lisp/vc/vc-misc-tests.el → test/lisp/vc/vc-tests/vc-test-misc.el
View file

@ -1,4 +1,4 @@
;;; vc-misc-tests.el --- backend-agnostic VC tests -*- lexical-binding:t -*-
;;; vc-test-misc.el --- backend-agnostic VC tests -*- lexical-binding:t -*-
;; Copyright (C) 2025 Free Software Foundation, Inc.
@ -63,5 +63,5 @@
(should (equal (test-it `(Git ("missing" ,temp "present")))
missing+present))))))
(provide 'vc-misc-tests)
;;; vc-misc-tests.el ends here
(provide 'vc-test-misc)
;;; vc-test-misc.el ends here

5
test/lisp/vc/vc-tests.el → test/lisp/vc/vc-tests/vc-tests.el
View file

@ -785,6 +785,11 @@ This checks also `vc-backend' and `vc-responsible-backend'."
;; `vc-mtn.el' gives me:
;; "Failed (status 1): mtn commit -m Testing vc-version-diff\n\n foo"
(skip-when (memq ',backend '(Mtn)))
;; `vc-hg.el' gives me, only on MS-Windows and only in batch mode:
;; "Failed (status 255): hg --config ui.report_untrusted=0 commit -m Testing vc-version-diff\n\n foo"
(skip-when (and (memq ',backend '(Hg))
(eq system-type 'windows-nt)
noninteractive))
(vc-test--version-diff ',backend))
))))

19
test/src/fileio-tests.el
View file

@ -217,4 +217,23 @@ Also check that an encoding error can appear in a symlink."
(should-not (file-exists-p "//"))
(should (file-attributes "//")))
(ert-deftest fileio-tests-w32-time-stamp-granularity ()
"Test 100-nsec granularity of file time stamps on MS-Windows."
(skip-unless (eq system-type 'windows-nt))
;; FIXME: This only works on NTFS volumes, so should skip the test if
;; not NTFS. But we don't expose the filesystem type to Lisp.
(let ((tfile (make-temp-file "tstamp")))
(unwind-protect
(progn
(set-file-times tfile (encode-time '(59.123456789 15 23 01 02 2025)))
(should
(equal (format-time-string "%Y/%m/%d %H:%M:%S.%N"
(file-attribute-modification-time
(file-attributes tfile)))
;; Last 2 digits of seconds must be zero due to
;; 100-nsec resolution of Windows file time stamps.
"2025/02/01 23:15:59.123456700")))
(delete-file tfile))))
;;; fileio-tests.el ends here

19
test/src/filelock-tests.el
View file

@ -123,10 +123,7 @@ the case)."
(filelock-tests--fixture
(filelock-tests--spoil-lock-file buffer-file-truename)
(let ((err (should-error (file-locked-p (buffer-file-name)))))
(should (equal (seq-subseq err 0 2)
(if (eq system-type 'windows-nt)
'(permission-denied "Testing file lock")
'(file-error "Testing file lock")))))))
(should (equal (seq-subseq err 0 2) '(file-error "Testing file lock"))))))
(ert-deftest filelock-tests-unlock-spoiled ()
"Check that `unlock-buffer' fails if the lockfile is \"spoiled\"."
@ -142,11 +139,8 @@ the case)."
;; `userlock--handle-unlock-error' (bug#46397).
(cl-letf (((symbol-function 'userlock--handle-unlock-error)
(lambda (err) (signal (car err) (cdr err)))))
(should (equal
(if (eq system-type 'windows-nt)
'(permission-denied "Unlocking file")
'(file-error "Unlocking file"))
(seq-subseq (should-error (unlock-buffer)) 0 2))))))
(should (equal '(file-error "Unlocking file")
(seq-subseq (should-error (unlock-buffer)) 0 2))))))
(ert-deftest filelock-tests-kill-buffer-spoiled ()
"Check that `kill-buffer' fails if a lockfile is \"spoiled\"."
@ -168,11 +162,8 @@ the case)."
(cl-letf (((symbol-function 'yes-or-no-p) #'always)
((symbol-function 'userlock--handle-unlock-error)
(lambda (err) (signal (car err) (cdr err)))))
(should (equal
(if (eq system-type 'windows-nt)
'(permission-denied "Unlocking file")
'(file-error "Unlocking file"))
(seq-subseq (should-error (kill-buffer)) 0 2))))))
(should (equal '(file-error "Unlocking file")
(seq-subseq (should-error (kill-buffer)) 0 2))))))
(ert-deftest filelock-tests-detect-external-change ()
"Check that an external file modification is reported."