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

Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk

Browse source
This commit is contained in:
Yuuki Harano 2021-07-25 23:34:55 +09:00
commit 13a9a5e836
127 changed files with 4170 additions and 1478 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
admin/merge-gnulib
View file

@ -33,7 +33,7 @@ GNULIB_MODULES='
crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer
d-type diffseq double-slash-root dtoastr dtotimespec dup2
environ execinfo explicit_bzero faccessat
fchmodat fcntl fcntl-h fdopendir
fchmodat fcntl fcntl-h fdopendir file-has-acl
filemode filename filevercmp flexmember fpieee
free-posix fstatat fsusage fsync futimens
getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog

20
doc/emacs/custom.texi
View file

@ -623,7 +623,7 @@ button.
the theme file and asks if you really want to load it. Because
loading a Custom theme can execute arbitrary Lisp code, you should
only say yes if you know that the theme is safe; in that case, Emacs
offers to remember in the future that the theme is safe (this is done
offers to remember in the future that the theme is safe(this is done
by saving the theme file's SHA-256 hash to the variable
@code{custom-safe-themes}; if you want to treat all themes as safe,
change its value to @code{t}). Themes that come with Emacs (in the
@ -1271,7 +1271,13 @@ confirmation prompt. When Emacs encounters these variable/value pairs
subsequently, in the same file or others, it will assume they are
safe.
You can also tell Emacs to permanently ignore all the variable/value
pairs in the file, by typing @kbd{i} at the confirmation prompt --
these pairs will thereafter be ignored in this file and in all other
files.
@vindex safe-local-variable-values
@vindex ignored-local-variable-values
@cindex risky variable
Some variables, such as @code{load-path}, are considered
particularly @dfn{risky}: there is seldom any reason to specify them
@ -1283,6 +1289,8 @@ can enter @kbd{!} at the prompt. It applies all the variables, but only
marks the non-risky ones as safe for the future. If you really want to
record safe values for risky variables, do it directly by customizing
@samp{safe-local-variable-values} (@pxref{Easy Customization}).
Similarly, if you want to record values of risky variables that should
be permanently ignored, customize @code{ignored-local-variable-values}.
@vindex enable-local-variables
The variable @code{enable-local-variables} allows you to change the
@ -1407,6 +1415,16 @@ meanings as they would have in file local variables. @code{coding}
cannot be specified as a directory local variable. @xref{File
Variables}.
The special key @code{auto-mode-alist} in a @file{.dir-locals.el} lets
you set a file's major mode. It works much like the variable
@code{auto-mode-alist} (@pxref{Choosing Modes}). For example, here is
how you can tell Emacs that @file{.def} source files in this directory
should be in C mode:
@example
((auto-mode-alist . (("\\.def\\'" . c-mode))))
@end example
@findex add-dir-local-variable
@findex delete-dir-local-variable
@findex copy-file-locals-to-dir-locals

5
doc/emacs/misc.texi
View file

@ -1021,7 +1021,10 @@ pending in the shell buffer and not yet sent.
@findex comint-delete-output
Delete the last batch of output from a shell command
(@code{comint-delete-output}). This is useful if a shell command spews
out lots of output that just gets in the way.
out lots of output that just gets in the way. With a prefix argument,
this command saves the deleted text in the @code{kill-ring}
(@pxref{Kill Ring}), so that you could later yank it (@pxref{Yanking})
elsewhere.
@item C-c C-s
@kindex C-c C-s @r{(Shell mode)}

10
doc/emacs/modes.texi
View file

@ -357,8 +357,12 @@ preferences. If you personally want to use a minor mode for a
particular file type, it is better to enable the minor mode via a
major mode hook (@pxref{Major Modes}).
Second, Emacs checks whether the file's extension matches an entry
in any directory-local @code{auto-mode-alist}. These are found using
the @file{.dir-locals.el} facility (@pxref{Directory Variables}).
@vindex interpreter-mode-alist
Second, if there is no file variable specifying a major mode, Emacs
Third, if there is no file variable specifying a major mode, Emacs
checks whether the file's contents begin with @samp{#!}. If so, that
indicates that the file can serve as an executable shell command,
which works by running an interpreter named on the file's first line
@ -376,7 +380,7 @@ same is true for man pages which start with the magic string
@samp{'\"} to specify a list of troff preprocessors.
@vindex magic-mode-alist
Third, Emacs tries to determine the major mode by looking at the
Fourth, Emacs tries to determine the major mode by looking at the
text at the start of the buffer, based on the variable
@code{magic-mode-alist}. By default, this variable is @code{nil} (an
empty list), so Emacs skips this step; however, you can customize it
@ -404,7 +408,7 @@ where @var{match-function} is a Lisp function that is called at the
beginning of the buffer; if the function returns non-@code{nil}, Emacs
set the major mode with @var{mode-function}.
Fourth---if Emacs still hasn't found a suitable major mode---it
Fifth---if Emacs still hasn't found a suitable major mode---it
looks at the file's name. The correspondence between file names and
major modes is controlled by the variable @code{auto-mode-alist}. Its
value is a list in which each element has this form,

11
doc/emacs/search.texi
View file

@ -1971,6 +1971,17 @@ it never deletes lines that are only partially contained in the region
(a newline that ends a line counts as part of that line).
If a match is split across lines, this command keeps all those lines.
@findex kill-matching-lines
@item M-x kill-matching-lines
Like @code{flush-lines}, but also add the matching lines to the kill
ring. The command adds the matching lines to the kill ring as a
single string, including the newlines that separated the lines.
@findex copy-matching-lines
@item M-x copy-matching-lines
Like @code{kill-matching-lines}, but the matching lines are not
removed from the buffer.
@end table
@node Search Customizations

4
doc/lispref/buffers.texi
View file

@ -1183,7 +1183,7 @@ buffer.
the base buffer effectively kills the indirect buffer in that it cannot
ever again be the current buffer.
@deffn Command make-indirect-buffer base-buffer name &optional clone
@deffn Command make-indirect-buffer base-buffer name &optional clone inhibit-buffer-hooks
This creates and returns an indirect buffer named @var{name} whose
base buffer is @var{base-buffer}. The argument @var{base-buffer} may
be a live buffer or the name (a string) of an existing buffer. If
@ -1199,6 +1199,8 @@ If @var{base-buffer} is an indirect buffer, its base buffer is used as
the base for the new buffer. If, in addition, @var{clone} is
non-@code{nil}, the initial state is copied from the actual base
buffer, not from @var{base-buffer}.
@xref{Creating Buffers}, for the meaning of @var{inhibit-buffer-hooks}.
@end deffn
@deffn Command clone-indirect-buffer newname display-flag &optional norecord

14
doc/lispref/commands.texi
View file

@ -3381,6 +3381,12 @@ nil)}. This is the same thing that quitting does. (See @code{signal}
in @ref{Errors}.)
@end deffn
To quit without aborting a keyboard macro definition or execution,
you can signal the @code{minibuffer-quit} condition. This has almost
the same effect as the @code{quit} condition except that the error
handling in the command loop handles it without exiting keyboard macro
definition or execution.
You can specify a character other than @kbd{C-g} to use for quitting.
See the function @code{set-input-mode} in @ref{Input Modes}.
@ -3565,12 +3571,14 @@ commands.
@code{recursive-edit}. This function contains the command loop; it also
contains a call to @code{catch} with tag @code{exit}, which makes it
possible to exit the recursive editing level by throwing to @code{exit}
(@pxref{Catch and Throw}). If you throw a value other than @code{t},
then @code{recursive-edit} returns normally to the function that called
it. The command @kbd{C-M-c} (@code{exit-recursive-edit}) does this.
(@pxref{Catch and Throw}). If you throw a @code{nil} value, then
@code{recursive-edit} returns normally to the function that called it.
The command @kbd{C-M-c} (@code{exit-recursive-edit}) does this.
Throwing a @code{t} value causes @code{recursive-edit} to quit, so that
control returns to the command loop one level up. This is called
@dfn{aborting}, and is done by @kbd{C-]} (@code{abort-recursive-edit}).
You can also throw a function value. In that case,
@code{recursive-edit} will call it without arguments before returning.
Most applications should not use recursive editing, except as part of
using the minibuffer. Usually it is more convenient for the user if you

9
doc/lispref/display.texi
View file

@ -1861,9 +1861,12 @@ from the buffer.
@item keymap
@cindex keymap of character (and overlays)
@kindex keymap @r{(overlay property)}
If this property is non-@code{nil}, it specifies a keymap for a portion of the
text. This keymap is used when the character after point is within the
overlay, and takes precedence over most other keymaps. @xref{Active Keymaps}.
If this property is non-@code{nil}, it specifies a keymap for a
portion of the text. This keymap takes precedence over most other
keymaps (@pxref{Active Keymaps}), and it is used when point is within
the overlay, where the front-
and rear-advance properties define whether the boundaries are
considered as being @emph{within} or not.
@item local-map
@kindex local-map @r{(overlay property)}

9
doc/lispref/errors.texi
View file

@ -20,8 +20,9 @@ the errors in accessing files have the condition @code{file-error}. If
we do not say here that a certain error symbol has additional error
conditions, that means it has none.
As a special exception, the error symbol @code{quit} does not have the
condition @code{error}, because quitting is not considered an error.
As a special exception, the error symbols @code{quit} and
@code{minibuffer-quit} don't have the condition @code{error}, because
quitting is not considered an error.
Most of these error symbols are defined in C (mainly @file{data.c}),
but some are defined in Lisp. For example, the file @file{userlock.el}
@ -40,6 +41,10 @@ The message is @samp{error}. @xref{Errors}.
@item quit
The message is @samp{Quit}. @xref{Quitting}.
@item minibuffer-quit
The message is @samp{Quit}. This is a subcategory of @code{quit}.
@xref{Quitting}.
@item args-out-of-range
The message is @samp{Args out of range}. This happens when trying to
access an element beyond the range of a sequence, buffer, or other

3
doc/lispref/eval.texi
View file

@ -350,7 +350,8 @@ Here is how you could define @code{indirect-function} in Lisp:
@example
(defun indirect-function (function)
(if (symbolp function)
(if (and function
(symbolp function))
(indirect-function (symbol-function function))
function))
@end example

53
doc/lispref/files.texi
View file

@ -2343,49 +2343,26 @@ entirely of directory separators.
@end example
@end defun
Given a directory name, you can combine it with a relative file name
using @code{concat}:
@defun file-name-concat directory &rest components
Concatenate @var{components} to @var{directory}, inserting a slash
before the components if @var{directory} or the preceding component
didn't end with a slash.
@example
(concat @var{dirname} @var{relfile})
@group
(file-name-concat "/tmp" "foo")
@result{} "/tmp/foo"
@end group
@end example
@noindent
Be sure to verify that the file name is relative before doing that.
If you use an absolute file name, the results could be syntactically
invalid or refer to the wrong file.
A @var{directory} or components that are @code{nil} or the empty
string are ignored---they are filtered out first and do not affect the
results in any way.
If you want to use a directory file name in making such a
combination, you must first convert it to a directory name using
@code{file-name-as-directory}:
@example
(concat (file-name-as-directory @var{dirfile}) @var{relfile})
@end example
@noindent
Don't try concatenating a slash by hand, as in
@example
;;; @r{Wrong!}
(concat @var{dirfile} "/" @var{relfile})
@end example
@noindent
because this is not portable. Always use
@code{file-name-as-directory}.
To avoid the issues mentioned above, or if the @var{dirname} value
might be @code{nil} (for example, from an element of @code{load-path}),
use:
@example
(expand-file-name @var{relfile} @var{dirname})
@end example
However, @code{expand-file-name} expands leading @samp{~} in
@var{relfile}, which may not be what you want. @xref{File Name
Expansion}.
This is almost the same as using @code{concat}, but @var{dirname} (and
the non-final components) may or may not end with slash characters,
and this function will not double those characters.
@end defun
To convert a directory name to its abbreviation, use this
function:

2
doc/lispref/hooks.texi
View file

@ -184,7 +184,7 @@ The command loop runs this soon after @code{post-command-hook} (q.v.).
@item mouse-leave-buffer-hook
@vindex mouse-leave-buffer-hook
Hook run when about to switch windows with a mouse command.
Hook run when the user mouse-clicks in a window.
@item mouse-position-function
@xref{Mouse Position}.

11
doc/lispref/modes.texi
View file

@ -2287,11 +2287,14 @@ enabled separately in each buffer.
@defvar global-mode-string
This variable holds a mode line construct that, by default, appears in
the mode line just after the @code{which-function-mode} minor mode if set,
else after @code{mode-line-modes}. The command @code{display-time} sets
the mode line just after the @code{which-function-mode} minor mode if
set, else after @code{mode-line-modes}. Elements that are added to
this construct should normally end in a space (to ensure that
consecutive @code{global-mode-string} elements display properly). For
instance, the command @code{display-time} sets
@code{global-mode-string} to refer to the variable
@code{display-time-string}, which holds a string containing the time and
load information.
@code{display-time-string}, which holds a string containing the time
and load information.
The @samp{%M} construct substitutes the value of
@code{global-mode-string}, but that is obsolete, since the variable is

9
doc/lispref/text.texi
View file

@ -5301,11 +5301,20 @@ represents @code{@{@}}, the empty JSON object; not @code{null},
@code{false}, or an empty array, all of which are different JSON
values.
@defun json-available-p
This predicate returns non-@code{nil} if Emacs has been built with
@acronym{JSON} support, and the library is available on the current
system.
@end defun
If some Lisp object can't be represented in JSON, the serialization
functions will signal an error of type @code{wrong-type-argument}.
The parsing functions can also signal the following errors:
@table @code
@item json-unavailable
Signaled when the parsing library isn't available.
@item json-end-of-file
Signaled when encountering a premature end of the input text.

14
doc/lispref/variables.texi
View file

@ -1995,6 +1995,20 @@ Doing so adds those variable/value pairs to
file.
@end defopt
@defopt ignored-local-variable-values
If there are some values of particular local variables that you always
want to ignore completely, you can use this variable. Its value has
the same form as @code{safe-local-variable-values}; a file-local
variable setting to the value that appears in the list will always be
ignored when processing the local variables specified by the file. As
with that variable, when Emacs queries the user about whether to obey
file-local variables, the user can choose to ignore their particular
values permanently, and that will alter this variable and save it to
the user's custom file. Variable-value pairs that appear in this
variable take precedence over the same pairs in
@code{safe-local-variable-values}.
@end defopt
@defun safe-local-variable-p sym val
This function returns non-@code{nil} if it is safe to give @var{sym}
the value @var{val}, based on the above criteria.

2
doc/misc/gnus.texi
View file

@ -16288,7 +16288,7 @@ cleaning up the headers. Functions that can be used include:
Clear leading white space that ``helpful'' listservs have added to the
headers to make them look nice. Aaah.
(Note that this function works on both the header on the body of all
(Note that this function works on both the header and the body of all
messages, so it is a potentially dangerous function to use (if a body
of a message contains something that looks like a header line). So
rather than fix the bug, it is of course the right solution to make it

10
doc/misc/smtpmail.texi
View file

@ -338,6 +338,16 @@ not sent immediately but rather queued in the directory
@code{smtpmail-send-queued-mail} (typically when you connect to the
internet).
@item smtpmail-store-queue-variables
@vindex smtpmail-store-queue-variables
Normally the queue will be dispatched with the values of the
@acronym{SMTP} variables that are in effect when @kbd{M-x
smtpmail-send-queued-mail} is executed, but if
@code{smtpmail-store-queue-variables} is non-@code{nil}, the values
for @code{smtpmail-smtp-server} (etc.@:) will be stored when the mail is
queued, and then used when actually sending the mail. This can be
useful if you have a complex outgoing mail setup.
@item smtpmail-queue-dir
@vindex smtpmail-queue-dir
The variable @code{smtpmail-queue-dir} specifies the name of the

182
etc/NEWS
View file

@ -91,6 +91,10 @@ proper pty support that Emacs needs.
* Startup Changes in Emacs 28.1
---
** File names given on the command line will now be pushed onto
'file-name-history'.
---
** In GTK builds, Emacs now supports startup notification.
This means that Emacs won't steal keyboard focus upon startup
@ -114,6 +118,15 @@ avoid security issues when executing untrusted code. See the manual
page for 'seccomp' system call, for details about Secure Computing
filters.
** Setting 'fill-column' to nil is obsolete.
This undocumented use of 'fill-column' is now obsolete. To disable
auto filling, turn off 'auto-fill-mode' instead.
For instance, you could add something like the following to your init
file:
(add-hook 'foo-mode-hook (lambda () (auto-fill-mode -1))
* Changes in Emacs 28.1
@ -335,6 +348,10 @@ by dragging the tab lines of their topmost windows with the mouse.
* Editing Changes in Emacs 28.1
---
** Dragging a file to Emacs will now also push the name of the file
onto 'file-name-history'.
+++
** A prefix arg now causes 'delete-other-frames' to only iconify frames.
@ -476,6 +493,11 @@ highlighting on heading lines using standard outline faces. This
works well only when there are no conflicts with faces used by the
major mode.
** New commands 'copy-matching-lines' and 'kill-matching-lines'.
These commands are similar to the command 'flush-lines',
but add the matching lines to the kill ring as a single string,
including the newlines that separate the lines.
* Changes in Specialized Modes and Packages in Emacs 28.1
@ -581,6 +603,11 @@ indentation is done using SMIE or with the old ad-hoc code.
** Icomplete
---
*** New user option 'icomplete-matches-format'.
This allows controlling the current/total number of matches for the
prompt prefix.
+++
*** New minor mode 'icomplete-vertical-mode', alias 'fido-vertical-mode'.
This mode is intended to be used with Icomplete ('M-x icomplete-mode')
@ -868,6 +895,12 @@ keys, add the following to your init file:
** Change Logs and VC
*** vc-git now sets the GIT_LITERAL_PATHSPECS environment variable.
This ensures that Git operations on files containing wildcard
characters work as they're supposed to. However, this also affects
scripts running from Git hooks, and these have to "unset
GIT_LITERAL_PATHSPECS" to work as before.
*** More VC commands can be used from non-file buffers.
The relevant commands are those that don't change the VC state.
The non-file buffers which can use VC commands are those that have
@ -1109,6 +1142,12 @@ take the actual screenshot, and defaults to "ImageMagick import".
** Smtpmail
+++
*** New user option 'smtpmail-store-queue-variables'.
If non-nil, SMTP variables will be stored together with the queued
messages, and will then be used when sending with
'M-x smtpmail-send-queued-mail'.
+++
*** Allow direct selection of smtp authentication mechanism.
A server entry retrieved by auth-source can request a desired smtp
@ -1421,6 +1460,10 @@ If non-nil, 'shell-mode' handles implicit "cd" commands, changing the
directory if the command is a directory. Useful for shells like "zsh"
that has this feature.
+++
*** 'comint-delete-output' can now save deleted text in the kill-ring.
Interactively, 'C-u C-c C-o' triggers this new optional behavior.
** Eshell
---
@ -1558,6 +1601,10 @@ See the new user options 'package-name-column-width',
** gdb-mi
*** New user option 'gdb-registers-enable-filter'.
If non-nil, apply a register filter based on
'gdb-registers-filter-pattern-list'.
+++
*** gdb-mi can now store and restore window configurations.
Use 'gdb-save-window-configuration' to save window configuration to a
@ -1592,12 +1639,28 @@ Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options.
** Compilation mode
---
*** New function 'ansi-color-compilation-filter'.
This function is meant to be used in 'compilation-filter-hook'.
---
*** New user option 'ansi-color-for-compilation-mode'.
This controls what 'ansi-color-compilation-filter' does.
*** Regexp matching of messages is now case-sensitive by default.
The variable 'compilation-error-case-fold-search' can be set for
case-insensitive matching of messages when the old behavior is
required, but the recommended solution is to use a correctly matching
regexp instead.
---
*** New user option 'compilation-search-all-directories'.
When doing parallel builds, directories and compilation errors may
arrive in the "*compilation*" buffer out-of-order. If this variable is
non-nil (the default), Emacs will now search backwards in the buffer
for any directory the file with errors may be in. If nil, this won't
be done (and this restores how this previously worked).
---
*** Messages from ShellCheck are now recognized.
@ -1986,6 +2049,27 @@ used instead. Uses of 'json-encode-list' should be changed to call
one of 'json-encode', 'json-encode-alist', 'json-encode-plist', or
'json-encode-array' instead.
** json.c
+++
*** New function 'json-available-p'.
This predicate returns non-nil if Emacs is built with libjansson
support, and it is available on the current system.
+++
*** Native JSON functions now signal an error if libjansson is unavailable.
This affects 'json-serialize', 'json-insert', 'json-parse-srtring',
and 'json-parse-buffer'. This can happen if Emacs was compiled with
libjansson, but the DLL cannot be found and/or loaded by Emacs at run
time. Previously, Emacs would display a message and return nil in
these cases.
*** The JSON functions 'json-serialize', 'json-insert',
'json-parse-string', and 'json-parse-buffer' now implement some of the
semantics of RFC 8259 instead of the earlier RFC 4627. In particular,
these functions now accept top-level JSON values that are neither
arrays nor objects.
** xml.el
*** XML serialization functions now reject invalid characters.
@ -2214,6 +2298,28 @@ This command, called interactively, toggles the local value of
** Miscellaneous
+++
*** .dir-locals.el now supports setting 'auto-mode-alist'.
The new 'auto-mode-alist' specification in .dir-local.el files can now
be used to override the global 'auto-mode-alist' in the current
directory tree.
---
*** New utility function 'make-separator-line'.
---
*** New face 'separator-line'.
This is used by 'make-separator-line'.
+++
*** New user option 'ignored-local-variable-values'.
This is the opposite of 'safe-local-variable-values' -- it's an alist
of variable-value pairs that are to be ignored when reading a
local-variables section of a file.
---
*** 'indent-tabs-mode' is now a global minor mode instead of just a variable.
---
*** New user option 'save-place-abbreviate-file-names'.
@ -2225,6 +2331,9 @@ previously no easy way to get back to the original displayed order
after sorting, but giving a -1 numerical prefix to the sorting command
will now restore the original order.
---
*** 'M-left' and 'M-right' now move between columns in 'tabulated-list-mode'.
+++
*** New utility function 'insert-into-buffer'.
This is like 'insert-buffer-substring', but works in the opposite
@ -2357,14 +2466,6 @@ doesn't turn on 'display-fill-column-indicator-mode' in special-mode
buffers. This can be controlled by customizing the variable
'global-display-fill-column-indicator-modes'.
---
*** New user option 'compilation-search-all-directories'.
When doing parallel builds, directories and compilation errors may
arrive in the "*compilation*" buffer out-of-order. If this variable is
non-nil (the default), Emacs will now search backwards in the buffer
for any directory the file with errors may be in. If nil, this won't
be done (and this restores how this previously worked).
+++
*** New user option 'next-error-message-highlight'.
In addition to a fringe arrow, 'next-error' error may now optionally
@ -2418,20 +2519,6 @@ If non-nil (the default), revealed text is automatically hidden when
point leaves the text. If nil, the text is not hidden again. Instead
'M-x reveal-hide-revealed' can be used to hide all the revealed text.
+++
*** New user options to control the look of line/column numbers in the mode line.
'mode-line-position-line-format' is the line number format (when
'line-number-mode' is on), 'mode-line-position-column-format' is
the column number format (when 'column-number-mode' is on), and
'mode-line-position-column-line-format' is the combined format (when
both modes are on).
+++
*** New user option 'mode-line-compact'.
If non-nil, repeating spaces are compressed into a single space. If
'long', this is only done when the mode line is longer than the
current window width (in characters).
+++
*** New command 'submit-emacs-patch'.
This works like 'report-emacs-bug', but is more geared towards sending
@ -2636,6 +2723,15 @@ also keep the type information of their arguments. Use the
---
*** New face 'perl-heredoc', used for heredoc elements.
+++
** A function can now be thrown to the 'exit' label in addition to t or nil.
The command loop will call it with zero arguments before returning.
+++
** New error symbol 'minibuffer-quit'.
Signaling it has almost the same effect as 'quit' except that it
doesn't cause keyboard macro termination.
---
*** The command 'cperl-set-style' offers the new value "PBP".
This value customizes Emacs to use the style recommended in Damian
@ -2722,6 +2818,9 @@ similar to prefix arguments, but are more flexible and discoverable.
* Incompatible Editing Changes in Emacs 28.1
** 'revert-buffer' will now preserve buffer-readedness.
It previously switched the read-only flag off.
** 'electric-indent-mode' now also indents inside strings and comments,
(unless the indentation function doesn't, of course).
To recover the previous behavior you can use:
@ -2774,6 +2873,14 @@ This is to keep the same behavior as Eshell.
* Incompatible Lisp Changes in Emacs 28.1
---
** 'kill-all-local-variables' has changed how it handles non-symbol hooks.
The function is documented to eliminated all buffer-local bindings
except variables with a 'permanent-local' property, or hooks that
have elements with a 'permanent-local-hook' property. In addition, it
would also keep lambda expressions in hooks sometimes. The latter has
now been changed: The function will now also remove these.
---
** Some floating-point numbers are now handled differently by the Lisp reader.
In previous versions of Emacs, numbers with a trailing dot and an exponent
@ -3001,6 +3108,10 @@ The former is now declared obsolete.
* Lisp Changes in Emacs 28.1
+++
*** New function 'file-name-concat'.
This appends path components to a directory name and returns the result.
+++
*** New function 'split-string-shell-command'.
This splits a shell command string into separate components,
@ -3229,6 +3340,27 @@ file mode specification into symbolic form.
** The variable 'force-new-style-backquotes' has been removed.
This removes the final remaining trace of old-style backquotes.
** Mode Lines
+++
*** New user options to control the line/column numbers in the mode line.
'mode-line-position-line-format' is the line number format (when
'line-number-mode' is on), 'mode-line-position-column-format' is
the column number format (when 'column-number-mode' is on), and
'mode-line-position-column-line-format' is the combined format (when
both modes are on).
+++
*** New user option 'mode-line-compact'.
If non-nil, repeating spaces are compressed into a single space. If
'long', this is only done when the mode line is longer than the
current window width (in characters).
+++
*** 'global-mode-string' constructs should end with a space.
This was previously not formalized, which led to combinations of modes
displaying data "smushed together" on the mode line.
** Changes in handling dynamic modules
*** The module header 'emacs-module.h' now contains type aliases
@ -3410,12 +3542,6 @@ locales. They are also available as aliases 'ebcdic-cp-*' (e.g.,
'cp278' for 'ibm278'). There are also new charsets 'ibm2xx' to
support these coding-systems.
** The JSON functions 'json-serialize', 'json-insert',
'json-parse-string', and 'json-parse-buffer' now implement some of the
semantics of RFC 8259 instead of the earlier RFC 4627. In particular,
these functions now accept top-level JSON values that are neither
arrays nor objects.
---
** 'while-no-input-ignore-events' accepts more special events.
The special events 'dbus-event' and 'file-notify' are now ignored in

226
lib-src/emacsclient.c
View file

@ -80,6 +80,9 @@ char *w32_getenv (const char *);
#include <sys/stat.h>
#include <unistd.h>
#ifndef WINDOWSNT
# include <acl.h>
#endif
#include <filename.h>
#include <intprops.h>
#include <min-max.h>
@ -91,6 +94,10 @@ char *w32_getenv (const char *);
# pragma GCC diagnostic ignored "-Wformat-truncation=2"
#endif
#if !defined O_PATH && !defined WINDOWSNT
# define O_PATH O_SEARCH
#endif
/* Name used to invoke this program. */
static char const *progname;
@ -1133,24 +1140,74 @@ process_grouping (void)
#ifdef SOCKETS_IN_FILE_SYSTEM
/* Return the file status of NAME, ordinarily a socket.
It should be owned by UID. Return one of the following:
>0 - 'stat' failed with this errno value
-1 - isn't owned by us
0 - success: none of the above */
/* A local socket address. The union avoids the need to cast. */
union local_sockaddr
{
struct sockaddr_un un;
struct sockaddr sa;
};
/* Relative to the directory DIRFD, connect the socket file named ADDR
to the socket S. Return 0 if successful, -1 if DIRFD is not
AT_FDCWD and DIRFD's permissions would allow a symlink attack, an
errno otherwise. */
static int
socket_status (const char *name, uid_t uid)
connect_socket (int dirfd, char const *addr, int s, uid_t uid)
{
struct stat statbfr;
int sock_status = 0;
if (stat (name, &statbfr) != 0)
return errno;
union local_sockaddr server;
if (sizeof server.un.sun_path <= strlen (addr))
return ENAMETOOLONG;
server.un.sun_family = AF_UNIX;
strcpy (server.un.sun_path, addr);
if (statbfr.st_uid != uid)
return -1;
/* If -1, WDFD is not set yet. If nonnegative, WDFD is a file
descriptor for the initial working directory. Otherwise -1 - WDFD is
the error number for the initial working directory. */
static int wdfd = -1;
return 0;
if (dirfd != AT_FDCWD)
{
/* Fail if DIRFD's permissions are bogus. */
struct stat st;
if (fstat (dirfd, &st) != 0)
return errno;
if (st.st_uid != uid || (st.st_mode & (S_IWGRP | S_IWOTH)))
return -1;
if (wdfd == -1)
{
/* Save the initial working directory. */
wdfd = open (".", O_PATH | O_CLOEXEC);
if (wdfd < 0)
wdfd = -1 - errno;
}
if (wdfd < 0)
return -1 - wdfd;
if (fchdir (dirfd) != 0)
return errno;
/* Fail if DIRFD has an ACL, which means its permissions are
almost surely bogus. */
int has_acl = file_has_acl (".", &st);
if (has_acl)
sock_status = has_acl < 0 ? errno : -1;
}
if (!sock_status)
sock_status = connect (s, &server.sa, sizeof server.un) == 0 ? 0 : errno;
/* Fail immediately if we cannot change back to the initial working
directory, as that can mess up the rest of execution. */
if (dirfd != AT_FDCWD && fchdir (wdfd) != 0)
{
message (true, "%s: .: %s\n", progname, strerror (errno));
exit (EXIT_FAILURE);
}
return sock_status;
}
@ -1327,32 +1384,49 @@ act_on_signals (HSOCKET emacs_socket)
}
}
/* Create in SOCKNAME (of size SOCKNAMESIZE) a name for a local socket.
The first TMPDIRLEN bytes of SOCKNAME are already initialized to be
the name of a temporary directory. Use UID and SERVER_NAME to
concoct the name. Return the total length of the name if successful,
-1 if it does not fit (and store a truncated name in that case).
Fail if TMPDIRLEN is out of range. */
enum { socknamesize = sizeof ((struct sockaddr_un *) NULL)->sun_path };
/* Given a local socket S, create in *SOCKNAME a name for a local socket
and connect to that socket. The first TMPDIRLEN bytes of *SOCKNAME are
already initialized to be the name of a temporary directory.
Use UID and SERVER_NAME to concoct the name. Return 0 if
successful, -1 if the socket's parent directory is not safe, and an
errno if there is some other problem. */
static int
local_sockname (char *sockname, int socknamesize, int tmpdirlen,
uintmax_t uid, char const *server_name)
local_sockname (int s, char sockname[socknamesize], int tmpdirlen,
uid_t uid, char const *server_name)
{
/* If ! (0 <= TMPDIRLEN && TMPDIRLEN < SOCKNAMESIZE) the truncated
temporary directory name is already in SOCKNAME, so nothing more
need be stored. */
if (0 <= tmpdirlen)
{
int remaining = socknamesize - tmpdirlen;
if (0 < remaining)
{
int suffixlen = snprintf (&sockname[tmpdirlen], remaining,
"/emacs%"PRIuMAX"/%s", uid, server_name);
if (0 <= suffixlen && suffixlen < remaining)
return tmpdirlen + suffixlen;
}
}
return -1;
if (! (0 <= tmpdirlen && tmpdirlen < socknamesize))
return ENAMETOOLONG;
/* Put the full address name into the buffer, since the caller might
need it for diagnostics. But don't overrun the buffer. */
uintmax_t uidmax = uid;
int emacsdirlen;
int suffixlen = snprintf (sockname + tmpdirlen, socknamesize - tmpdirlen,
"/emacs%"PRIuMAX"%n/%s", uidmax, &emacsdirlen,
server_name);
if (! (0 <= suffixlen && suffixlen < socknamesize - tmpdirlen))
return ENAMETOOLONG;
/* Make sure the address's parent directory is not a symlink and is
this user's directory and does not let others write to it; this
fends off some symlink attacks. To avoid races, keep the parent
directory open while checking. */
char *emacsdirend = sockname + tmpdirlen + emacsdirlen;
*emacsdirend = '\0';
int dir = openat (AT_FDCWD, sockname,
O_PATH | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC);
*emacsdirend = '/';
if (dir < 0)
return errno;
int sock_status = connect_socket (dir, server_name, s, uid);
close (dir);
return sock_status;
}
/* Create a local socket for SERVER_NAME and connect it to Emacs. If
@ -1363,28 +1437,43 @@ local_sockname (char *sockname, int socknamesize, int tmpdirlen,
static HSOCKET
set_local_socket (char const *server_name)
{
union {
struct sockaddr_un un;
struct sockaddr sa;
} server = {{ .sun_family = AF_UNIX }};
union local_sockaddr server;
int sock_status;
char *sockname = server.un.sun_path;
enum { socknamesize = sizeof server.un.sun_path };
int tmpdirlen = -1;
int socknamelen = -1;
uid_t uid = geteuid ();
bool tmpdir_used = false;
int s = cloexec_socket (AF_UNIX, SOCK_STREAM, 0);
if (s < 0)
{
message (true, "%s: can't create socket: %s\n",
progname, strerror (errno));
fail ();
}
if (strchr (server_name, '/')
|| (ISSLASH ('\\') && strchr (server_name, '\\')))
socknamelen = snprintf (sockname, socknamesize, "%s", server_name);
{
socknamelen = snprintf (sockname, socknamesize, "%s", server_name);
sock_status = (0 <= socknamelen && socknamelen < socknamesize
? connect_socket (AT_FDCWD, sockname, s, 0)
: ENAMETOOLONG);
}
else
{
/* socket_name is a file name component. */
sock_status = ENOENT;
char const *xdg_runtime_dir = egetenv ("XDG_RUNTIME_DIR");
if (xdg_runtime_dir)
socknamelen = snprintf (sockname, socknamesize, "%s/emacs/%s",
xdg_runtime_dir, server_name);
else
{
socknamelen = snprintf (sockname, socknamesize, "%s/emacs/%s",
xdg_runtime_dir, server_name);
sock_status = (0 <= socknamelen && socknamelen < socknamesize
? connect_socket (AT_FDCWD, sockname, s, 0)
: ENAMETOOLONG);
}
if (sock_status == ENOENT)
{
char const *tmpdir = egetenv ("TMPDIR");
if (tmpdir)
@ -1403,23 +1492,24 @@ set_local_socket (char const *server_name)
if (tmpdirlen < 0)
tmpdirlen = snprintf (sockname, socknamesize, "/tmp");
}
socknamelen = local_sockname (sockname, socknamesize, tmpdirlen,
sock_status = local_sockname (s, sockname, tmpdirlen,
uid, server_name);
tmpdir_used = true;
}
}
if (! (0 <= socknamelen && socknamelen < socknamesize))
if (sock_status == 0)
return s;
if (sock_status == ENAMETOOLONG)
{
message (true, "%s: socket-name %s... too long\n", progname, sockname);
fail ();
}
/* See if the socket exists, and if it's owned by us. */
int sock_status = socket_status (sockname, uid);
if (sock_status)
if (tmpdir_used)
{
/* Failing that, see if LOGNAME or USER exist and differ from
/* See whether LOGNAME or USER exist and differ from
our euid. If so, look for a socket based on the UID
associated with the name. This is reminiscent of the logic
that init_editfns uses to set the global Vuser_full_name. */
@ -1436,48 +1526,26 @@ set_local_socket (char const *server_name)
if (pw && pw->pw_uid != uid)
{
/* We're running under su, apparently. */
socknamelen = local_sockname (sockname, socknamesize, tmpdirlen,
sock_status = local_sockname (s, sockname, tmpdirlen,
pw->pw_uid, server_name);
if (socknamelen < 0)
if (sock_status == 0)
return s;
if (sock_status == ENAMETOOLONG)
{
message (true, "%s: socket-name %s... too long\n",
progname, sockname);
exit (EXIT_FAILURE);
}
sock_status = socket_status (sockname, uid);
}
}
}
if (sock_status == 0)
{
HSOCKET s = cloexec_socket (AF_UNIX, SOCK_STREAM, 0);
if (s < 0)
{
message (true, "%s: socket: %s\n", progname, strerror (errno));
return INVALID_SOCKET;
}
if (connect (s, &server.sa, sizeof server.un) != 0)
{
message (true, "%s: connect: %s\n", progname, strerror (errno));
CLOSE_SOCKET (s);
return INVALID_SOCKET;
}
close (s);
struct stat connect_stat;
if (fstat (s, &connect_stat) != 0)
sock_status = errno;
else if (connect_stat.st_uid == uid)
return s;
else
sock_status = -1;
CLOSE_SOCKET (s);
}
if (sock_status < 0)
message (true, "%s: Invalid socket owner\n", progname);
if (sock_status == -1)
message (true,
"%s: Invalid permissions on parent directory of socket: %s\n",
progname, sockname);
else if (sock_status == ENOENT)
{
if (tmpdir_used)
@ -1507,7 +1575,7 @@ set_local_socket (char const *server_name)
}
}
else
message (true, "%s: can't stat %s: %s\n",
message (true, "%s: can't connect to %s: %s\n",
progname, sockname, strerror (sock_status));
return INVALID_SOCKET;

510
lib/file-has-acl.c Normal file
View file

@ -0,0 +1,510 @@
/* Test whether a file has a nontrivial ACL. -*- coding: utf-8 -*-
Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */
/* Without this pragma, gcc 4.7.0 20120126 may suggest that the
file_has_acl function might be candidate for attribute 'const' */
#if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__
# pragma GCC diagnostic ignored "-Wsuggest-attribute=const"
#endif
#include <config.h>
#include "acl.h"
#include "acl-internal.h"
#if GETXATTR_WITH_POSIX_ACLS
# include <sys/xattr.h>
# include <linux/xattr.h>
#endif
/* Return 1 if NAME has a nontrivial access control list,
0 if ACLs are not supported, or if NAME has no or only a base ACL,
and -1 (setting errno) on error. Note callers can determine
if ACLs are not supported as errno is set in that case also.
SB must be set to the stat buffer of NAME,
obtained through stat() or lstat(). */
int
file_has_acl (char const *name, struct stat const *sb)
{
#if USE_ACL
if (! S_ISLNK (sb->st_mode))
{
# if GETXATTR_WITH_POSIX_ACLS
ssize_t ret;
ret = getxattr (name, XATTR_NAME_POSIX_ACL_ACCESS, NULL, 0);
if (ret < 0 && errno == ENODATA)
ret = 0;
else if (ret > 0)
return 1;
if (ret == 0 && S_ISDIR (sb->st_mode))
{
ret = getxattr (name, XATTR_NAME_POSIX_ACL_DEFAULT, NULL, 0);
if (ret < 0 && errno == ENODATA)
ret = 0;
else if (ret > 0)
return 1;
}
if (ret < 0)
return - acl_errno_valid (errno);
return ret;
# elif HAVE_ACL_GET_FILE
/* POSIX 1003.1e (draft 17 -- abandoned) specific version. */
/* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */
int ret;
if (HAVE_ACL_EXTENDED_FILE) /* Linux */
{
/* On Linux, acl_extended_file is an optimized function: It only
makes two calls to getxattr(), one for ACL_TYPE_ACCESS, one for
ACL_TYPE_DEFAULT. */
ret = acl_extended_file (name);
}
else /* FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */
{
# if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */
/* On Mac OS X, acl_get_file (name, ACL_TYPE_ACCESS)
and acl_get_file (name, ACL_TYPE_DEFAULT)
always return NULL / EINVAL. There is no point in making
these two useless calls. The real ACL is retrieved through
acl_get_file (name, ACL_TYPE_EXTENDED). */
acl_t acl = acl_get_file (name, ACL_TYPE_EXTENDED);
if (acl)
{
ret = acl_extended_nontrivial (acl);
acl_free (acl);
}
else
ret = -1;
# else /* FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */
acl_t acl = acl_get_file (name, ACL_TYPE_ACCESS);
if (acl)
{
int saved_errno;
ret = acl_access_nontrivial (acl);
saved_errno = errno;
acl_free (acl);
errno = saved_errno;
# if HAVE_ACL_FREE_TEXT /* Tru64 */
/* On OSF/1, acl_get_file (name, ACL_TYPE_DEFAULT) always
returns NULL with errno not set. There is no point in
making this call. */
# else /* FreeBSD, IRIX, Cygwin >= 2.5 */
/* On Linux, FreeBSD, IRIX, acl_get_file (name, ACL_TYPE_ACCESS)
and acl_get_file (name, ACL_TYPE_DEFAULT) on a directory
either both succeed or both fail; it depends on the
file system. Therefore there is no point in making the second
call if the first one already failed. */
if (ret == 0 && S_ISDIR (sb->st_mode))
{
acl = acl_get_file (name, ACL_TYPE_DEFAULT);
if (acl)
{
# ifdef __CYGWIN__ /* Cygwin >= 2.5 */
ret = acl_access_nontrivial (acl);
saved_errno = errno;
acl_free (acl);
errno = saved_errno;
# else
ret = (0 < acl_entries (acl));
acl_free (acl);
# endif
}
else
ret = -1;
}
# endif
}
else
ret = -1;
# endif
}
if (ret < 0)
return - acl_errno_valid (errno);
return ret;
# elif HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */
# if defined ACL_NO_TRIVIAL
/* Solaris 10 (newer version), which has additional API declared in
<sys/acl.h> (acl_t) and implemented in libsec (acl_set, acl_trivial,
acl_fromtext, ...). */
return acl_trivial (name);
# else /* Solaris, Cygwin, general case */
/* Solaris 2.5 through Solaris 10, Cygwin, and contemporaneous versions
of Unixware. The acl() call returns the access and default ACL both
at once. */
{
/* Initially, try to read the entries into a stack-allocated buffer.
Use malloc if it does not fit. */
enum
{
alloc_init = 4000 / sizeof (aclent_t), /* >= 3 */
alloc_max = MIN (INT_MAX, SIZE_MAX / sizeof (aclent_t))
};
aclent_t buf[alloc_init];
size_t alloc = alloc_init;
aclent_t *entries = buf;
aclent_t *malloced = NULL;
int count;
for (;;)
{
count = acl (name, GETACL, alloc, entries);
if (count < 0 && errno == ENOSPC)
{
/* Increase the size of the buffer. */
free (malloced);
if (alloc > alloc_max / 2)
{
errno = ENOMEM;
return -1;
}
alloc = 2 * alloc; /* <= alloc_max */
entries = malloced =
(aclent_t *) malloc (alloc * sizeof (aclent_t));
if (entries == NULL)
{
errno = ENOMEM;
return -1;
}
continue;
}
break;
}
if (count < 0)
{
if (errno == ENOSYS || errno == ENOTSUP)
;
else
{
int saved_errno = errno;
free (malloced);
errno = saved_errno;
return -1;
}
}
else if (count == 0)
;
else
{
/* Don't use MIN_ACL_ENTRIES: It's set to 4 on Cygwin, but Cygwin
returns only 3 entries for files with no ACL. But this is safe:
If there are more than 4 entries, there cannot be only the
"user::", "group::", "other:", and "mask:" entries. */
if (count > 4)
{
free (malloced);
return 1;
}
if (acl_nontrivial (count, entries))
{
free (malloced);
return 1;
}
}
free (malloced);
}
# ifdef ACE_GETACL
/* Solaris also has a different variant of ACLs, used in ZFS and NFSv4
file systems (whereas the other ones are used in UFS file systems). */
{
/* Initially, try to read the entries into a stack-allocated buffer.
Use malloc if it does not fit. */
enum
{
alloc_init = 4000 / sizeof (ace_t), /* >= 3 */
alloc_max = MIN (INT_MAX, SIZE_MAX / sizeof (ace_t))
};
ace_t buf[alloc_init];
size_t alloc = alloc_init;
ace_t *entries = buf;
ace_t *malloced = NULL;
int count;
for (;;)
{
count = acl (name, ACE_GETACL, alloc, entries);
if (count < 0 && errno == ENOSPC)
{
/* Increase the size of the buffer. */
free (malloced);
if (alloc > alloc_max / 2)
{
errno = ENOMEM;
return -1;
}
alloc = 2 * alloc; /* <= alloc_max */
entries = malloced = (ace_t *) malloc (alloc * sizeof (ace_t));
if (entries == NULL)
{
errno = ENOMEM;
return -1;
}
continue;
}
break;
}
if (count < 0)
{
if (errno == ENOSYS || errno == EINVAL)
;
else
{
int saved_errno = errno;
free (malloced);
errno = saved_errno;
return -1;
}
}
else if (count == 0)
;
else
{
/* In the old (original Solaris 10) convention:
If there are more than 3 entries, there cannot be only the
ACE_OWNER, ACE_GROUP, ACE_OTHER entries.
In the newer Solaris 10 and Solaris 11 convention:
If there are more than 6 entries, there cannot be only the
ACE_OWNER, ACE_GROUP, ACE_EVERYONE entries, each once with
NEW_ACE_ACCESS_ALLOWED_ACE_TYPE and once with
NEW_ACE_ACCESS_DENIED_ACE_TYPE. */
if (count > 6)
{
free (malloced);
return 1;
}
if (acl_ace_nontrivial (count, entries))
{
free (malloced);
return 1;
}
}
free (malloced);
}
# endif
return 0;
# endif
# elif HAVE_GETACL /* HP-UX */
{
struct acl_entry entries[NACLENTRIES];
int count;
count = getacl (name, NACLENTRIES, entries);
if (count < 0)
{
/* ENOSYS is seen on newer HP-UX versions.
EOPNOTSUPP is typically seen on NFS mounts.
ENOTSUP was seen on Quantum StorNext file systems (cvfs). */
if (errno == ENOSYS || errno == EOPNOTSUPP || errno == ENOTSUP)
;
else
return -1;
}
else if (count == 0)
return 0;
else /* count > 0 */
{
if (count > NACLENTRIES)
/* If NACLENTRIES cannot be trusted, use dynamic memory
allocation. */
abort ();
/* If there are more than 3 entries, there cannot be only the
(uid,%), (%,gid), (%,%) entries. */
if (count > 3)
return 1;
{
struct stat statbuf;
if (stat (name, &statbuf) < 0)
return -1;
return acl_nontrivial (count, entries);
}
}
}
# if HAVE_ACLV_H /* HP-UX >= 11.11 */
{
struct acl entries[NACLVENTRIES];
int count;
count = acl ((char *) name, ACL_GET, NACLVENTRIES, entries);
if (count < 0)
{
/* EOPNOTSUPP is seen on NFS in HP-UX 11.11, 11.23.
EINVAL is seen on NFS in HP-UX 11.31. */
if (errno == ENOSYS || errno == EOPNOTSUPP || errno == EINVAL)
;
else
return -1;
}
else if (count == 0)
return 0;
else /* count > 0 */
{
if (count > NACLVENTRIES)
/* If NACLVENTRIES cannot be trusted, use dynamic memory
allocation. */
abort ();
/* If there are more than 4 entries, there cannot be only the
four base ACL entries. */
if (count > 4)
return 1;
return aclv_nontrivial (count, entries);
}
}
# endif
# elif HAVE_ACLX_GET && defined ACL_AIX_WIP /* AIX */
acl_type_t type;
char aclbuf[1024];
void *acl = aclbuf;
size_t aclsize = sizeof (aclbuf);
mode_t mode;
for (;;)
{
/* The docs say that type being 0 is equivalent to ACL_ANY, but it
is not true, in AIX 5.3. */
type.u64 = ACL_ANY;
if (aclx_get (name, 0, &type, aclbuf, &aclsize, &mode) >= 0)
break;
if (errno == ENOSYS)
return 0;
if (errno != ENOSPC)
{
if (acl != aclbuf)
{
int saved_errno = errno;
free (acl);
errno = saved_errno;
}
return -1;
}
aclsize = 2 * aclsize;
if (acl != aclbuf)
free (acl);
acl = malloc (aclsize);
if (acl == NULL)
{
errno = ENOMEM;
return -1;
}
}
if (type.u64 == ACL_AIXC)
{
int result = acl_nontrivial ((struct acl *) acl);
if (acl != aclbuf)
free (acl);
return result;
}
else if (type.u64 == ACL_NFS4)
{
int result = acl_nfs4_nontrivial ((nfs4_acl_int_t *) acl);
if (acl != aclbuf)
free (acl);
return result;
}
else
{
/* A newer type of ACL has been introduced in the system.
We should better support it. */
if (acl != aclbuf)
free (acl);
errno = EINVAL;
return -1;
}
# elif HAVE_STATACL /* older AIX */
union { struct acl a; char room[4096]; } u;
if (statacl ((char *) name, STX_NORMAL, &u.a, sizeof (u)) < 0)
return -1;
return acl_nontrivial (&u.a);
# elif HAVE_ACLSORT /* NonStop Kernel */
{
struct acl entries[NACLENTRIES];
int count;
count = acl ((char *) name, ACL_GET, NACLENTRIES, entries);
if (count < 0)
{
if (errno == ENOSYS || errno == ENOTSUP)
;
else
return -1;
}
else if (count == 0)
return 0;
else /* count > 0 */
{
if (count > NACLENTRIES)
/* If NACLENTRIES cannot be trusted, use dynamic memory
allocation. */
abort ();
/* If there are more than 4 entries, there cannot be only the
four base ACL entries. */
if (count > 4)
return 1;
return acl_nontrivial (count, entries);
}
}
# endif
}
#endif
return 0;
}

11
lib/gnulib.mk.in
View file

@ -98,6 +98,7 @@
# fcntl \
# fcntl-h \
# fdopendir \
# file-has-acl \
# filemode \
# filename \
# filevercmp \
@ -1788,6 +1789,16 @@ EXTRA_libgnu_a_SOURCES += fdopendir.c
endif
## end gnulib module fdopendir
## begin gnulib module file-has-acl
ifeq (,$(OMIT_GNULIB_MODULE_file-has-acl))
libgnu_a_SOURCES += file-has-acl.c
EXTRA_DIST += acl-internal.h
endif
## end gnulib module file-has-acl
## begin gnulib module filemode
ifeq (,$(OMIT_GNULIB_MODULE_filemode))

32
lisp/ansi-color.el
View file

@ -75,6 +75,7 @@
;;; Code:
(defvar comint-last-output-start)
(defvar compilation-filter-start)
;; Customization
@ -181,6 +182,24 @@ in shell buffers. You set this variable by calling one of:
:group 'ansi-colors
:version "23.2")
(defcustom ansi-color-for-compilation-mode t
"Determines what to do with compilation output.
If nil, do nothing.
If the symbol `filter', then filter all ANSI graphical control
sequences.
If anything else (such as t), then translate ANSI graphical
control sequences into text properties.
In order for this to have any effect, `ansi-color-compilation-filter'
must be in `compilation-filter-hook'."
:type '(choice (const :tag "Do nothing" nil)
(const :tag "Filter" filter)
(other :tag "Translate" t))
:group 'ansi-colors
:version "28.1")
(defvar ansi-color-apply-face-function #'ansi-color-apply-overlay-face
"Function for applying an Ansi Color face to text in a buffer.
This function should accept three arguments: BEG, END, and FACE,
@ -228,6 +247,19 @@ This is a good function to put in `comint-output-filter-functions'."
(t
(ansi-color-apply-on-region start-marker end-marker)))))
;;;###autoload
(defun ansi-color-compilation-filter ()
"Maybe translate SGR control sequences into text properties.
This function depends on the `ansi-color-for-compilation-mode'
variable, and is meant to be used in `compilation-filter-hook'."
(let ((inhibit-read-only t))
(pcase ansi-color-for-compilation-mode
('nil nil)
('filter
(ansi-color-filter-region compilation-filter-start (point)))
(_
(ansi-color-apply-on-region compilation-filter-start (point))))))
(define-obsolete-function-alias 'ansi-color-unfontify-region
'font-lock-default-unfontify-region "24.1")

4
lisp/autorevert.el
View file

@ -391,6 +391,10 @@ disk changes.
When a buffer is reverted, a message is generated. This can be
suppressed by setting `auto-revert-verbose' to nil.
Reverting can sometimes fail to preserve all the markers in the buffer.
To avoid that, set `revert-buffer-insert-file-contents-function' to
the slower function `revert-buffer-insert-file-contents-delicately'.
Use `global-auto-revert-mode' to automatically revert all buffers.
Use `auto-revert-tail-mode' if you know that the file will only grow
without being changed in the part that is already in the buffer."

4
lisp/battery.el
View file

@ -161,9 +161,9 @@ The full `format-spec' formatting syntax is supported."
(defcustom battery-mode-line-format
(cond ((eq battery-status-function #'battery-linux-proc-acpi)
"[%b%p%%,%d°C]")
"[%b%p%%,%d°C] ")
(battery-status-function
"[%b%p%%]"))
"[%b%p%%] "))
"Control string formatting the string to display in the mode line.
Ordinary characters in the control string are printed as-is, while
conversion specifications introduced by a `%' character in the control

2
lisp/bindings.el
View file

@ -580,7 +580,7 @@ Major modes that edit things other than ordinary files may change this
(put 'mode-line-buffer-identification 'risky-local-variable t)
(defvar mode-line-misc-info
'((global-mode-string ("" global-mode-string " ")))
'((global-mode-string ("" global-mode-string)))
"Mode line construct for miscellaneous information.
By default, this shows the information specified by `global-mode-string'.")
(put 'mode-line-misc-info 'risky-local-variable t)

12
lisp/bookmark.el
View file

@ -561,10 +561,14 @@ old one."
(set-text-properties 0 (length stripped-name) nil stripped-name)
(if (and (not no-overwrite)
(bookmark-get-bookmark stripped-name 'noerror))
;; already existing bookmark under that name and
;; no prefix arg means just overwrite old bookmark
;; Use the new (NAME . ALIST) format.
(setcdr (bookmark-get-bookmark stripped-name) alist)
;; Already existing bookmark under that name and
;; no prefix arg means just overwrite old bookmark.
(let ((bm (bookmark-get-bookmark stripped-name)))
;; First clean up if previously location was fontified.
(when bookmark-fontify
(bookmark--unfontify bm))
;; Modify using the new (NAME . ALIST) format.
(setcdr bm alist))
;; otherwise just cons it onto the front (either the bookmark
;; doesn't exist already, or there is no prefix arg. In either

1
lisp/button.el
View file

@ -61,6 +61,7 @@
;; might get converted to ^M when building loaddefs.el
(define-key map [(control ?m)] 'push-button)
(define-key map [mouse-2] 'push-button)
(define-key map [follow-link] 'mouse-face)
;; FIXME: You'd think that for keymaps coming from text-properties on the
;; mode-line or header-line, the `mode-line' or `header-line' prefix
;; shouldn't be necessary!

192
lisp/calendar/cal-french.el
View file

@ -40,12 +40,13 @@
(defconst calendar-french-month-name-array
["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse"
"Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"]
"Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"
"jour complémentaire"]
"Array of month names in the French calendar.")
(defconst calendar-french-day-name-array
["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi"
"Octidi" "Nonidi" "Decadi"]
"Octidi" "Nonidi" "Décadi"]
"Array of day names in the French calendar.")
(define-obsolete-variable-alias 'calendar-french-multibyte-special-days-array
@ -56,6 +57,144 @@
"de la Révolution"]
"Array of special day names in the French calendar.")
(defconst calendar-french-feasts-array
[;; Vendémiaire
"du Raisin" "du Safran" "de la Châtaigne"
"de la Colchique" "du Cheval" "de la Balsamine"
"de la Carotte" "de l'Amarante" "du Panais"
"de la Cuve" "de la Pomme de terre" "de l'Immortelle"
"du Potiron" "du Réséda" "de l'Âne"
"de la Belle de nuit" "de la Citrouille" "du Sarrasin"
"du Tournesol" "du Pressoir" "du Chanvre"
"de la Pêche" "du Navet" "de l'Amaryllis"
"du Bœuf" "de l'Aubergine" "du Piment"
"de la Tomate" "de l'Orge" "du Tonneau"
;; Brumaire
"de la Pomme" "du Céleri" "de la Poire"
"de la Betterave" "de l'Oie" "de l'Héliotrope"
"de la Figue" "de la Scorsonère" "de l'Alisier"
"de la Charrue" "du Salsifis" "de la Macre"
"du Topinambour" "de l'Endive" "du Dindon"
"du Chervis" "du Cresson" "de la Dentelaire"
"de la Grenade" "de la Herse" "de la Bacchante"
"de l'Azerole" "de la Garance" "de l'Orange"
"du Faisan" "de la Pistache" "du Macjon"
"du Coing" "du Cormier" "du Rouleau"
;; Frimaire
"de la Raiponce" "du Turneps" "de la Chicorée"
"de la Nèfle" "du Cochon" "de la Mâche"
"du Chou-fleur" "du Miel" "du Genièvre"
"de la Pioche" "de la Cire" "du Raifort"
"du Cèdre" "du Sapin" "du Chevreuil"
"de l'Ajonc" "du Cyprès" "du Lierre"
"de la Sabine" "du Hoyau" "de l'Érable-sucre"
"de la Bruyère" "du Roseau" "de l'Oseille"
"du Grillon" "du Pignon" "du Liège"
"de la Truffe" "de l'Olive" "de la Pelle"
;; Nivôse
"de la Tourbe" "de la Houille" "du Bitume"
"du Soufre" "du Chien" "de la Lave"
"de la Terre végétale" "du Fumier" "du Salpêtre"
"du Fléau" "du Granit" "de l'Argile"
"de l'Ardoise" "du Grès" "du Lapin"
"du Silex" "de la Marne" "de la Pierre à chaux"
"du Marbre" "du Van" "de la Pierre à plâtre"
"du Sel" "du Fer" "du Cuivre"
"du Chat" "de l'Étain" "du Plomb"
"du Zinc" "du Mercure" "du Crible"
;; Pluviôse
"de la Lauréole" "de la Mousse" "du Fragon"
"du Perce-neige" "du Taureau" "du Laurier-thym"
"de l'Amadouvier" "du Mézéréon" "du Peuplier"
"de la Cognée" "de l'Ellébore" "du Brocoli"
"du Laurier" "de l'Avelinier" "de la Vache"
"du Buis" "du Lichen" "de l'If"
"de la Pulmonaire" "de la Serpette" "du Thlaspi"
"du Thymelé" "du Chiendent" "de la Traînasse"
"du Lièvre" "de la Guède" "du Noisetier"
"du Cyclamen" "de la Chélidoine" "du Traîneau"
;; Ventôse
"du Tussilage" "du Cornouiller" "du Violier"
"du Troène" "du Bouc" "de l'Asaret"
"de l'Alaterne" "de la Violette" "du Marsault"
"de la Bêche" "du Narcisse" "de l'Orme"
"de la Fumeterre" "du Vélar" "de la Chèvre"
"de l'Épinard" "du Doronic" "du Mouron"
"du Cerfeuil" "du Cordeau" "de la Mandragore"
"du Persil" "du Cochléaria" "de la Pâquerette"
"du Thon" "du Pissenlit" "de la Sylvie"
"du Capillaire" "du Frêne" "du Plantoir"
;; Germinal
"de la Primevère" "du Platane" "de l'Asperge"
"de la Tulipe" "de la Poule" "de la Blette"
"du Bouleau" "de la Jonquille" "de l'Aulne"
"du Couvoir" "de la Pervenche" "du Charme"
"de la Morille" "du Hêtre" "de l'Abeille"
"de la Laitue" "du Mélèze" "de la Ciguë"
"du Radis" "de la Ruche" "du Gainier"
"de la Romaine" "du Marronnier" "de la Roquette"
"du Pigeon" "du Lilas" "de l'Anémone"
"de la Pensée" "de la Myrtille" "du Greffoir"
;; Floréal
"de la Rose" "du Chêne" "de la Fougère"
"de l'Aubépine" "du Rossignol" "de l'Ancolie"
"du Muguet" "du Champignon" "de la Jacinthe"
"du Rateau" "de la Rhubarbe" "du Sainfoin"
"du Bâton-d'or" "du Chamérisier" "du Ver à soie"
"de la Consoude" "de la Pimprenelle" "de la Corbeille-d'or"
"de l'Arroche" "du Sarcloir" "du Statice"
"de la Fritillaire" "de la Bourrache" "de la Valériane"
"de la Carpe" "du Fusain" "de la Civette"
"de la Buglosse" "du Sénevé" "de la Houlette"
;; Prairial
"de la Luzerne" "de l'Hémérocalle" "du Trèfle"
"de l'Angélique" "du Canard" "de la Mélisse"
"du Fromental" "du Martagon" "du Serpolet"
"de la Faux" "de la Fraise" "de la Bétoine"
"du Pois" "de l'Acacia" "de la Caille"
"de l'Œillet" "du Sureau" "du Pavot"
"du Tilleul" "de la Fourche" "du Barbeau"
"de la Camomille" "du Chèvrefeuille" "du Caille-lait"
"de la Tanche" "du Jasmin" "de la Verveine"
"du Thym" "de la Pivoine" "du Chariot"
;; Messidor
"du Seigle" "de l'Avoine" "de l'Oignon"
"de la Véronique" "du Mulet" "du Romarin"
"du Concombre" "de l'Échalotte" "de l'Absinthe"
"de la Faucille" "de la Coriandre" "de l'Artichaut"
"de la Giroflée" "de la Lavande" "du Chamois"
"du Tabac" "de la Groseille" "de la Gesse"
"de la Cerise" "du Parc" "de la Menthe"
"du Cumin" "du Haricot" "de l'Orcanète"
"de la Pintade" "de la Sauge" "de l'Ail"
"de la Vesce" "du Blé" "de la Chalémie"
;; Thermidor
"de l'Épautre" "du Bouillon-blanc" "du Melon"
"de l'Ivraie" "du Bélier" "de la Prèle"
"de l'Armoise" "du Carthame" "de la Mûre"
"de l'Arrosoir" "du Panis" "du Salicor"
"de l'Abricot" "du Basilic" "de la Brebis"
"de la Guimauve" "du Lin" "de l'Amande"
"de la Gentiane" "de l'Écluse" "de la Carline"
"du Câprier" "de la Lentille" "de l'Aunée"
"de la Loutre" "de la Myrte" "du Colza"
"du Lupin" "du Coton" "du Moulin"
;; Fructidor
"de la Prune" "du Millet" "du Lycoperdon"
"de l'Escourgeon" "du Saumon" "de la Tubéreuse"
"du Sucrion" "de l'Apocyn" "de la Réglisse"
"de l'Échelle" "de la Pastèque" "du Fenouil"
"de l'Épine-vinette" "de la Noix" "de la Truite"
"du Citron" "de la Cardère" "du Nerprun"
"du Tagette" "de la Hotte" "de l'Églantier"
"de la Noisette" "du Houblon" "du Sorgho"
"de l'Écrevisse" "de la Bagarade" "de la Verge-d'or"
"du Maïs" "du Marron" "du Panier"
;; jour complémentaire
"de la Vertu" "du Génie" "du Travail"
"de la Raison" "des Récompenses" "de la Révolution"]
"Array of day feasts in the French calendar.")
(defun calendar-french-accents-p ()
(declare (obsolete nil "28.1"))
t)
@ -75,6 +214,16 @@
(declare (obsolete "use the variable of the same name instead" "28.1"))
calendar-french-special-days-array)
(defun calendar-french-trim-feast (feast)
"Remove the article from the FEAST.
E.g. \"du Raisin\" -> \"Raisin\" or \"de la Vertu\" -> \"Vertu\"."
(cond
((equal (substring feast 0 3) "du ") (substring feast 3))
((equal (substring feast 0 6) "de la ") (substring feast 6))
((equal (substring feast 0 5) "de l'") (substring feast 5))
((equal (substring feast 0 4) "des ") (substring feast 4))
(t feast)))
(defun calendar-french-leap-year-p (year)
"True if YEAR is a leap year on the French Revolutionary calendar.
For Gregorian years 1793 to 1805, the years of actual operation of the
@ -162,14 +311,13 @@ Defaults to today's date if DATE is not given."
(d (calendar-extract-day french-date)))
(cond
((< y 1) "")
((= m 13) (format "Jour %s de l'Année %d de la Révolution"
(aref calendar-french-special-days-array (1- d))
y))
(t (format
"%d %s an %d de la Révolution"
"%s %d %s an %d de la Révolution, jour %s"
(aref calendar-french-day-name-array (% (1- d) 10))
d
(aref calendar-french-month-name-array (1- m))
y)))))
y
(aref calendar-french-feasts-array (+ -31 (* 30 m) d)))))))
;;;###cal-autoload
(defun calendar-french-print-date ()
@ -186,7 +334,7 @@ Defaults to today's date if DATE is not given."
Echo French Revolutionary date unless NOECHO is non-nil."
(interactive
(let* ((months calendar-french-month-name-array)
(special-days calendar-french-special-days-array)
(feasts calendar-french-feasts-array)
(year (progn
(calendar-read-sexp
"Année de la Révolution (>0)"
@ -199,29 +347,31 @@ Echo French Revolutionary date unless NOECHO is non-nil."
(mapcar 'list
(append months
(if (calendar-french-leap-year-p year)
(mapcar
(lambda (x) (concat "Jour " x))
calendar-french-special-days-array)
(mapcar #'calendar-french-trim-feast feasts)
(reverse
(cdr ; we don't want rev. day in a non-leap yr
(reverse
(mapcar
(lambda (x)
(concat "Jour " x))
special-days))))))))
(mapcar #'calendar-french-trim-feast
feasts))))))))
(completion-ignore-case t)
(month (cdr (assoc-string
(completing-read
"Mois ou Sansculottide: "
"Mois ou \"jour complémentaire\" ou fête: "
month-list
nil t)
(calendar-make-alist month-list 1 'car) t)))
(day (if (> month 12)
(- month 12)
(last-day (calendar-french-last-day-of-month (min month 13) year))
(day (if (> month 13)
(- month 13)
(calendar-read-sexp
"Jour (1-30)"
(lambda (x) (and (<= 1 x) (<= x 30))))))
(month (if (> month 12) 13 month)))
(format "Jour (1-%d): " last-day)
(lambda (x) (<= 1 x last-day)))))
;; All days in Vendémiaire and numbered 1 to 365 e.g., "Pomme"
;; gives 31 Vendémiaire automatically normalized to 1 Brumaire
;; "Céleri" gives 32 Vnd normalized to 2 Bru, "Raiponce" gives
;; 61 Vnd normalized to 1 Frimaire, etc until "Récompences" which
;; gives 365 Vnd normalized to 5 jour complémentaire.
(month (if (> month 13) 1 month)))
(list (list month day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-french-to-absolute date)))

11
lisp/comint.el
View file

@ -2471,10 +2471,13 @@ This function could be in the list `comint-output-filter-functions'."
;; Random input hackage
(defun comint-delete-output ()
(defun comint-delete-output (&optional kill)
"Delete all output from interpreter since last input.
Does not delete the prompt."
(interactive)
If KILL (interactively, the prefix), save the killed text in the
kill ring.
This command does not delete the prompt."
(interactive "P")
(let ((proc (get-buffer-process (current-buffer)))
(replacement nil)
(inhibit-read-only t))
@ -2482,6 +2485,8 @@ Does not delete the prompt."
(let ((pmark (progn (goto-char (process-mark proc))
(forward-line 0)
(point-marker))))
(when kill
(copy-region-as-kill comint-last-input-end pmark))
(delete-region comint-last-input-end pmark)
(goto-char (process-mark proc))
(setq replacement (concat "*** output flushed ***\n"

42
lisp/cus-start.el
View file

@ -306,8 +306,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(use-short-answers menu boolean "28.1")
(focus-follows-mouse
frames (choice
(const :tag "Off (nil)" :value nil)
(const :tag "On (t)" :value t)
(const :tag "Off" :value nil)
(const :tag "On" :value t)
(const :tag "Auto-raise" :value auto-raise)) "26.1")
;; fontset.c
;; FIXME nil is the initial value, fontset.el setqs it.
@ -603,27 +603,29 @@ since it could result in memory overflow and make Emacs crash."
(next-screen-context-lines windows integer)
(scroll-preserve-screen-position
windows (choice
(const :tag "Off (nil)" :value nil)
(const :tag "Full screen (t)" :value t)
(other :tag "Always" 1)) "22.1")
(const :tag "Off" :value nil)
(const :tag "Full screen" :value t)
(other :tag "Always" 1))
"22.1")
(recenter-redisplay
windows (choice
(const :tag "Never (nil)" :value nil)
(const :tag "Never" :value nil)
(const :tag "Only on ttys" :value tty)
(other :tag "Always" t)) "23.1")
(other :tag "Always" t))
"23.1")
(window-combination-resize windows boolean "24.1")
(window-combination-limit
windows (choice
(const :tag "Never (nil)" :value nil)
(const :tag "If requested via buffer display alist (window-size)"
(const :tag "Never" :value nil)
(const :tag "If requested via buffer display alist"
:value window-size)
(const :tag "With Temp Buffer Resize mode (temp-buffer-resize)"
(const :tag "With Temp Buffer Resize mode"
:value temp-buffer-resize)
(const :tag "For temporary buffers (temp-buffer)"
(const :tag "For temporary buffers"
:value temp-buffer)
(const :tag "For buffer display (display-buffer)"
(const :tag "For buffer display"
:value display-buffer)
(other :tag "Always (t)" :value t))
(other :tag "Always" :value t))
"26.1")
(fast-but-imprecise-scrolling scrolling boolean "25.1")
(window-resize-pixelwise windows boolean "24.4")
@ -631,6 +633,12 @@ since it could result in memory overflow and make Emacs crash."
;; The whitespace group is for whitespace.el.
(show-trailing-whitespace editing-basics boolean nil
:safe booleanp)
(mode-line-compact
mode-line
(choice (const :tag "Never" :value nil)
(const :tag "Only if wider than window" :value long)
(const :tag "Always" :value t))
"28.1")
(scroll-step windows integer)
(scroll-conservatively windows integer)
(scroll-margin windows integer)
@ -668,7 +676,7 @@ since it could result in memory overflow and make Emacs crash."
(underline-minimum-offset display integer "23.1")
(mouse-autoselect-window
display (choice
(const :tag "Off (nil)" :value nil)
(const :tag "Off" :value nil)
(const :tag "Immediate" :value t)
(number :tag "Delay by secs" :value 0.5)) "22.1")
(tool-bar-style
@ -713,15 +721,15 @@ since it could result in memory overflow and make Emacs crash."
(hourglass-delay cursor number)
(resize-mini-windows
windows (choice
(const :tag "Off (nil)" :value nil)
(const :tag "Fit (t)" :value t)
(const :tag "Off" :value nil)
(const :tag "Fit" :value t)
(const :tag "Grow only" :value grow-only))
"25.1")
(display-raw-bytes-as-hex display boolean "26.1")
(display-line-numbers
display-line-numbers
(choice
(const :tag "Off (nil)" :value nil)
(const :tag "Off" :value nil)
(const :tag "Absolute line numbers"
:value t)
(const :tag "Relative line numbers"

2
lisp/custom.el
View file

@ -926,7 +926,7 @@ See `custom-known-themes' for a list of known themes."
;; the value to a fake theme, `changed'. If the theme is
;; later disabled, we use this to bring back the old value.
;;
;; For faces, we just use `face-new-frame-defaults' to
;; For faces, we just use `face--new-frame-defaults' to
;; recompute when the theme is disabled.
(when (and (eq prop 'theme-value)
(boundp symbol))

5
lisp/desktop.el
View file

@ -706,8 +706,9 @@ if different)."
"\\)\\'")))
(dolist (buffer (buffer-list))
(let ((bufname (buffer-name buffer)))
(unless (or (eq (aref bufname 0) ?\s) ;; Don't kill internal buffers
(string-match-p preserve-regexp bufname))
(unless (or (null bufname)
(eq (aref bufname 0) ?\s) ;; Don't kill internal buffers
(string-match-p preserve-regexp bufname))
(kill-buffer buffer)))))
(delete-other-windows)
(when (and desktop-restore-frames

50
lisp/dired-x.el
View file

@ -972,38 +972,26 @@ REGEXP is matched case-sensitively."
(defun dired-guess-default (files)
"Return a shell command, or a list of commands, appropriate for FILES.
See `dired-guess-shell-alist-user'."
(let* ((case-fold-search dired-guess-shell-case-fold-search)
;; Prepend the user's alist to the default alist.
(alist (append dired-guess-shell-alist-user
dired-guess-shell-alist-default))
(file (car files))
(flist (cdr files))
elt regexp cmds)
;; Find the first match in the alist for first file in FILES.
(while alist
(setq elt (car alist)
regexp (car elt)
alist (cdr alist))
(if (string-match-p regexp file)
(setq cmds (cdr elt)
alist nil)))
;; If more than one file, see if all of FILES match regular expression.
(while (and flist
(string-match-p regexp (car flist)))
(setq flist (cdr flist)))
;; If flist is still non-nil, then do not guess since this means that not
;; all the files in FILES were matched by the regexp.
(setq cmds (and (not flist) cmds))
;; Return commands or nil if flist is still non-nil.
;; Evaluate the commands in order that any logical testing will be done.
(if (cdr cmds)
(delete-dups (mapcar (lambda (cmd) (eval cmd `((file . ,file)))) cmds))
(eval (car cmds) `((file . ,file)))))) ; single command
(programs
(delete-dups
(mapcar
(lambda (command)
(eval command `((file . ,(car files)))))
(seq-reduce
#'append
(mapcar #'cdr
(seq-filter (lambda (elem)
(seq-every-p
(lambda (file)
(string-match-p (car elem) file))
files))
(append dired-guess-shell-alist-user
dired-guess-shell-alist-default)))
nil)))))
(if (length= programs 1)
(car programs)
programs)))
(defun dired-guess-shell-command (prompt files)
"Ask user with PROMPT for a shell command, guessing a default from FILES."

1
lisp/dnd.el
View file

@ -180,6 +180,7 @@ An alternative for systems that do not support unc file names is
(if dnd-open-file-other-window
(find-file-other-window f)
(find-file f))
(file-name-history--add f)
'private)
(error "Can not read %s" uri))))

19
lisp/emacs-lisp/byte-opt.el
View file

@ -274,6 +274,7 @@ Earlier variables shadow later ones with the same name.")
((pred byte-code-function-p)
;; (message "Inlining byte-code for %S!" name)
;; The byte-code will be really inlined in byte-compile-unfold-bcf.
(byte-compile--check-arity-bytecode form fn)
`(,fn ,@(cdr form)))
((or `(lambda . ,_) `(closure . ,_))
;; While byte-compile-unfold-bcf can inline dynbind byte-code into
@ -300,7 +301,9 @@ Earlier variables shadow later ones with the same name.")
;; surrounded the `defsubst'.
(byte-compile-warnings nil))
(byte-compile name))
`(,(symbol-function name) ,@(cdr form))))
(let ((bc (symbol-function name)))
(byte-compile--check-arity-bytecode form bc)
`(,bc ,@(cdr form)))))
(_ ;; Give up on inlining.
form))))
@ -414,7 +417,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
form)))
(t form)))
(`(quote . ,v)
(if (cdr v)
(if (or (not v) (cdr v))
(byte-compile-warn "malformed quote form: `%s'"
(prin1-to-string form)))
;; Map (quote nil) to nil to simplify optimizer logic.
@ -667,8 +670,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
(byte-compile-log " %s\t==>\t%s" old new)
(setq form new)
(not (eq new old))))))))
;; Normalise (quote nil) to nil, for a single representation of constant nil.
(and (not (equal form '(quote nil))) form))
form)
(defun byte-optimize-let-form (head form for-effect)
;; Recursively enter the optimizer for the bindings and body
@ -969,6 +971,11 @@ See Info node `(elisp) Integer Basics'."
;; Arity errors reported elsewhere.
form)))
(defun byte-optimize-eq (form)
(pcase (cdr form)
((or `(,x nil) `(nil ,x)) `(not ,x))
(_ (byte-optimize-binary-predicate form))))
(defun byte-optimize-member (form)
;; Replace `member' or `memql' with `memq' if the first arg is a symbol,
;; or the second arg is a list of symbols. Same with fixnums.
@ -1056,7 +1063,7 @@ See Info node `(elisp) Integer Basics'."
(put 'min 'byte-optimizer #'byte-optimize-min-max)
(put '= 'byte-optimizer #'byte-optimize-binary-predicate)
(put 'eq 'byte-optimizer #'byte-optimize-binary-predicate)
(put 'eq 'byte-optimizer #'byte-optimize-eq)
(put 'eql 'byte-optimizer #'byte-optimize-equal)
(put 'equal 'byte-optimizer #'byte-optimize-equal)
(put 'string= 'byte-optimizer #'byte-optimize-binary-predicate)
@ -1072,7 +1079,7 @@ See Info node `(elisp) Integer Basics'."
(defun byte-optimize-quote (form)
(if (or (consp (nth 1 form))
(and (symbolp (nth 1 form))
(not (macroexp--const-symbol-p form))))
(not (macroexp--const-symbol-p (nth 1 form)))))
form
(nth 1 form)))

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

@ -1477,6 +1477,30 @@ when printing the error message."
(push (list f byte-compile-last-position nargs)
byte-compile-unresolved-functions)))))
(defun byte-compile-emit-callargs-warn (name actual-args min-args max-args)
(byte-compile-set-symbol-position name)
(byte-compile-warn
"%s called with %d argument%s, but %s %s"
name actual-args
(if (= 1 actual-args) "" "s")
(if (< actual-args min-args)
"requires"
"accepts only")
(byte-compile-arglist-signature-string (cons min-args max-args))))
(defun byte-compile--check-arity-bytecode (form bytecode)
"Check that the call in FORM matches that allowed by BYTECODE."
(when (and (byte-code-function-p bytecode)
(byte-compile-warning-enabled-p 'callargs))
(let* ((actual-args (length (cdr form)))
(arity (func-arity bytecode))
(min-args (car arity))
(max-args (and (numberp (cdr arity)) (cdr arity))))
(when (or (< actual-args min-args)
(and max-args (> actual-args max-args)))
(byte-compile-emit-callargs-warn
(car form) actual-args min-args max-args)))))
;; Warn if the form is calling a function with the wrong number of arguments.
(defun byte-compile-callargs-warn (form)
(let* ((def (or (byte-compile-fdefinition (car form) nil)
@ -1491,16 +1515,9 @@ when printing the error message."
(setcdr sig nil))
(if sig
(when (or (< ncall (car sig))
(and (cdr sig) (> ncall (cdr sig))))
(byte-compile-set-symbol-position (car form))
(byte-compile-warn
"%s called with %d argument%s, but %s %s"
(car form) ncall
(if (= 1 ncall) "" "s")
(if (< ncall (car sig))
"requires"
"accepts only")
(byte-compile-arglist-signature-string sig))))
(and (cdr sig) (> ncall (cdr sig))))
(byte-compile-emit-callargs-warn
(car form) ncall (car sig) (cdr sig))))
(byte-compile-format-warn form)
(byte-compile-function-warn (car form) (length (cdr form)) def)))
@ -4340,6 +4357,16 @@ Return (TAIL VAR TEST CASES), where:
(push value keys)
(push (cons (list value) (or body '(t))) cases))
t))))
;; Treat (not X) as (eq X nil).
(`((,(or 'not 'null) ,(and var (pred symbolp))) . ,body)
(and (or (eq var switch-var) (not switch-var))
(progn
(setq switch-var var)
(setq switch-test 'eq)
(unless (memq nil keys)
(push nil keys)
(push (cons (list nil) (or body '(t))) cases))
t)))
(`((,(and fn (or 'memq 'memql 'member)) ,var ,expr) . ,body)
(and (symbolp var)
(or (eq var switch-var) (not switch-var))

15
lisp/emacs-lisp/cconv.el
View file

@ -259,8 +259,7 @@ Returns a form where all lambdas don't have any free variables."
(not (intern-soft var))
(eq ?_ (aref (symbol-name var) 0))
;; As a special exception, ignore "ignore".
(eq var 'ignored)
(not (byte-compile-warning-enabled-p 'unbound var)))
(eq var 'ignored))
(let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
(format "Unused lexical %s `%S'%s"
varkind var
@ -287,7 +286,7 @@ of converted forms."
(let (and (pred stringp) msg)
(cconv--warn-unused-msg arg "argument")))
(if (assq arg env) (push `(,arg . nil) env)) ;FIXME: Is it needed?
(push (lambda (body) (macroexp--warn-wrap msg body)) wrappers))
(push (lambda (body) (macroexp--warn-wrap msg body 'lexical)) wrappers))
(_
(if (assq arg env) (push `(,arg . nil) env)))))
(setq funcbody (mapcar (lambda (form)
@ -408,7 +407,7 @@ places where they originally did not directly appear."
`(ignore ,(cconv-convert value env extend)))
(msg (cconv--warn-unused-msg var "variable")))
(if (null msg) newval
(macroexp--warn-wrap msg newval))))
(macroexp--warn-wrap msg newval 'lexical))))
;; Normal default case.
(_
@ -507,7 +506,7 @@ places where they originally did not directly appear."
(newprotform (cconv-convert protected-form env extend)))
`(condition-case ,var
,(if msg
(macroexp--warn-wrap msg newprotform)
(macroexp--warn-wrap msg newprotform 'lexical)
newprotform)
,@(mapcar
(lambda (handler)
@ -599,14 +598,16 @@ FORM is the parent form that binds this var."
(`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_)
,_ ,_ ,_ ,_)
;; FIXME: Convert this warning to use `macroexp--warn-wrap'
;; so as to give better position information.
;; so as to give better position information and obey
;; `byte-compile-warnings'.
(byte-compile-warn
"%s `%S' not left unused" varkind var))
((and (let (or 'let* 'let) (car form))
`((,var) ;; (or `(,var nil) : Too many false positives: bug#47080
t nil ,_ ,_))
;; FIXME: Convert this warning to use `macroexp--warn-wrap'
;; so as to give better position information.
;; so as to give better position information and obey
;; `byte-compile-warnings'.
(unless (not (intern-soft var))
(byte-compile-warn "Variable `%S' left uninitialized" var))))
(pcase vardata

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

@ -515,111 +515,6 @@ the process stops as soon as KEYS or VALUES run out.
If ALIST is non-nil, the new pairs are prepended to it."
(nconc (cl-mapcar 'cons keys values) alist))
;;; Generalized variables.
;; These used to be in cl-macs.el since all macros that use them (like setf)
;; were autoloaded from cl-macs.el. But now that setf, push, and pop are in
;; core Elisp, they need to either be right here or be autoloaded via
;; cl-loaddefs.el, which is more trouble than it is worth.
;; Some more Emacs-related place types.
(gv-define-simple-setter buffer-file-name set-visited-file-name t)
(gv-define-setter buffer-modified-p (flag &optional buf)
(macroexp-let2 nil buffer `(or ,buf (current-buffer))
`(with-current-buffer ,buffer
(set-buffer-modified-p ,flag))))
(gv-define-simple-setter buffer-name rename-buffer t)
(gv-define-setter buffer-string (store)
`(insert (prog1 ,store (erase-buffer))))
(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
(gv-define-simple-setter current-buffer set-buffer)
(gv-define-simple-setter current-column move-to-column t)
(gv-define-simple-setter current-global-map use-global-map t)
(gv-define-setter current-input-mode (store)
`(progn (apply #'set-input-mode ,store) ,store))
(gv-define-simple-setter current-local-map use-local-map t)
(gv-define-simple-setter current-window-configuration
set-window-configuration t)
(gv-define-simple-setter default-file-modes set-default-file-modes t)
(gv-define-simple-setter documentation-property put)
(gv-define-setter face-background (x f &optional s)
`(set-face-background ,f ,x ,s))
(gv-define-setter face-background-pixmap (x f &optional s)
`(set-face-background-pixmap ,f ,x ,s))
(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s))
(gv-define-setter face-foreground (x f &optional s)
`(set-face-foreground ,f ,x ,s))
(gv-define-setter face-underline-p (x f &optional s)
`(set-face-underline ,f ,x ,s))
(gv-define-simple-setter file-modes set-file-modes t)
(gv-define-setter frame-height (x &optional frame)
`(set-frame-height (or ,frame (selected-frame)) ,x))
(gv-define-simple-setter frame-parameters modify-frame-parameters t)
(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p)
(gv-define-setter frame-width (x &optional frame)
`(set-frame-width (or ,frame (selected-frame)) ,x))
(gv-define-simple-setter getenv setenv t)
(gv-define-simple-setter get-register set-register)
(gv-define-simple-setter global-key-binding global-set-key)
(gv-define-simple-setter local-key-binding local-set-key)
(gv-define-simple-setter mark set-mark t)
(gv-define-simple-setter mark-marker set-mark t)
(gv-define-simple-setter marker-position set-marker t)
(gv-define-setter mouse-position (store scr)
`(set-mouse-position ,scr (car ,store) (cadr ,store)
(cddr ,store)))
(gv-define-simple-setter point goto-char)
(gv-define-simple-setter point-marker goto-char t)
(gv-define-setter point-max (store)
`(progn (narrow-to-region (point-min) ,store) ,store))
(gv-define-setter point-min (store)
`(progn (narrow-to-region ,store (point-max)) ,store))
(gv-define-setter read-mouse-position (store scr)
`(set-mouse-position ,scr (car ,store) (cdr ,store)))
(gv-define-simple-setter screen-height set-screen-height t)
(gv-define-simple-setter screen-width set-screen-width t)
(gv-define-simple-setter selected-window select-window)
(gv-define-simple-setter selected-screen select-screen)
(gv-define-simple-setter selected-frame select-frame)
(gv-define-simple-setter standard-case-table set-standard-case-table)
(gv-define-simple-setter syntax-table set-syntax-table)
(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t)
(gv-define-setter window-height (store)
`(progn (enlarge-window (- ,store (window-height))) ,store))
(gv-define-setter window-width (store)
`(progn (enlarge-window (- ,store (window-width)) t) ,store))
(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
;; More complex setf-methods.
;; This is a hack that allows (setf (eq a 7) B) to mean either
;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
;; This is useful when you have control over the PLACE but not over
;; the VALUE, as is the case in define-minor-mode's :variable.
;; It turned out that :variable needed more flexibility anyway, so
;; this doesn't seem too useful now.
(gv-define-expander eq
(lambda (do place val)
(gv-letplace (getter setter) place
(macroexp-let2 nil val val
(funcall do `(eq ,getter ,val)
(lambda (v)
`(cond
(,v ,(funcall setter val))
((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
(gv-define-expander substring
(lambda (do place from &optional to)
(gv-letplace (getter setter) place
(macroexp-let2* nil ((start from) (end to))
(funcall do `(substring ,getter ,start ,end)
(lambda (v)
(macroexp-let2 nil v v
`(progn
,(funcall setter `(cl--set-substring
,getter ,start ,end ,v))
,v))))))))
;;; Miscellaneous.
(provide 'cl-lib)

15
lisp/emacs-lisp/copyright.el
View file

@ -144,11 +144,16 @@ This function sets the match-data that `copyright-update-year' uses."
(with-demoted-errors "Can't update copyright: %s"
;; (1) Need the extra \\( \\) around copyright-regexp because we
;; goto (match-end 1) below. See note (2) below.
(copyright-re-search (concat "\\(" copyright-regexp
"\\)\\([ \t]*\n\\)?.*\\(?:"
copyright-names-regexp "\\)")
(copyright-limit)
t)))
(let ((regexp (concat "\\(" copyright-regexp
"\\)\\([ \t]*\n\\)?.*\\(?:"
copyright-names-regexp "\\)")))
(when (copyright-re-search regexp (copyright-limit) t)
;; We may accidentally have landed in the middle of a
;; copyright line, so re-perform the search without the
;; search. (Otherwise we may be inserting the new year in the
;; middle of the list of years.)
(goto-char (match-beginning 0))
(copyright-re-search regexp nil t)))))
(defun copyright-find-end ()
"Possibly adjust the search performed by `copyright-find-copyright'.

13
lisp/emacs-lisp/eieio-core.el
View file

@ -742,7 +742,8 @@ Argument FN is the function calling this verifier."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
(format-message "Unknown slot `%S'" name) exp 'compile-only))
(format-message "Unknown slot `%S'" name)
exp nil 'compile-only))
(_ exp))))
(gv-setter eieio-oset))
(cl-check-type slot symbol)
@ -777,12 +778,13 @@ Fills in CLASS's SLOT with its default value."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
(format-message "Unknown slot `%S'" name) exp 'compile-only))
(format-message "Unknown slot `%S'" name)
exp nil 'compile-only))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
(format-message "Slot `%S' is not class-allocated" name)
exp 'compile-only))
exp nil 'compile-only))
(_ exp)))))
(cl-check-type class (or eieio-object class))
(cl-check-type slot symbol)
@ -838,12 +840,13 @@ Fills in the default value in CLASS' in SLOT with VALUE."
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
(macroexp-warn-and-return
(format-message "Unknown slot `%S'" name) exp 'compile-only))
(format-message "Unknown slot `%S'" name)
exp nil 'compile-only))
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-class-slot-names))))
(macroexp-warn-and-return
(format-message "Slot `%S' is not class-allocated" name)
exp 'compile-only))
exp nil 'compile-only))
(_ exp)))))
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)

5
lisp/emacs-lisp/eieio.el
View file

@ -241,7 +241,8 @@ This method is obsolete."
))
`(progn
,@(mapcar (lambda (w) (macroexp-warn-and-return w `(progn ',w) 'compile-only))
,@(mapcar (lambda (w)
(macroexp-warn-and-return w `(progn ',w) nil 'compile-only))
warnings)
;; This test must be created right away so we can have self-
;; referencing classes. ei, a class whose slot can contain only
@ -742,7 +743,7 @@ Called from the constructor routine."
(cl-defmethod initialize-instance ((this eieio-default-superclass)
&optional args)
"Construct the new object THIS based on SLOTS.
"Construct the new object THIS based on ARGS.
ARGS is a property list where odd numbered elements are tags, and
even numbered elements are the values to store in the tagged slot.
If you overload the `initialize-instance', there you will need to

100
lisp/emacs-lisp/gv.el
View file

@ -614,5 +614,105 @@ REF must have been previously obtained with `gv-ref'."
;; (,(nth 1 vars) (v) (funcall ',setter v)))
;; ,@body)))
;;; Generalized variables.
;; Some Emacs-related place types.
(gv-define-simple-setter buffer-file-name set-visited-file-name t)
(gv-define-setter buffer-modified-p (flag &optional buf)
(macroexp-let2 nil buffer `(or ,buf (current-buffer))
`(with-current-buffer ,buffer
(set-buffer-modified-p ,flag))))
(gv-define-simple-setter buffer-name rename-buffer t)
(gv-define-setter buffer-string (store)
`(insert (prog1 ,store (erase-buffer))))
(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
(gv-define-simple-setter current-buffer set-buffer)
(gv-define-simple-setter current-column move-to-column t)
(gv-define-simple-setter current-global-map use-global-map t)
(gv-define-setter current-input-mode (store)
`(progn (apply #'set-input-mode ,store) ,store))
(gv-define-simple-setter current-local-map use-local-map t)
(gv-define-simple-setter current-window-configuration
set-window-configuration t)
(gv-define-simple-setter default-file-modes set-default-file-modes t)
(gv-define-simple-setter documentation-property put)
(gv-define-setter face-background (x f &optional s)
`(set-face-background ,f ,x ,s))
(gv-define-setter face-background-pixmap (x f &optional s)
`(set-face-background-pixmap ,f ,x ,s))
(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s))
(gv-define-setter face-foreground (x f &optional s)
`(set-face-foreground ,f ,x ,s))
(gv-define-setter face-underline-p (x f &optional s)
`(set-face-underline ,f ,x ,s))
(gv-define-simple-setter file-modes set-file-modes t)
(gv-define-setter frame-height (x &optional frame)
`(set-frame-height (or ,frame (selected-frame)) ,x))
(gv-define-simple-setter frame-parameters modify-frame-parameters t)
(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p)
(gv-define-setter frame-width (x &optional frame)
`(set-frame-width (or ,frame (selected-frame)) ,x))
(gv-define-simple-setter getenv setenv t)
(gv-define-simple-setter get-register set-register)
(gv-define-simple-setter global-key-binding global-set-key)
(gv-define-simple-setter local-key-binding local-set-key)
(gv-define-simple-setter mark set-mark t)
(gv-define-simple-setter mark-marker set-mark t)
(gv-define-simple-setter marker-position set-marker t)
(gv-define-setter mouse-position (store scr)
`(set-mouse-position ,scr (car ,store) (cadr ,store)
(cddr ,store)))
(gv-define-simple-setter point goto-char)
(gv-define-simple-setter point-marker goto-char t)
(gv-define-setter point-max (store)
`(progn (narrow-to-region (point-min) ,store) ,store))
(gv-define-setter point-min (store)
`(progn (narrow-to-region ,store (point-max)) ,store))
(gv-define-setter read-mouse-position (store scr)
`(set-mouse-position ,scr (car ,store) (cdr ,store)))
(gv-define-simple-setter screen-height set-screen-height t)
(gv-define-simple-setter screen-width set-screen-width t)
(gv-define-simple-setter selected-window select-window)
(gv-define-simple-setter selected-screen select-screen)
(gv-define-simple-setter selected-frame select-frame)
(gv-define-simple-setter standard-case-table set-standard-case-table)
(gv-define-simple-setter syntax-table set-syntax-table)
(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t)
(gv-define-setter window-height (store)
`(progn (enlarge-window (- ,store (window-height))) ,store))
(gv-define-setter window-width (store)
`(progn (enlarge-window (- ,store (window-width)) t) ,store))
(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
;; More complex setf-methods.
;; This is a hack that allows (setf (eq a 7) B) to mean either
;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
;; This is useful when you have control over the PLACE but not over
;; the VALUE, as is the case in define-minor-mode's :variable.
;; It turned out that :variable needed more flexibility anyway, so
;; this doesn't seem too useful now.
(gv-define-expander eq
(lambda (do place val)
(gv-letplace (getter setter) place
(macroexp-let2 nil val val
(funcall do `(eq ,getter ,val)
(lambda (v)
`(cond
(,v ,(funcall setter val))
((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
(gv-define-expander substring
(lambda (do place from &optional to)
(gv-letplace (getter setter) place
(macroexp-let2* nil ((start from) (end to))
(funcall do `(substring ,getter ,start ,end)
(lambda (v)
(macroexp-let2 nil v v
`(progn
,(funcall setter `(cl--set-substring
,getter ,start ,end ,v))
,v))))))))
(provide 'gv)
;;; gv.el ends here

27
lisp/emacs-lisp/macroexp.el
View file

@ -135,15 +135,22 @@ Other uses risk returning non-nil value that point to the wrong file."
(defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
(defun macroexp--warn-wrap (msg form)
(let ((when-compiled (lambda () (byte-compile-warn "%s" msg))))
(defun macroexp--warn-wrap (msg form category)
(let ((when-compiled (lambda ()
(when (byte-compile-warning-enabled-p category)
(byte-compile-warn "%s" msg)))))
`(progn
(macroexp--funcall-if-compiled ',when-compiled)
,form)))
(define-obsolete-function-alias 'macroexp--warn-and-return
#'macroexp-warn-and-return "28.1")
(defun macroexp-warn-and-return (msg form &optional compile-only)
(defun macroexp-warn-and-return (msg form &optional category compile-only)
"Return code equivalent to FORM labeled with warning MSG.
CATEGORY is the category of the warning, like the categories that
can appear in `byte-compile-warnings'.
COMPILE-ONLY non-nil means no warning should be emitted if the code
is executed without being compiled first."
(cond
((null msg) form)
((macroexp-compiling-p)
@ -153,7 +160,7 @@ Other uses risk returning non-nil value that point to the wrong file."
;; macroexpand-all gets right back to macroexpanding `form'.
form
(puthash form form macroexp--warned)
(macroexp--warn-wrap msg form)))
(macroexp--warn-wrap msg form category)))
(t
(unless compile-only
(message "%sWarning: %s"
@ -205,9 +212,7 @@ Other uses risk returning non-nil value that point to the wrong file."
(if (and (not (eq form new-form)) ;It was a macro call.
(car-safe form)
(symbolp (car form))
(get (car form) 'byte-obsolete-info)
(or (not (fboundp 'byte-compile-warning-enabled-p))
(byte-compile-warning-enabled-p 'obsolete (car form))))
(get (car form) 'byte-obsolete-info))
(let* ((fun (car form))
(obsolete (get fun 'byte-obsolete-info)))
(macroexp-warn-and-return
@ -215,7 +220,7 @@ Other uses risk returning non-nil value that point to the wrong file."
fun obsolete
(if (symbolp (symbol-function fun))
"alias" "macro"))
new-form))
new-form 'obsolete))
new-form)))
(defun macroexp--unfold-lambda (form &optional name)
@ -325,10 +330,8 @@ Assumes the caller has bound `macroexpand-all-environment'."
(if (null body)
(macroexp-unprogn
(macroexp-warn-and-return
(and (or (not (fboundp 'byte-compile-warning-enabled-p))
(byte-compile-warning-enabled-p t))
(format "Empty %s body" fun))
nil t))
(format "Empty %s body" fun)
nil nil 'compile-only))
(macroexp--all-forms body))
(cdr form))
form))

21
lisp/emacs-lisp/package.el
View file

@ -2195,8 +2195,24 @@ Downloads and installs required packages as needed."
((derived-mode-p 'tar-mode)
(package-tar-file-info))
(t
(save-excursion
(package-buffer-info)))))
;; Package headers should be parsed from decoded text
;; (see Bug#48137) where possible.
(if (and (eq buffer-file-coding-system 'no-conversion)
buffer-file-name)
(let* ((package-buffer (current-buffer))
(decoding-system
(car (find-operation-coding-system
'insert-file-contents
(cons buffer-file-name
package-buffer)))))
(with-temp-buffer
(insert-buffer-substring package-buffer)
(decode-coding-region (point-min) (point-max)
decoding-system)
(package-buffer-info)))
(save-excursion
(package-buffer-info))))))
(name (package-desc-name pkg-desc)))
;; Download and install the dependencies.
(let* ((requires (package-desc-reqs pkg-desc))
@ -2222,6 +2238,7 @@ directory."
(setq default-directory file)
(dired-mode))
(insert-file-contents-literally file)
(set-visited-file-name file)
(when (string-match "\\.tar\\'" file) (tar-mode)))
(package-install-from-buffer)))

20
lisp/emacs-lisp/shortdoc.el
View file

@ -32,14 +32,6 @@
"Short documentation."
:group 'lisp)
(defface shortdoc-separator
'((((class color) (background dark))
:height 0.1 :background "#505050" :extend t)
(((class color) (background light))
:height 0.1 :background "#a0a0a0" :extend t)
(t :height 0.1 :inverse-video t :extend t))
"Face used to separate sections.")
(defface shortdoc-heading
'((t :inherit variable-pitch :height 1.3 :weight bold))
"Face used for a heading."
@ -281,8 +273,16 @@ There can be any number of :example/:result elements."
:eval (file-relative-name "/tmp/foo" "/tmp"))
(make-temp-name
:eval (make-temp-name "/tmp/foo-"))
(file-name-concat
:eval (file-name-concat "/tmp/" "foo")
:eval (file-name-concat "/tmp" "foo")
:eval (file-name-concat "/tmp" "foo" "bar/" "zot")
:eval (file-name-concat "/tmp" "~"))
(expand-file-name
:eval (expand-file-name "foo" "/tmp/"))
:eval (expand-file-name "foo" "/tmp/")
:eval (expand-file-name "foo" "/tmp///")
:eval (expand-file-name "foo" "/tmp/foo/.././")
:eval (expand-file-name "~" "/tmp/"))
(substitute-in-file-name
:eval (substitute-in-file-name "$HOME/foo"))
"Directory Functions"
@ -1174,7 +1174,7 @@ If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)."
;; There may be functions not yet defined in the data.
((fboundp (car data))
(when prev
(insert (propertize "\n" 'face 'shortdoc-separator)))
(insert (make-separator-line)))
(setq prev t)
(shortdoc--display-function data))))
(cdr (assq group shortdoc--groups))))

24
lisp/emacs-lisp/tabulated-list.el
View file

@ -214,6 +214,8 @@ If ADVANCE is non-nil, move forward by one line afterwards."
special-mode-map))
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
(define-key map (kbd "M-<left>") 'tabulated-list-previous-column)
(define-key map (kbd "M-<right>") 'tabulated-list-next-column)
(define-key map "S" 'tabulated-list-sort)
(define-key map "}" 'tabulated-list-widen-current-column)
(define-key map "{" 'tabulated-list-narrow-current-column)
@ -740,6 +742,28 @@ Interactively, N is the prefix numeric argument, and defaults to
(setq-local tabulated-list--current-lnum-width lnum-width)
(tabulated-list-init-header)))))
(defun tabulated-list-next-column (&optional arg)
"Go to the start of the next column after point on the current line.
If ARG is provided, move that many columns."
(interactive "p")
(dotimes (_ (or arg 1))
(let ((next (or (next-single-property-change
(point) 'tabulated-list-column-name)
(point-max))))
(when (<= next (line-end-position))
(goto-char next)))))
(defun tabulated-list-previous-column (&optional arg)
"Go to the start of the column point is in on the current line.
If ARG is provided, move that many columns."
(interactive "p")
(dotimes (_ (or arg 1))
(let ((prev (or (previous-single-property-change
(point) 'tabulated-list-column-name)
1)))
(unless (< prev (line-beginning-position))
(goto-char prev)))))
;;; The mode definition:
(defvar tabulated-list--original-order nil)

5
lisp/erc/erc-button.el
View file

@ -130,7 +130,8 @@ longer than `erc-fill-column'."
("<URL: *\\([^<> ]+\\) *>" 0 t browse-url-button-open-url 1)
;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
;; emacs internal
("[`]\\([a-zA-Z][-a-zA-Z_0-9]+\\)[']" 1 t erc-button-describe-symbol 1)
("[`]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)[']"
1 t erc-button-describe-symbol 1)
;; pseudo links
("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1)
("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)"
@ -299,7 +300,7 @@ specified by `erc-button-alist'."
(end (match-end (nth 1 entry)))
(form (nth 2 entry))
(fun (nth 3 entry))
(data (mapcar #'match-string (nthcdr 4 entry))))
(data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
(when (or (eq t form)
(eval form t))
(erc-button-add-button start end fun nil data regexp)))))

26
lisp/faces.el
View file

@ -176,10 +176,28 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
;;; Creation, copying.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(make-obsolete-variable 'face-new-frame-defaults
"use `face--new-frame-defaults' or `face-alist' instead." "28.1")
(defun frame-face-alist (&optional frame)
"Return an alist of frame-local faces defined on FRAME.
This alist is a copy of the contents of `frame--face-hash-table'.
For internal use only."
(declare (obsolete frame--face-hash-table "28.1"))
(let (faces)
(maphash (lambda (face spec)
(let ((face-id (car (gethash face face--new-frame-defaults))))
(push `(,face-id ,face . ,spec) faces)))
(frame--face-hash-table frame))
(mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2)))))))
(defun face-list ()
"Return a list of all defined faces."
(mapcar #'car face-new-frame-defaults))
(let (faces)
(maphash (lambda (face spec)
(push `(,(car spec) . ,face) faces))
face--new-frame-defaults)
(mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2)))))))
(defun make-face (face)
"Define a new face with name FACE, a symbol.
@ -2116,6 +2134,8 @@ the X resource \"reverseVideo\" is present, handle that."
(unwind-protect
(progn
(x-setup-function-keys frame)
(dolist (face (nreverse (face-list)))
(face-spec-recalc face frame))
(x-handle-reverse-video frame parameters)
(frame-set-background-mode frame t)
(face-set-after-frame-default frame parameters)
@ -2146,7 +2166,7 @@ the X resource \"reverseVideo\" is present, handle that."
(defun face-set-after-frame-default (frame &optional parameters)
"Initialize the frame-local faces of FRAME.
Calculate the face definitions using the face specs, custom theme
settings, X resources, and `face-new-frame-defaults'.
settings, X resources, and `face--new-frame-defaults'.
Finally, apply any relevant face attributes found amongst the
frame parameters in PARAMETERS."
;; The `reverse' is so that `default' goes first.
@ -2155,7 +2175,7 @@ frame parameters in PARAMETERS."
(progn
;; Initialize faces from face spec and custom theme.
(face-spec-recalc face frame)
;; Apply attributes specified by face-new-frame-defaults
;; Apply attributes specified by face--new-frame-defaults
(internal-merge-in-global-face face frame))
;; Don't let invalid specs prevent frame creation.
(error nil)))

256
lisp/files.el
View file

@ -1702,6 +1702,10 @@ rather than FUN itself, to `minibuffer-setup-hook'."
(list (read-file-name prompt nil default-directory mustmatch)
t))
(defun file-name-history--add (file)
"Add FILE to `file-name-history'."
(add-to-history 'file-name-history (abbreviate-file-name file)))
(defun find-file (filename &optional wildcards)
"Edit file FILENAME.
Switch to a buffer visiting file FILENAME,
@ -3191,11 +3195,70 @@ If FUNCTION is nil, then it is not called.")
"Upper limit on `magic-mode-alist' regexp matches.
Also applies to `magic-fallback-mode-alist'.")
(defun set-auto-mode--apply-alist (alist keep-mode-if-same dir-local)
"Helper function for `set-auto-mode'.
This function takes an alist of the same form as
`auto-mode-alist'. It then tries to find the appropriate match
in the alist for the current buffer; setting the mode if
possible.
Return non-nil if the mode was set, nil otherwise.
DIR-LOCAL non-nil means this call is via directory-locals, and
extra checks should be done."
(if buffer-file-name
(let (mode
(name buffer-file-name)
(remote-id (file-remote-p buffer-file-name))
(case-insensitive-p (file-name-case-insensitive-p
buffer-file-name)))
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
;; Remove remote file name identification.
(when (and (stringp remote-id)
(string-match (regexp-quote remote-id) name))
(setq name (substring name (match-end 0))))
(while name
;; Find first matching alist entry.
(setq mode
(if case-insensitive-p
;; Filesystem is case-insensitive.
(let ((case-fold-search t))
(assoc-default name alist 'string-match))
;; Filesystem is case-sensitive.
(or
;; First match case-sensitively.
(let ((case-fold-search nil))
(assoc-default name alist 'string-match))
;; Fallback to case-insensitive match.
(and auto-mode-case-fold
(let ((case-fold-search t))
(assoc-default name alist 'string-match))))))
(if (and mode
(consp mode)
(cadr mode))
(setq mode (car mode)
name (substring name 0 (match-beginning 0)))
(setq name nil)))
(when (and dir-local mode
(not (set-auto-mode--dir-local-valid-p mode)))
(message "Ignoring invalid mode `%s'" mode)
(setq mode nil))
(when mode
(set-auto-mode-0 mode keep-mode-if-same)
t))))
(defun set-auto-mode--dir-local-valid-p (mode)
"Say whether MODE can be used in a .dir-local.el `auto-mode-alist'."
(and (symbolp mode)
(string-suffix-p "-mode" (symbol-name mode))
(commandp mode)
(not (provided-mode-derived-p mode 'special-mode))))
(defun set-auto-mode (&optional keep-mode-if-same)
"Select major mode appropriate for current buffer.
To find the right major mode, this function checks for a -*- mode tag
checks for a `mode:' entry in the Local Variables section of the file,
checks if there an `auto-mode-alist' entry in `.dir-locals.el',
checks if it uses an interpreter listed in `interpreter-mode-alist',
matches the buffer beginning against `magic-mode-alist',
compares the file name against the entries in `auto-mode-alist',
@ -3252,6 +3315,14 @@ we don't actually set it to the same mode the buffer already has."
(or (set-auto-mode-0 mode keep-mode-if-same)
;; continuing would call minor modes again, toggling them off
(throw 'nop nil))))))
;; Check for auto-mode-alist entry in dir-locals.
(unless done
(with-demoted-errors "Directory-local variables error: %s"
;; Note this is a no-op if enable-local-variables is nil.
(let* ((mode-alist (cdr (hack-dir-local--get-variables
(lambda (key) (eq key 'auto-mode-alist))))))
(setq done (set-auto-mode--apply-alist mode-alist
keep-mode-if-same t)))))
(and (not done)
(setq mode (hack-local-variables t (not try-locals)))
(not (memq mode modes)) ; already tried and failed
@ -3303,45 +3374,8 @@ we don't actually set it to the same mode the buffer already has."
(set-auto-mode-0 done keep-mode-if-same)))
;; Next compare the filename against the entries in auto-mode-alist.
(unless done
(if buffer-file-name
(let ((name buffer-file-name)
(remote-id (file-remote-p buffer-file-name))
(case-insensitive-p (file-name-case-insensitive-p
buffer-file-name)))
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
;; Remove remote file name identification.
(when (and (stringp remote-id)
(string-match (regexp-quote remote-id) name))
(setq name (substring name (match-end 0))))
(while name
;; Find first matching alist entry.
(setq mode
(if case-insensitive-p
;; Filesystem is case-insensitive.
(let ((case-fold-search t))
(assoc-default name auto-mode-alist
'string-match))
;; Filesystem is case-sensitive.
(or
;; First match case-sensitively.
(let ((case-fold-search nil))
(assoc-default name auto-mode-alist
'string-match))
;; Fallback to case-insensitive match.
(and auto-mode-case-fold
(let ((case-fold-search t))
(assoc-default name auto-mode-alist
'string-match))))))
(if (and mode
(consp mode)
(cadr mode))
(setq mode (car mode)
name (substring name 0 (match-beginning 0)))
(setq name nil))
(when mode
(set-auto-mode-0 mode keep-mode-if-same)
(setq done t))))))
(setq done (set-auto-mode--apply-alist auto-mode-alist
keep-mode-if-same nil)))
;; Next try matching the buffer beginning against magic-fallback-mode-alist.
(unless done
(if (setq done (save-excursion
@ -3435,13 +3469,27 @@ Major modes can use this to examine user-specified local variables
in order to initialize other data structure based on them.")
(defcustom safe-local-variable-values nil
"List variable-value pairs that are considered safe.
"List of variable-value pairs that are considered safe.
Each element is a cons cell (VAR . VAL), where VAR is a variable
symbol and VAL is a value that is considered safe."
symbol and VAL is a value that is considered safe.
Also see `ignored-local-variable-values'."
:risky t
:group 'find-file
:type 'alist)
(defcustom ignored-local-variable-values nil
"List of variable-value pairs that should always be ignored.
Each element is a cons cell (VAR . VAL), where VAR is a variable
symbol and VAL is its value; if VAR is set to VAL by a file-local
variables section, that setting should be ignored.
Also see `safe-local-variable-values'."
:risky t
:group 'find-file
:type 'alist
:version "28.1")
(defcustom safe-local-eval-forms
;; This should be here at least as long as Emacs supports write-file-hooks.
'((add-hook 'write-file-hooks 'time-stamp)
@ -3592,7 +3640,9 @@ n -- to ignore the local variables list.")
(if offer-save
(insert "
! -- to apply the local variables list, and permanently mark these
values (*) as safe (in the future, they will be set automatically.)\n\n")
values (*) as safe (in the future, they will be set automatically.)
i -- to ignore the local variables list, and permanently mark these
values (*) as ignored\n\n")
(insert "\n\n"))
(dolist (elt all-vars)
(cond ((member elt unsafe-vars)
@ -3616,16 +3666,24 @@ n -- to ignore the local variables list.")
(pop-to-buffer buf '(display-buffer--maybe-at-bottom))
(let* ((exit-chars '(?y ?n ?\s))
(prompt (format "Please type %s%s: "
(if offer-save "y, n, or !" "y or n")
(if offer-save "y, n, ! or i" "y or n")
(if (< (line-number-at-pos (point-max))
(window-body-height))
""
", or C-v/M-v to scroll")))
char)
(if offer-save (push ?! exit-chars))
(when offer-save
(push ?i exit-chars)
(push ?! exit-chars))
(setq char (read-char-choice prompt exit-chars))
(when (and offer-save (= char ?!) unsafe-vars)
(customize-push-and-save 'safe-local-variable-values unsafe-vars))
(when (and offer-save
(or (= char ?!) (= char ?i))
unsafe-vars)
(customize-push-and-save
(if (= char ?!)
'safe-local-variable-values
'ignored-local-variable-values)
unsafe-vars))
(prog1 (memq char '(?! ?\s ?y))
(quit-window t)))))))
@ -3718,13 +3776,18 @@ If these settings come from directory-local variables, then
DIR-NAME is the name of the associated directory. Otherwise it is nil."
;; Find those variables that we may want to save to
;; `safe-local-variable-values'.
(let (all-vars risky-vars unsafe-vars)
(let (all-vars risky-vars unsafe-vars ignored)
(dolist (elt variables)
(let ((var (car elt))
(val (cdr elt)))
(cond ((memq var ignored-local-variables)
;; Ignore any variable in `ignored-local-variables'.
nil)
((seq-some (lambda (elem)
(and (eq (car elem) var)
(eq (cdr elem) val)))
ignored-local-variable-values)
nil)
;; Obey `enable-local-eval'.
((eq var 'eval)
(when enable-local-eval
@ -4133,10 +4196,13 @@ Returns the new list."
;; Need a new cons in case we setcdr later.
(push (cons variable value) variables)))))
(defun dir-locals-collect-variables (class-variables root variables)
(defun dir-locals-collect-variables (class-variables root variables
&optional predicate)
"Collect entries from CLASS-VARIABLES into VARIABLES.
ROOT is the root directory of the project.
Return the new variables list."
Return the new variables list.
If PREDICATE is given, it is used to test a symbol key in the alist
to see whether it should be considered."
(let* ((file-name (or (buffer-file-name)
;; Handle non-file buffers, too.
(expand-file-name default-directory)))
@ -4155,9 +4221,11 @@ Return the new variables list."
(>= (length sub-file-name) (length key))
(string-prefix-p key sub-file-name))
(setq variables (dir-locals-collect-variables
(cdr entry) root variables))))
((or (not key)
(derived-mode-p key))
(cdr entry) root variables predicate))))
((if predicate
(funcall predicate key)
(or (not key)
(derived-mode-p key)))
(let* ((alist (cdr entry))
(subdirs (assq 'subdirs alist)))
(if (or (not subdirs)
@ -4454,13 +4522,13 @@ Return the new class name, which is a symbol named DIR."
(defvar hack-dir-local-variables--warned-coding nil)
(defun hack-dir-local-variables ()
(defun hack-dir-local--get-variables (predicate)
"Read per-directory local variables for the current buffer.
Store the directory-local variables in `dir-local-variables-alist'
and `file-local-variables-alist', without applying them.
This does nothing if either `enable-local-variables' or
`enable-dir-local-variables' are nil."
Return a cons of the form (DIR . ALIST), where DIR is the
directory name (maybe nil) and ALIST is an alist of all variables
that might apply. These will be filtered according to the
buffer's directory, but not according to its mode.
PREDICATE is passed to `dir-locals-collect-variables'."
(when (and enable-local-variables
enable-dir-local-variables
(or enable-remote-dir-locals
@ -4479,21 +4547,33 @@ This does nothing if either `enable-local-variables' or
(setq dir-name (nth 0 dir-or-cache))
(setq class (nth 1 dir-or-cache))))
(when class
(let ((variables
(dir-locals-collect-variables
(dir-locals-get-class-variables class) dir-name nil)))
(when variables
(dolist (elt variables)
(if (eq (car elt) 'coding)
(unless hack-dir-local-variables--warned-coding
(setq hack-dir-local-variables--warned-coding t)
(display-warning 'files
"Coding cannot be specified by dir-locals"))
(unless (memq (car elt) '(eval mode))
(setq dir-local-variables-alist
(assq-delete-all (car elt) dir-local-variables-alist)))
(push elt dir-local-variables-alist)))
(hack-local-variables-filter variables dir-name)))))))
(cons dir-name
(dir-locals-collect-variables
(dir-locals-get-class-variables class)
dir-name nil predicate))))))
(defun hack-dir-local-variables ()
"Read per-directory local variables for the current buffer.
Store the directory-local variables in `dir-local-variables-alist'
and `file-local-variables-alist', without applying them.
This does nothing if either `enable-local-variables' or
`enable-dir-local-variables' are nil."
(let* ((items (hack-dir-local--get-variables nil))
(dir-name (car items))
(variables (cdr items)))
(when variables
(dolist (elt variables)
(if (eq (car elt) 'coding)
(unless hack-dir-local-variables--warned-coding
(setq hack-dir-local-variables--warned-coding t)
(display-warning 'files
"Coding cannot be specified by dir-locals"))
(unless (memq (car elt) '(eval mode))
(setq dir-local-variables-alist
(assq-delete-all (car elt) dir-local-variables-alist)))
(push elt dir-local-variables-alist)))
(hack-local-variables-filter variables dir-name))))
(defun hack-dir-local-variables-non-file-buffer ()
"Apply directory-local variables to a non-file buffer.
@ -6245,9 +6325,6 @@ This undoes all changes since the file was visited or saved.
With a prefix argument, offer to revert from latest auto-save file, if
that is more recent than the visited file.
Reverting a buffer will try to preserve markers in the buffer;
see the Info node `(elisp)Reverting' for details.
This command also implements an interface for special buffers
that contain text that doesn't come from a file, but reflects
some other data instead (e.g. Dired buffers, `buffer-list'
@ -6273,7 +6350,12 @@ This function binds `revert-buffer-in-progress-p' non-nil while it operates.
This function calls the function that `revert-buffer-function' specifies
to do the work, with arguments IGNORE-AUTO and NOCONFIRM.
The default function runs the hooks `before-revert-hook' and
`after-revert-hook'."
`after-revert-hook'
Reverting a buffer will try to preserve markers in the buffer,
but it cannot always preserve all of them. For better results,
use `revert-buffer-with-fine-grain', which tries harder to
preserve markers and overlays, at the price of being slower."
;; I admit it's odd to reverse the sense of the prefix argument, but
;; there is a lot of code out there that assumes that the first
;; argument should be t to avoid consulting the auto-save file, and
@ -6282,7 +6364,9 @@ The default function runs the hooks `before-revert-hook' and
;; interface, but leaving the programmatic interface the same.
(interactive (list (not current-prefix-arg)))
(let ((revert-buffer-in-progress-p t)
(revert-buffer-preserve-modes preserve-modes))
(revert-buffer-preserve-modes preserve-modes)
;; Preserve buffer-readedness.
(buffer-read-only buffer-read-only))
(funcall (or revert-buffer-function #'revert-buffer--default)
ignore-auto noconfirm)))
@ -8043,16 +8127,16 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
;; exists, but the file name may exist in the trash
;; directory even if there is no info file for it.
(when (file-exists-p
(expand-file-name files-base trash-files-dir))
(file-name-concat trash-files-dir files-base))
(setq overwrite t
files-base (file-name-nondirectory
(make-temp-file
(expand-file-name
files-base trash-files-dir)
(file-name-concat
trash-files-dir files-base)
is-directory))))
(setq info-fn (expand-file-name
(concat files-base ".trashinfo")
trash-info-dir))
(setq info-fn (file-name-concat
trash-info-dir
(concat files-base ".trashinfo")))
;; Re-check the existence (sort of).
(condition-case nil
(write-region nil nil info-fn nil 'quiet info-fn 'excl)
@ -8061,14 +8145,14 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
;; like Emacs-style backup file names. E.g.:
;; https://bugs.kde.org/170956
(setq info-fn (make-temp-file
(expand-file-name files-base trash-info-dir)
(file-name-concat trash-info-dir files-base)
nil ".trashinfo"))
(setq files-base (substring (file-name-nondirectory info-fn)
0 (- (length ".trashinfo"))))
(write-region nil nil info-fn nil 'quiet info-fn)))
;; Finally, try to move the file to the trashcan.
(let ((delete-by-moving-to-trash nil)
(new-fn (expand-file-name files-base trash-files-dir)))
(new-fn (file-name-concat trash-files-dir files-base)))
(rename-file fn new-fn overwrite)))))))))
(defsubst file-attribute-type (attributes)

2
lisp/frame.el
View file

@ -1231,7 +1231,7 @@ face specs for the new background mode."
;; during startup with -rv on the command
;; line for the initial frame, because frames
;; are not recorded in the pdump file.
(assq face (frame-face-alist frame))
(gethash face (frame--face-hash-table))
(face-spec-match-p face
(face-user-default-spec face)
frame)))

4
lisp/gnus/message.el
View file

@ -4922,6 +4922,7 @@ Each line should be no more than 79 characters long."
(defvar smtpmail-smtp-service)
(defvar smtpmail-smtp-user)
(defvar smtpmail-stream-type)
(defvar smtpmail-store-queue-variables)
(defun message-multi-smtp-send-mail ()
"Send the current buffer to `message-send-mail-function'.
@ -4937,7 +4938,8 @@ that instead."
(message-send-mail-with-sendmail))
((equal (car method) "smtp")
(require 'smtpmail)
(let* ((smtpmail-smtp-server (nth 1 method))
(let* ((smtpmail-store-queue-variables t)
(smtpmail-smtp-server (nth 1 method))
(service (nth 2 method))
(port (string-to-number service))
;; If we're talking to the TLS SMTP port, then force a

12
lisp/help-fns.el
View file

@ -1078,6 +1078,9 @@ it is displayed along with the global value."
(with-current-buffer standard-output
(setq help-mode--current-data
(list :symbol variable
:type (if (eq file-name 'C-source)
'variable
'defvar)
:file file-name))
(save-excursion
(re-search-backward (substitute-command-keys
@ -1089,7 +1092,8 @@ it is displayed along with the global value."
"It is void as a variable."
"Its "))
(with-current-buffer standard-output
(setq help-mode--current-data (list :symbol variable)))
(setq help-mode--current-data (list :symbol variable
:type 'variable)))
(if valvoid
" is void as a variable."
(substitute-command-keys "'s ")))))
@ -1573,11 +1577,7 @@ current buffer and the selected frame, respectively."
(insert doc)
(delete-region (point)
(progn (skip-chars-backward " \t\n") (point)))
(insert "\n\n"
(eval-when-compile
(propertize "\n" 'face
'(:height 0.1 :inverse-video t :extend t)))
"\n")
(insert "\n\n" (make-separator-line) "\n")
(when name
(insert (symbol-name symbol)
" is also a " name "." "\n\n"))))

6
lisp/help-mode.el
View file

@ -738,8 +738,10 @@ See `help-make-xrefs'."
(interactive nil help-mode)
(unless (plist-get help-mode--current-data :file)
(error "Source file for the current help item is not defined"))
(help-function-def--button-function (plist-get help-mode--current-data :symbol)
(plist-get help-mode--current-data :file)))
(help-function-def--button-function
(plist-get help-mode--current-data :symbol)
(plist-get help-mode--current-data :file)
(plist-get help-mode--current-data :type)))
(defun help-goto-info ()
"View the *info* node of the current help item."

7
lisp/help.el
View file

@ -943,12 +943,7 @@ current buffer."
(when defn
(when (> (length info-list) 1)
(with-current-buffer standard-output
(insert "\n\n"
;; FIXME: Can't use eval-when-compile because purified
;; strings lose their text properties :-(
(propertize "\n" 'face
'(:height 0.1 :inverse-video t :extend t))
"\n")))
(insert "\n\n" (make-separator-line) "\n")))
(princ brief-desc)
(when locus

18
lisp/icomplete.el
View file

@ -97,6 +97,12 @@ Otherwise this should be a list of the completion tables (e.g.,
:type '(choice (const :tag "All" t)
(repeat function)))
(defcustom icomplete-matches-format "%s/%s "
"Format of the current/total number of matches for the prompt prefix."
:version "28.1"
:type '(choice (const :tag "No prefix" nil)
(string :tag "Prefix format string")))
(defface icomplete-first-match '((t :weight bold))
"Face used by Icomplete for highlighting first match."
:version "24.4")
@ -696,12 +702,12 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
(overlay-put
icomplete-overlay 'before-string
(and icomplete-scroll
(let ((past (length icomplete--scrolled-past)))
(format
"%s/%s "
(1+ past)
(+ past
(safe-length completion-all-sorted-completions))))))
icomplete-matches-format
(let* ((past (length icomplete--scrolled-past))
(current (1+ past))
(total (+ past (safe-length
completion-all-sorted-completions))))
(format icomplete-matches-format current total))))
(overlay-put icomplete-overlay 'after-string text))))))))
(defun icomplete--affixate (md prospects)

74
lisp/ls-lisp.el
View file

@ -276,7 +276,9 @@ supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards'
is non-nil; otherwise, it interprets wildcards as regular expressions
to match file names. It does not support all `ls' switches -- those
that work are: A a B C c F G g h i n R r S s t U u v X. The l switch
is assumed to be always present and cannot be turned off."
is assumed to be always present and cannot be turned off.
Long variants of the above switches, as documented for GNU `ls',
are also supported; unsupported long options are silently ignored."
(if ls-lisp-use-insert-directory-program
(funcall orig-fun
file switches wildcard full-directory-p)
@ -284,13 +286,21 @@ is assumed to be always present and cannot be turned off."
(let ((handler (find-file-name-handler (expand-file-name file)
'insert-directory))
(orig-file file)
wildcard-regexp)
wildcard-regexp
(ls-lisp-dirs-first
(or ls-lisp-dirs-first
(string-match "--group-directories-first" switches))))
(if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
;; Remove --dired switch
(if (string-match "--dired " switches)
(setq switches (replace-match "" nil nil switches)))
(when (string-match "--group-directories-first" switches)
;; if ls-lisp-dirs-first is nil, dirs are grouped but come out in
;; reverse order:
(setq ls-lisp-dirs-first t)
(setq switches (replace-match "" nil nil switches)))
;; Remove unrecognized long options, and convert the
;; recognized ones to their short variants.
(setq switches (ls-lisp--sanitize-switches switches))
;; Convert SWITCHES to a list of characters.
(setq switches (delete ?\ (delete ?- (append switches nil))))
;; Sometimes we get ".../foo*/" as FILE. While the shell and
@ -890,6 +900,60 @@ All ls time options, namely c, t and u, are handled."
;; Continue standard unloading.
nil)
(defun ls-lisp--sanitize-switches (switches)
"Convert long options of GNU 'ls' to their short form.
Conversion is done only for flags supported by ls-lisp.
Long options not supported by ls-lisp are removed.
Supported options are: A a B C c F G g h i n R r S s t U u v X.
The l switch is assumed to be always present and cannot be turned off."
(let ((lsflags '(("-a" . "--all")
("-A" . "--almost-all")
("-B" . "--ignore-backups")
("-C" . "--color")
("-F" . "--classify")
("-G" . "--no-group")
("-h" . "--human-readable")
("-H" . "--dereference-command-line")
("-i" . "--inode")
("-n" . "--numeric-uid-gid")
("-r" . "--reverse")
("-R" . "--recursive")
("-s" . "--size")
("-S" . "--sort.*[ \\\t]")
("" . "--group-directories-first")
("" . "--author")
("" . "--escape")
("" . "--directory")
("" . "--dired")
("" . "--file-type")
("" . "--format")
("" . "--full-time")
("" . "--si")
("" . "--dereference-command-line-symlink-to-dir")
("" . "--hide")
("" . "--hyperlink")
("" . "--ignore")
("" . "--kibibytes")
("" . "--dereference")
("" . "--literal")
("" . "--hide-control-chars")
("" . "--show-control-chars")
("" . "--quote-name")
("" . "--context")
("" . "--help")
;; ("" . "--indicator-style.*[ \\\t]")
;; ("" . "--quoting-style.*[ \t\\]")
;; ("" . "--time.*[ \\\t]")
;; ("" . "--time-style.*[ \\\t]")
;; ("" . "--tabsize.*[ \\\t]")
;; ("" . "--width.*[ \\\t]")
("" . "--.*=.*[ \\\t\n]?") ;; catch all with '=' sign in
("" . "--version"))))
(dolist (f lsflags)
(if (string-match (cdr f) switches)
(setq switches (replace-match (car f) nil nil switches))))
(string-trim switches)))
(provide 'ls-lisp)
;;; ls-lisp.el ends here

80
lisp/mail/smtpmail.el
View file

@ -135,8 +135,9 @@ Used for the value of `sendmail-coding-system' when
(defcustom smtpmail-queue-mail nil
"Non-nil means mail is queued; otherwise it is sent immediately.
If queued, it is stored in the directory `smtpmail-queue-dir'
and sent with `smtpmail-send-queued-mail'."
If queued, it is stored in the directory `smtpmail-queue-dir' and
sent with `smtpmail-send-queued-mail'. Also see
`smtpmail-store-queue-variables'."
:type 'boolean)
(defcustom smtpmail-queue-dir "~/Mail/queued-mail/"
@ -173,10 +174,21 @@ mean \"try again\"."
:type 'integer
:version "27.1")
(defcustom smtpmail-store-queue-variables nil
"If non-nil, store SMTP variables when queueing mail.
These will then be used when sending the queue."
:type 'boolean
:version "28.1")
;;; Variables
(defvar smtpmail-address-buffer)
(defvar smtpmail-recipient-address-list)
(defvar smtpmail-recipient-address-list nil)
(defvar smtpmail--stored-queue-variables
'(smtpmail-smtp-server
smtpmail-stream-type
smtpmail-smtp-service
smtpmail-smtp-user))
(defvar smtpmail-queue-counter 0)
@ -387,11 +399,17 @@ for `smtpmail-try-auth-method'.")
nil t)
(insert-buffer-substring tembuf)
(write-file file-data)
(write-region
(concat "(setq smtpmail-recipient-address-list '"
(prin1-to-string smtpmail-recipient-address-list)
")\n")
nil file-elisp nil 'silent)
(let ((coding-system-for-write 'utf-8))
(with-temp-buffer
(insert "(setq ")
(dolist (var (cons 'smtpmail-recipient-address-list
;; Perhaps store the server etc.
(and smtpmail-store-queue-variables
smtpmail--stored-queue-variables)))
(insert (format " %s %S\n" var (symbol-value var))))
(insert ")\n")
(write-region (point-min) (point-max) file-elisp
nil 'silent)))
(write-region (concat file-data "\n") nil
(expand-file-name smtpmail-queue-index-file
smtpmail-queue-dir)
@ -411,26 +429,30 @@ for `smtpmail-try-auth-method'.")
(let (file-data file-elisp
(qfile (expand-file-name smtpmail-queue-index-file
smtpmail-queue-dir))
(stored (cons 'smtpmail-recipient-address-list
smtpmail--stored-queue-variables))
smtpmail-recipient-address-list
(smtpmail-smtp-server smtpmail-smtp-server)
(smtpmail-stream-type smtpmail-stream-type)
(smtpmail-smtp-service smtpmail-smtp-service)
(smtpmail-smtp-user smtpmail-smtp-user)
result)
(insert-file-contents qfile)
(goto-char (point-min))
(while (not (eobp))
(setq file-data (buffer-substring (point) (line-end-position)))
(setq file-elisp (concat file-data ".el"))
;; FIXME: Avoid `load' which can execute arbitrary code and is hence
;; a source of security holes. Better read the file and extract the
;; data "by hand".
;;(load file-elisp)
(with-temp-buffer
(insert-file-contents file-elisp)
(goto-char (point-min))
(pcase (read (current-buffer))
(`(setq smtpmail-recipient-address-list ',v)
(skip-chars-forward " \n\t")
(unless (eobp) (message "Ignoring trailing text in %S"
file-elisp))
(setq smtpmail-recipient-address-list v))
(sexp (error "Unexpected code in %S: %S" file-elisp sexp))))
(let ((coding-system-for-read 'utf-8))
(with-temp-buffer
(insert-file-contents file-elisp)
(let ((form (read (current-buffer))))
(when (or (not (consp form))
(not (eq (car form) 'setq))
(not (consp (cdr form))))
(error "Unexpected code in %S: %S" file-elisp form))
(cl-loop for (var val) on (cdr form) by #'cddr
when (memq var stored)
do (set var val)))))
;; Insert the message literally: it is already encoded as per
;; the MIME headers, and code conversions might guess the
;; encoding wrongly.
@ -445,13 +467,13 @@ for `smtpmail-try-auth-method'.")
(message-narrow-to-headers)
(mail-envelope-from)))
user-mail-address)))
(if (not (null smtpmail-recipient-address-list))
(when (setq result (smtpmail-via-smtp
smtpmail-recipient-address-list
(current-buffer)))
(error "Sending failed: %s"
(smtpmail--sanitize-error-message result)))
(error "Sending failed; no recipients"))))
(if (not smtpmail-recipient-address-list)
(error "Sending failed; no recipients")
(when (setq result (smtpmail-via-smtp
smtpmail-recipient-address-list
(current-buffer)))
(error "Sending failed: %s"
(smtpmail--sanitize-error-message result))))))
(delete-file file-data)
(delete-file file-elisp)
(delete-region (point-at-bol) (point-at-bol 2)))

9
lisp/minibuffer.el
View file

@ -2328,6 +2328,15 @@ variables.")
(setq deactivate-mark nil)
(throw 'exit nil))
(defun minibuffer-quit-recursive-edit ()
"Quit the command that requested this recursive edit without error.
Like `abort-recursive-edit' without aborting keyboard macro
execution."
;; See Info node `(elisp)Recursive Editing' for an explanation of
;; throwing a function to `exit'.
(throw 'exit (lambda ()
(signal 'minibuffer-quit nil))))
(defun self-insert-and-exit ()
"Terminate minibuffer input."
(interactive)

1404
lisp/net/rcirc.el
View file

File diff suppressed because it is too large Load diff

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

@ -327,9 +327,9 @@ arguments to pass to the OPERATION."
v (format "%s -d -a -l %s %s"
(tramp-adb-get-ls-command v)
(tramp-shell-quote-argument
(concat (file-name-as-directory localname) "."))
(tramp-compat-file-name-concat localname "."))
(tramp-shell-quote-argument
(concat (file-name-as-directory localname) ".."))))
(tramp-compat-file-name-concat localname ".."))))
(widen)))
(tramp-adb-sh-fix-ls-output)
(let ((result (tramp-do-parse-file-attributes-with-ls
@ -549,14 +549,14 @@ But handle the case, if the \"test\" command is not available."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
(let (file-locked
(let ((file-locked (eq (file-locked-p lockname) t))
(curbuf (current-buffer))
(tmpfile (tramp-compat-make-temp-file filename)))
;; Lock file.
(when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
(file-remote-p lockname)
(not (eq (file-locked-p lockname) t)))
(not file-locked))
(setq file-locked t)
;; `lock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'lock-file lockname))
@ -592,7 +592,7 @@ But handle the case, if the \"test\" command is not available."
(current-time))))
;; Unlock file.
(when (and file-locked (eq (file-locked-p lockname) t))
(when file-locked
;; `unlock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'unlock-file lockname))

14
lisp/net/tramp-compat.el
View file

@ -363,6 +363,20 @@ A nil value for either argument stands for the current time."
".#" (file-name-nondirectory filename))
(file-name-directory filename)))))
;; Function `file-name-concat' is new in Emacs 28.1.
(defalias 'tramp-compat-file-name-concat
(if (fboundp 'file-name-concat)
#'file-name-concat
(lambda (directory &rest components)
(unless (null directory)
(let ((components (delq nil components))
file-name-handler-alist)
(if (null components)
directory
(tramp-compat-file-name-concat
(concat (file-name-as-directory directory) (car components))
(cdr components))))))))
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
(put (intern elt) 'tramp-suppress-trace t))

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

@ -1142,7 +1142,7 @@ file names."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (concat (file-name-as-directory dir) name)))
(setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))

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

@ -519,6 +519,7 @@ shell from reading its init file."
(tramp-yn-prompt-regexp tramp-action-yn)
(tramp-terminal-prompt-regexp tramp-action-terminal)
(tramp-antispoof-regexp tramp-action-confirm-message)
(tramp-yubikey-regexp tramp-action-show-and-confirm-message)
(tramp-process-alive-regexp tramp-action-process-alive))
"List of pattern/action pairs.
Whenever a pattern matches, the corresponding action is performed.
@ -536,6 +537,7 @@ corresponding PATTERN matches, the ACTION function is called.")
'((tramp-password-prompt-regexp tramp-action-password)
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
(tramp-copy-failed-regexp tramp-action-permission-denied)
(tramp-yubikey-regexp tramp-action-show-and-confirm-message)
(tramp-process-alive-regexp tramp-action-out-of-band))
"List of pattern/action pairs.
This list is used for copying/renaming with out-of-band methods.
@ -1944,7 +1946,7 @@ file names."
(length (tramp-compat-file-attribute-size
(file-attributes (file-truename filename))))
(attributes (and preserve-extended-attributes
(apply #'file-extended-attributes (list filename))))
(file-extended-attributes filename)))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
@ -2020,7 +2022,7 @@ file names."
;; errors, because ACL strings could be incompatible.
(when attributes
(ignore-errors
(apply #'set-file-extended-attributes (list newname attributes))))
(set-file-extended-attributes newname attributes)))
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
@ -2679,7 +2681,7 @@ the result will be a local, non-Tramp, file name."
(tramp-run-real-handler #'expand-file-name (list name dir))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (concat (file-name-as-directory dir) name)))
(setq name (tramp-compat-file-name-concat dir name)))
;; If connection is not established yet, run the real handler.
(if (not (tramp-connectable-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@ -3249,7 +3251,7 @@ implementation will be used."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
(let (file-locked
(let ((file-locked (eq (file-locked-p lockname) t))
(uid (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
(tramp-get-remote-uid v 'integer)))
@ -3260,7 +3262,7 @@ implementation will be used."
;; Lock file.
(when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
(file-remote-p lockname)
(not (eq (file-locked-p lockname) t)))
(not file-locked))
(setq file-locked t)
;; `lock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'lock-file lockname))
@ -3481,7 +3483,7 @@ implementation will be used."
(tramp-set-file-uid-gid filename uid gid))
;; Unlock file.
(when (and file-locked (eq (file-locked-p lockname) t))
(when file-locked
;; `unlock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'unlock-file lockname))
@ -4782,7 +4784,9 @@ Goes through the list `tramp-inline-compress-commands'."
(with-temp-buffer
(tramp-call-process vec "scp" nil t nil "-T")
(goto-char (point-min))
(unless (search-forward-regexp "unknown option -- T" nil t)
(unless
(search-forward-regexp
"\\(illegal\\|unknown\\) option -- T" nil t)
(setq tramp-scp-strict-file-name-checking "-T")))))))
tramp-scp-strict-file-name-checking)))

8
lisp/net/tramp-smb.el
View file

@ -722,7 +722,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (concat (file-name-as-directory dir) name)))
(setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@ -1589,14 +1589,14 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
(let (file-locked
(let ((file-locked (eq (file-locked-p lockname) t))
(curbuf (current-buffer))
(tmpfile (tramp-compat-make-temp-file filename)))
;; Lock file.
(when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
(file-remote-p lockname)
(not (eq (file-locked-p lockname) t)))
(not file-locked))
(setq file-locked t)
;; `lock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'lock-file lockname))
@ -1635,7 +1635,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(current-time))))
;; Unlock file.
(when (and file-locked (eq (file-locked-p lockname) t))
(when file-locked
;; `unlock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'unlock-file lockname))

6
lisp/net/tramp-sshfs.el
View file

@ -295,12 +295,12 @@ arguments to pass to the OPERATION."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
(let (file-locked)
(let ((file-locked (eq (file-locked-p lockname) t)))
;; Lock file.
(when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
(file-remote-p lockname)
(not (eq (file-locked-p lockname) t)))
(not file-locked))
(setq file-locked t)
;; `lock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'lock-file lockname))
@ -311,7 +311,7 @@ arguments to pass to the OPERATION."
(tramp-flush-file-properties v localname))
;; Unlock file.
(when (and file-locked (eq (file-locked-p lockname) t))
(when file-locked
;; `unlock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'unlock-file lockname))

20
lisp/net/tramp-sudoedit.el
View file

@ -237,7 +237,7 @@ absolute file names."
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(attributes (and preserve-extended-attributes
(apply #'file-extended-attributes (list filename))))
(file-extended-attributes filename)))
(sudoedit-operation
(cond
((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p"))
@ -293,7 +293,7 @@ absolute file names."
;; errors, because ACL strings could be incompatible.
(when attributes
(ignore-errors
(apply #'set-file-extended-attributes (list newname attributes))))
(set-file-extended-attributes newname attributes)))
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
@ -353,7 +353,7 @@ the result will be a local, non-Tramp, file name."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (concat (file-name-as-directory dir) name)))
(setq name (tramp-compat-file-name-concat dir name)))
(with-parsed-tramp-file-name name nil
;; Tilde expansion if necessary. We cannot accept "~/", because
;; under sudo "~/" is expanded to the local user home directory
@ -726,13 +726,14 @@ ID-FORMAT valid values are `string' and `integer'."
(file-attributes filename 'integer))
(tramp-get-remote-gid v 'integer)))
(flag (and (eq mustbenew 'excl) 'nofollow))
(modes (tramp-default-file-modes filename flag)))
(modes (tramp-default-file-modes filename flag))
(attributes (file-extended-attributes filename)))
(prog1
(tramp-handle-write-region
start end filename append visit lockname mustbenew)
;; Set the ownership and modes. This is not performed in
;; `tramp-handle-write-region'.
;; Set the ownership, modes and extended attributes. This is
;; not performed in `tramp-handle-write-region'.
(unless (and (= (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
uid)
@ -740,7 +741,12 @@ ID-FORMAT valid values are `string' and `integer'."
(file-attributes filename 'integer))
gid))
(tramp-set-file-uid-gid filename uid gid))
(tramp-compat-set-file-modes filename modes flag)))))
(tramp-compat-set-file-modes filename modes flag)
;; We ignore possible errors, because ACL strings could be
;; incompatible.
(when attributes
(ignore-errors
(set-file-extended-attributes filename attributes)))))))
;; Internal functions.

31
lisp/net/tramp.el
View file

@ -698,6 +698,15 @@ The regexp should match at end of buffer."
:version "27.1"
:type 'regexp)
;; Yubikey requires the user physically to touch the device with their
;; finger. We must tell it to the user.
(defcustom tramp-yubikey-regexp
"Confirm user presence for key .*"
"Regular expression matching yubikey confirmation message.
The regexp should match at end of buffer."
:version "28.1"
:type 'regexp)
(defcustom tramp-operation-not-permitted-regexp
(concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
(regexp-opt '("Operation not permitted") t))
@ -3337,7 +3346,7 @@ User is always nil."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (concat (file-name-as-directory dir) name)))
(setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@ -4463,7 +4472,7 @@ of."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
(let (file-locked
(let ((file-locked (eq (file-locked-p lockname) t))
(tmpfile (tramp-compat-make-temp-file filename))
(modes (tramp-default-file-modes
filename (and (eq mustbenew 'excl) 'nofollow)))
@ -4477,7 +4486,7 @@ of."
;; Lock file.
(when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
(file-remote-p lockname)
(not (eq (file-locked-p lockname) t)))
(not file-locked))
(setq file-locked t)
;; `lock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'lock-file lockname))
@ -4515,7 +4524,7 @@ of."
(tramp-set-file-uid-gid filename uid gid)
;; Unlock file.
(when (and file-locked (eq (file-locked-p lockname) t))
(when file-locked
;; `unlock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'unlock-file lockname))
@ -4669,6 +4678,20 @@ The terminal type can be configured with `tramp-terminal-type'."
(tramp-send-string vec tramp-local-end-of-line)
t)
(defun tramp-action-show-and-confirm-message (_proc vec)
"Show the user a message for confirmation.
Wait, until the user has entered RET."
(save-window-excursion
(let ((enable-recursive-minibuffers t)
(stimers (with-timeout-suspend)))
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string))
(pop-to-buffer (current-buffer)))
(read-string "Press ENTER to continue")
;; Reenable the timers.
(with-timeout-unsuspend stimers)))
t)
(defun tramp-action-process-alive (proc _vec)
"Check, whether a process has finished."
(unless (process-live-p proc)

20
lisp/newcomment.el
View file

@ -840,9 +840,13 @@ Ensure that `comment-normalize-vars' has been called before you use this."
(make-string (min comment-padding
(- (match-end 0) (match-end 1)))
?\s)
(substring comment-padding ;additional right padding
(min (- (match-end 0) (match-end 1))
(length comment-padding))))))
(if (not (string-match-p "\\`\\s-" comment-padding))
;; If the padding isn't spaces, then don't
;; shorten the padding.
comment-padding
(substring comment-padding ;additional right padding
(min (- (match-end 0) (match-end 1))
(length comment-padding)))))))
;; We can only duplicate C if the comment-end has multiple chars
;; or if comments can be nested, else the comment-end `}' would
;; be turned into `}}}' where only the first ends the comment
@ -876,9 +880,13 @@ Ensure that `comment-normalize-vars' has been called before you use this."
;; Only separate the left pad because we assume there is no right pad.
(string-match "\\`\\s-*" str)
(let ((s (substring str (match-end 0)))
(pad (concat (substring comment-padding
(min (- (match-end 0) (match-beginning 0))
(length comment-padding)))
(pad (concat (if (not (string-match-p "\\`\\s-" comment-padding))
;; If the padding isn't spaces, then don't
;; shorten the padding.
comment-padding
(substring comment-padding
(min (- (match-end 0) (match-beginning 0))
(length comment-padding))))
(match-string 0 str)))
(c (aref str (match-end 0))) ;the first non-space char of STR
;; We can only duplicate C if the comment-end has multiple chars

1
lisp/progmodes/bug-reference.el
View file

@ -345,6 +345,7 @@ and set it if applicable."
(defvar gnus-article-buffer)
(defvar gnus-original-article-buffer)
(defvar gnus-summary-buffer)
(defvar bug-reference-mode)
(defun bug-reference--try-setup-gnus-article ()
(when (and bug-reference-mode ;; Only if enabled in article buffers.

15
lisp/progmodes/compile.el
View file

@ -1248,11 +1248,14 @@ POS and RES.")
(setq col (match-string-no-properties col))
(string-to-number col))))
(setq end-col
(or (if (functionp end-col) (funcall end-col)
(and end-col
(setq end-col (match-string-no-properties end-col))
(- (string-to-number end-col) -1)))
(and end-line -1)))
(let ((ec (if (functionp end-col)
(funcall end-col)
(and end-col (match-beginning end-col)
(string-to-number
(match-string-no-properties end-col))))))
(if ec
(1+ ec) ; Add one to get an exclusive upper bound.
(and end-line -1))))
(if (consp type) ; not a static type, check what it is.
(setq type (or (and (car type) (match-end (car type)) 1)
(and (cdr type) (match-end (cdr type)) 0)
@ -1540,7 +1543,7 @@ to `compilation-error-regexp-alist' if RULES is nil."
file line end-line col end-col
(or type 2) fmt rule))
(when (integerp file)
(when file
(let ((this-type (if (consp type)
(compilation-type type)
(or type 2))))

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

@ -1325,8 +1325,7 @@ Reinitialize the face according to the `defface' specification."
((eq (car form) 'custom-declare-face)
;; Reset the face.
(let ((face-symbol (eval (nth 1 form) lexical-binding)))
(setq face-new-frame-defaults
(assq-delete-all face-symbol face-new-frame-defaults))
(remhash face-symbol face--new-frame-defaults)
(put face-symbol 'face-defface-spec nil)
(put face-symbol 'face-override-spec nil))
form)

96
lisp/progmodes/gdb-mi.el
View file

@ -581,6 +581,23 @@ stopped thread is already selected."
:group 'gdb-buffers
:version "23.2")
(defcustom gdb-registers-enable-filter nil
"If non-nil, enable register name filter in register buffer.
Use `gdb-registers-filter-pattern-list' to control what register to
filter."
:type 'boolean
:group 'gdb-buffers
:version "28.1")
(defcustom gdb-registers-filter-pattern-list nil
"Patterns for names that are displayed in register buffer.
Each pattern is a regular expression. GDB displays registers
whose name matches any pattern in the list. Refresh the register
buffer for the change to take effect."
:type 'list
:group 'gdb-buffers
:version "28.1")
(defvar gdb-debug-log nil
"List of commands sent to and replies received from GDB.
Most recent commands are listed first. This list stores only the last
@ -4393,6 +4410,26 @@ member."
'gdb-registers-mode
'gdb-invalidate-registers)
(defun gdb-header-click-event-handler (function)
"Return a function that handles clicking event on gdb header buttons.
This function switches to the window where the header locates and
executes FUNCTION."
(lambda (event)
(interactive "e")
(save-selected-window
;; Make sure we are in the right buffer.
(select-window (posn-window (event-start event)))
(funcall function))))
(defun gdb-registers-toggle-filter ()
"Toggle register filter."
(interactive)
(setq gdb-registers-enable-filter
(not gdb-registers-enable-filter))
;; Update the register buffer.
(gdb-invalidate-registers 'update))
(defun gdb-registers-handler-custom ()
(when gdb-register-names
(let ((register-values
@ -4403,17 +4440,27 @@ member."
(value (gdb-mi--field register 'value))
(register-name (nth (string-to-number register-number)
gdb-register-names)))
(gdb-table-add-row
table
(list
(propertize register-name
'font-lock-face font-lock-variable-name-face)
(if (member register-number gdb-changed-registers)
(propertize value 'font-lock-face font-lock-warning-face)
value))
`(mouse-face highlight
help-echo "mouse-2: edit value"
gdb-register-name ,register-name))))
;; Add register if `gdb-registers-filter-pattern-list' is nil;
;; or any pattern that `gdb-registers-filter-pattern-list'
;; matches.
(when (or (null gdb-registers-enable-filter)
;; Return t if any register name matches a pattern.
(cl-loop for pattern
in gdb-registers-filter-pattern-list
if (string-match pattern register-name)
return t
finally return nil))
(gdb-table-add-row
table
(list
(propertize register-name
'font-lock-face font-lock-variable-name-face)
(if (member register-number gdb-changed-registers)
(propertize value 'font-lock-face font-lock-warning-face)
value))
`(mouse-face highlight
help-echo "mouse-2: edit value"
gdb-register-name ,register-name)))))
(insert (gdb-table-string table " ")))
(setq mode-name
(gdb-current-context-mode-name "Registers"))))
@ -4441,6 +4488,7 @@ member."
(gdb-get-buffer-create
'gdb-locals-buffer
gdb-thread-number) t)))
(define-key map "f" #'gdb-registers-toggle-filter)
map))
(defvar gdb-registers-header
@ -4450,7 +4498,31 @@ member."
mode-line-inactive)
" "
(gdb-propertize-header "Registers" gdb-registers-buffer
nil nil mode-line)))
nil nil mode-line)
" "
'(:eval
(format
"[filter %s %s]"
(propertize
(if gdb-registers-enable-filter "[on]" "[off]")
'face (if gdb-registers-enable-filter
'(:weight bold :inherit success)
'shadow)
'help-echo "mouse-1: toggle filter"
'mouse-face 'mode-line-highlight
'local-map (gdb-make-header-line-mouse-map
'mouse-1 (gdb-header-click-event-handler
#'gdb-registers-toggle-filter)))
(propertize
"[set]"
'face 'mode-line
'help-echo "mouse-1: Customize filter patterns"
'mouse-face 'mode-line-highlight
'local-map (gdb-make-header-line-mouse-map
'mouse-1 (lambda ()
(interactive)
(customize-variable-other-window
'gdb-registers-filter-pattern-list))))))))
(define-derived-mode gdb-registers-mode gdb-parent-mode "Registers"
"Major mode for gdb registers."

324
lisp/replace.el
View file

@ -792,12 +792,8 @@ which will run faster and will not set the mark or print anything."
Maximum length of the history list is determined by the value
of `history-length', which see.")
(defvar occur-highlight-regexp t
"Regexp matching part of visited source lines to highlight temporarily.
Highlight entire line if t; don't highlight source lines if nil.")
(defvar occur-highlight-overlay nil
"Overlay used to temporarily highlight occur matches.")
(defvar occur-highlight-overlays nil
"Overlays used to temporarily highlight occur matches.")
(defvar occur-collect-regexp-history '("\\1")
"History of regexp for occur's collect operation")
@ -1054,6 +1050,130 @@ also print the number."
count))
count))
(defun kill-matching-lines (regexp &optional rstart rend interactive)
"Kill lines containing matches for REGEXP.
When called from Lisp (and usually when called interactively as
well, see below), applies to the part of the buffer after point.
The line point is in is killed if and only if it contains a match
for REGEXP starting after point.
If REGEXP contains upper case characters (excluding those
preceded by `\\') and `search-upper-case' is non-nil, the
matching is case-sensitive.
Second and third args RSTART and REND specify the region to
operate on. Lines partially contained in this region are killed
if and only if they contain a match entirely contained in the
region.
Interactively, in Transient Mark mode when the mark is active,
operate on the contents of the region. Otherwise, operate from
point to the end of (the accessible portion of) the buffer.
If a match is split across lines, all the lines it lies in are
killed. They are killed _before_ looking for the next match.
Hence, a match starting on the same line at which another match
ended is ignored.
Return the number of killed matching lines. When called
interactively, also print the number."
(interactive
(progn
(barf-if-buffer-read-only)
(keep-lines-read-args "Kill lines containing match for regexp")))
(if rstart
(progn
(goto-char (min rstart rend))
(setq rend (copy-marker (max rstart rend))))
(if (and interactive (use-region-p))
(setq rstart (region-beginning)
rend (copy-marker (region-end)))
(setq rstart (point)
rend (point-max-marker)))
(goto-char rstart))
(let ((count 0)
(case-fold-search
(if (and case-fold-search search-upper-case)
(isearch-no-upper-case-p regexp t)
case-fold-search)))
(save-excursion
(while (and (< (point) rend)
(re-search-forward regexp rend t))
(unless (zerop count)
(setq last-command 'kill-region))
(kill-region (save-excursion (goto-char (match-beginning 0))
(forward-line 0)
(point))
(progn (forward-line 1) (point)))
(setq count (1+ count))))
(set-marker rend nil)
(when interactive (message (ngettext "Killed %d matching line"
"Killed %d matching lines"
count)
count))
count))
(defun copy-matching-lines (regexp &optional rstart rend interactive)
"Copy lines containing matches for REGEXP to the kill ring.
When called from Lisp (and usually when called interactively as
well, see below), applies to the part of the buffer after point.
The line point is in is copied if and only if it contains a match
for REGEXP starting after point.
If REGEXP contains upper case characters (excluding those
preceded by `\\') and `search-upper-case' is non-nil, the
matching is case-sensitive.
Second and third args RSTART and REND specify the region to
operate on. Lines partially contained in this region are copied
if and only if they contain a match entirely contained in the
region.
Interactively, in Transient Mark mode when the mark is active,
operate on the contents of the region. Otherwise, operate from
point to the end of (the accessible portion of) the buffer.
If a match is split across lines, all the lines it lies in are
copied.
Return the number of copied matching lines. When called
interactively, also print the number."
(interactive
(keep-lines-read-args "Copy lines containing match for regexp"))
(if rstart
(progn
(goto-char (min rstart rend))
(setq rend (copy-marker (max rstart rend))))
(if (and interactive (use-region-p))
(setq rstart (region-beginning)
rend (copy-marker (region-end)))
(setq rstart (point)
rend (point-max-marker)))
(goto-char rstart))
(let ((count 0)
(case-fold-search
(if (and case-fold-search search-upper-case)
(isearch-no-upper-case-p regexp t)
case-fold-search)))
(save-excursion
(while (and (< (point) rend)
(re-search-forward regexp rend t))
(unless (zerop count)
(setq last-command 'kill-region))
(copy-region-as-kill (save-excursion (goto-char (match-beginning 0))
(forward-line 0)
(point))
(progn (forward-line 1) (point)))
(setq count (1+ count))))
(set-marker rend nil)
(when interactive (message (ngettext "Copied %d matching line"
"Copied %d matching lines"
count)
count))
count))
(defun how-many (regexp &optional rstart rend interactive)
"Print and return number of matches for REGEXP following point.
When called from Lisp and INTERACTIVE is omitted or nil, just return
@ -1233,18 +1353,27 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]."
(occur-mode)
(message "Switching to Occur mode.")))
(defun occur--targets-start (targets)
"First marker of the `occur-target' property value TARGETS."
(if (consp targets)
(caar targets)
;; Tolerate an `occur-target' value that is a single marker for
;; compatibility.
targets))
(defun occur-after-change-function (beg end length)
(save-excursion
(goto-char beg)
(let* ((line-beg (line-beginning-position))
(m (get-text-property line-beg 'occur-target))
(targets (get-text-property line-beg 'occur-target))
(m (occur--targets-start targets))
(buf (marker-buffer m))
col)
(when (and (get-text-property line-beg 'occur-prefix)
(not (get-text-property end 'occur-prefix)))
(when (= length 0)
;; Apply occur-target property to inserted (e.g. yanked) text.
(put-text-property beg end 'occur-target m)
(put-text-property beg end 'occur-target targets)
;; Did we insert a newline? Occur Edit mode can't create new
;; Occur entries; just discard everything after the newline.
(save-excursion
@ -1269,8 +1398,27 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]."
(recenter line)
(if readonly
(message "Buffer `%s' is read only." buf)
(delete-region (line-beginning-position) (line-end-position))
(insert text))
;; Replace the line, but make the change as small as
;; possible by shrink-wrapping. That way, we avoid
;; disturbing markers unnecessarily.
(let* ((beg-pos (line-beginning-position))
(end-pos (line-end-position))
(buf-str (buffer-substring-no-properties beg-pos end-pos))
(common-prefix
(lambda (s1 s2)
(let ((c (compare-strings s1 nil nil s2 nil nil)))
(if (zerop c)
(length s1)
(1- (abs c))))))
(prefix-len (funcall common-prefix buf-str text))
(suffix-len (funcall common-prefix
(reverse buf-str) (reverse text))))
(setq beg-pos (+ beg-pos prefix-len))
(setq end-pos (- end-pos suffix-len))
(setq text (substring text prefix-len (- suffix-len)))
(delete-region beg-pos end-pos)
(goto-char beg-pos)
(insert text)))
(move-to-column col)))))))
@ -1278,35 +1426,38 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]."
"Handle `revert-buffer' for Occur mode buffers."
(apply #'occur-1 (append occur-revert-arguments (list (buffer-name)))))
(defun occur-mode-find-occurrence ()
(let ((pos (get-text-property (point) 'occur-target)))
(unless pos
(defun occur-mode--find-occurrences ()
;; The `occur-target' property value is a list of (BEG . END) for each
;; match on the line, or (for compatibility) a single marker to the start
;; of the first match.
(let* ((targets (get-text-property (point) 'occur-target))
(start (occur--targets-start targets)))
(unless targets
(error "No occurrence on this line"))
(unless (buffer-live-p (marker-buffer pos))
(unless (buffer-live-p (marker-buffer start))
(error "Buffer for this occurrence was killed"))
pos))
targets))
(defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence)
(defun occur-mode-goto-occurrence (&optional event)
"Go to the occurrence specified by EVENT, a mouse click.
If not invoked by a mouse click, go to occurrence on the current line."
(interactive (list last-nonmenu-event))
(let ((buffer (when event (current-buffer)))
(pos
(if (null event)
;; Actually `event-end' works correctly with a nil argument as
;; well, so we could dispense with this test, but let's not
;; rely on this undocumented behavior.
(occur-mode-find-occurrence)
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion
(goto-char (posn-point (event-end event)))
(occur-mode-find-occurrence)))))
(regexp occur-highlight-regexp))
(let* ((buffer (when event (current-buffer)))
(targets
(if (null event)
;; Actually `event-end' works correctly with a nil argument as
;; well, so we could dispense with this test, but let's not
;; rely on this undocumented behavior.
(occur-mode--find-occurrences)
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion
(goto-char (posn-point (event-end event)))
(occur-mode--find-occurrences)))))
(pos (occur--targets-start targets)))
(pop-to-buffer (marker-buffer pos))
(goto-char pos)
(let ((end-mk (save-excursion (re-search-forward regexp nil t))))
(occur--highlight-occurrence pos end-mk))
(occur--highlight-occurrences targets)
(when buffer (next-error-found buffer (current-buffer)))
(run-hooks 'occur-mode-find-occurrence-hook)))
@ -1314,15 +1465,15 @@ If not invoked by a mouse click, go to occurrence on the current line."
"Go to the occurrence the current line describes, in another window."
(interactive)
(let ((buffer (current-buffer))
(pos (occur-mode-find-occurrence)))
(pos (occur--targets-start (occur-mode--find-occurrences))))
(switch-to-buffer-other-window (marker-buffer pos))
(goto-char pos)
(next-error-found buffer (current-buffer))
(run-hooks 'occur-mode-find-occurrence-hook)))
;; Stolen from compile.el
(defun occur-goto-locus-delete-o ()
(delete-overlay occur-highlight-overlay)
(mapc #'delete-overlay occur-highlight-overlays)
(setq occur-highlight-overlays nil)
;; Get rid of timer and hook that would try to do this again.
(if (timerp next-error-highlight-timer)
(cancel-timer next-error-highlight-timer))
@ -1330,64 +1481,55 @@ If not invoked by a mouse click, go to occurrence on the current line."
#'occur-goto-locus-delete-o))
;; Highlight the current visited occurrence.
;; Adapted from `compilation-goto-locus'.
(defun occur--highlight-occurrence (mk end-mk)
(let ((highlight-regexp occur-highlight-regexp))
(if (timerp next-error-highlight-timer)
(cancel-timer next-error-highlight-timer))
(unless occur-highlight-overlay
(setq occur-highlight-overlay
(make-overlay (point-min) (point-min)))
(overlay-put occur-highlight-overlay 'face 'next-error))
(with-current-buffer (marker-buffer mk)
(save-excursion
(if end-mk (goto-char end-mk) (end-of-line))
(let ((end (point)))
(if mk (goto-char mk) (beginning-of-line))
(if (and (stringp highlight-regexp)
(re-search-forward highlight-regexp end t))
(progn
(goto-char (match-beginning 0))
(move-overlay occur-highlight-overlay
(match-beginning 0) (match-end 0)
(current-buffer)))
(move-overlay occur-highlight-overlay
(point) end (current-buffer)))
(if (or (eq next-error-highlight t)
(numberp next-error-highlight))
;; We want highlighting: delete overlay on next input.
(add-hook 'pre-command-hook
#'occur-goto-locus-delete-o)
;; We don't want highlighting: delete overlay now.
(delete-overlay occur-highlight-overlay))
;; We want highlighting for a limited time:
;; set up a timer to delete it.
(when (numberp next-error-highlight)
(setq next-error-highlight-timer
(run-at-time next-error-highlight nil
'occur-goto-locus-delete-o))))))
(when (eq next-error-highlight 'fringe-arrow)
;; We want a fringe arrow (instead of highlighting).
(setq next-error-overlay-arrow-position
(copy-marker (line-beginning-position))))))
(defun occur--highlight-occurrences (targets)
(let ((start-marker (occur--targets-start targets)))
(occur-goto-locus-delete-o)
(with-current-buffer (marker-buffer start-marker)
(when (or (eq next-error-highlight t)
(numberp next-error-highlight))
(setq occur-highlight-overlays
(mapcar (lambda (target)
(let ((o (make-overlay (car target) (cdr target))))
(overlay-put o 'face 'next-error)
o))
(if (listp targets)
targets
;; `occur-target' compatibility: when we only
;; have a single starting point, highlight the
;; rest of the line.
(let ((end-pos (save-excursion
(goto-char start-marker)
(line-end-position))))
(list (cons start-marker end-pos))))))
(add-hook 'pre-command-hook #'occur-goto-locus-delete-o)
(when (numberp next-error-highlight)
;; We want highlighting for a limited time:
;; set up a timer to delete it.
(setq next-error-highlight-timer
(run-at-time next-error-highlight nil
'occur-goto-locus-delete-o))))
(when (eq next-error-highlight 'fringe-arrow)
;; We want a fringe arrow (instead of highlighting).
(setq next-error-overlay-arrow-position
(copy-marker (line-beginning-position)))))))
(defun occur-mode-display-occurrence ()
"Display in another window the occurrence the current line describes."
(interactive)
(let ((buffer (current-buffer))
(pos (occur-mode-find-occurrence))
(regexp occur-highlight-regexp)
(next-error-highlight next-error-highlight-no-select)
(display-buffer-overriding-action
'(nil (inhibit-same-window . t)))
window)
(let* ((buffer (current-buffer))
(targets (occur-mode--find-occurrences))
(pos (occur--targets-start targets))
(next-error-highlight next-error-highlight-no-select)
(display-buffer-overriding-action
'(nil (inhibit-same-window . t)))
window)
(setq window (display-buffer (marker-buffer pos) t))
;; This is the way to set point in the proper window.
(save-selected-window
(select-window window)
(goto-char pos)
(let ((end-mk (save-excursion (re-search-forward regexp nil t))))
(occur--highlight-occurrence pos end-mk))
(occur--highlight-occurrences targets)
(next-error-found buffer (current-buffer))
(run-hooks 'occur-mode-find-occurrence-hook))))
@ -1744,7 +1886,6 @@ See also `multi-occur'."
(buffer-undo-list t)
(occur--final-pos nil))
(erase-buffer)
(setq-local occur-highlight-regexp regexp)
(let ((count
(if (stringp nlines)
;; Treat nlines as a regexp to collect.
@ -1844,7 +1985,7 @@ See also `multi-occur'."
(origpt nil)
(begpt nil)
(endpt nil)
(marker nil)
markers ; list of (BEG-MARKER . END-MARKER)
(curstring "")
(ret nil)
;; The following binding is for when case-fold-search
@ -1870,8 +2011,7 @@ See also `multi-occur'."
(setq endpt (line-end-position)))
;; Sum line numbers up to the first match line.
(setq curr-line (+ curr-line (count-lines origpt begpt)))
(setq marker (make-marker))
(set-marker marker matchbeg)
(setq markers nil)
(setq curstring (occur-engine-line begpt endpt keep-props))
;; Highlight the matches
(let ((len (length curstring))
@ -1893,6 +2033,11 @@ See also `multi-occur'."
(setq orig-line-shown-p t)))
(while (and (< start len)
(string-match regexp curstring start))
(push (cons (set-marker (make-marker)
(+ begpt (match-beginning 0)))
(set-marker (make-marker)
(+ begpt (match-end 0))))
markers)
(setq matches (1+ matches))
(add-text-properties
(match-beginning 0) (match-end 0)
@ -1905,6 +2050,7 @@ See also `multi-occur'."
;; Avoid infloop (Bug#7593).
(let ((end (match-end 0)))
(setq start (if (= start end) (1+ start) end)))))
(setq markers (nreverse markers))
;; Generate the string to insert for this match
(let* ((match-prefix
;; Using 7 digits aligns tabs properly.
@ -1918,7 +2064,7 @@ See also `multi-occur'."
;; (for Occur Edit mode).
front-sticky t
rear-nonsticky t
occur-target ,marker
occur-target ,markers
follow-link t
help-echo "mouse-2: go to this occurrence"))))
(match-str
@ -1926,7 +2072,7 @@ See also `multi-occur'."
;; because that loses. And don't put it
;; on context lines to reduce flicker.
(propertize curstring
'occur-target marker
'occur-target markers
'follow-link t
'help-echo
"mouse-2: go to this occurrence"))
@ -1945,8 +2091,8 @@ See also `multi-occur'."
;; get a contiguous highlight.
(propertize (concat match-prefix match-str)
'mouse-face 'highlight))
;; Add marker at eol, but no mouse props.
(propertize "\n" 'occur-target marker)))
;; Add markers at eol, but no mouse props.
(propertize "\n" 'occur-target markers)))
(data
(if (= nlines 0)
;; The simple display style

21
lisp/shadowfile.el
View file

@ -128,7 +128,7 @@ Default: ~/.emacs.d/shadow_todo"
(defvar shadow-system-name (concat "/" (system-name) ":")
"The identification for local files on this machine.")
(defvar shadow-homedir "~"
(defvar shadow-homedir "~/"
"Your home directory on this machine.")
;;;
@ -284,9 +284,13 @@ Argument can be a simple name, remote file name, or already a
(defsubst shadow-make-fullname (hup &optional host name)
"Make a Tramp style fullname out of HUP, a `tramp-file-name' structure.
Replace HOST, and NAME when non-nil."
Replace HOST, and NAME when non-nil. HOST can also be a remote file name."
(let ((hup (copy-tramp-file-name hup)))
(when host (setf (tramp-file-name-host hup) host))
(when host
(if (file-remote-p host)
(setq name (or name (and hup (tramp-file-name-localname hup)))
hup (tramp-dissect-file-name (file-remote-p host)))
(setf (tramp-file-name-host hup) host)))
(when name (setf (tramp-file-name-localname hup) name))
(if (null (tramp-file-name-method hup))
(format
@ -348,15 +352,16 @@ Will return the name bare if it is a local file."
(defun shadow-contract-file-name (file)
"Simplify FILE.
Do so by replacing (when possible) home directory with ~, and hostname
with cluster name that includes it. Filename should be absolute and
true."
Do so by replacing (when possible) home directory with ~/, and
hostname with cluster name that includes it. Filename should be
absolute and true."
(let* ((hup (shadow-parse-name file))
(homedir (if (shadow-local-file hup)
shadow-homedir
(file-name-as-directory
(file-local-name
(expand-file-name (shadow-make-fullname hup nil "~"))))))
(expand-file-name
(shadow-make-fullname hup nil shadow-homedir))))))
(suffix (shadow-suffix homedir (tramp-file-name-localname hup)))
(cluster (shadow-site-cluster (shadow-make-fullname hup nil ""))))
(when cluster
@ -365,7 +370,7 @@ true."
(shadow-make-fullname
hup nil
(if suffix
(concat "~/" suffix)
(concat shadow-homedir suffix)
(tramp-file-name-localname hup)))))
(defun shadow-same-site (pattern file)

40
lisp/simple.el
View file

@ -695,6 +695,30 @@ When called from Lisp code, ARG may be a prefix string to copy."
(indent-to col 0)
(goto-char pos)))
(defface separator-line
'((((type graphic) (background dark))
:height 0.1 :background "#505050")
(((type graphic) (background light))
:height 0.1 :background "#a0a0a0")
(t :foreground "ForestGreen"))
"Face for separator lines."
:version "28.1"
:group 'text)
(defun make-separator-line (&optional length)
"Make a string appropriate for usage as a visual separator line.
This uses the `separator-line' face.
If LENGTH is nil, use the window width."
(if (display-graphic-p)
(if length
(concat (propertize (make-string length ?\s) 'face 'separator-line)
"\n")
(propertize "\n" 'face '(:inherit separator-line :extend t)))
(concat (propertize (make-string (or length (1- (window-width))) ?-)
'face 'separator-line)
"\n")))
(defun delete-indentation (&optional arg beg end)
"Join this line to previous and fix up whitespace at join.
If there is a fill prefix, delete it from the beginning of this
@ -2855,8 +2879,10 @@ Go to the history element by the absolute history position HIST-POS."
The same as `command-error-default-function' but display error messages
at the end of the minibuffer using `minibuffer-message' to not obscure
the minibuffer contents."
(discard-input)
(ding)
(if (memq 'minibuffer-quit (get (car data) 'error-conditions))
(ding t)
(discard-input)
(ding))
(let ((string (error-message-string data)))
;; If we know from where the error was signaled, show it in
;; *Messages*.
@ -6682,6 +6708,10 @@ or \"mark.*active\" at the prompt."
;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
:variable (default-value 'transient-mark-mode))
(define-minor-mode indent-tabs-mode
"Toggle whether indentation can insert TAB characters."
:global t :group 'indent :variable indent-tabs-mode)
(defvar widen-automatically t
"Non-nil means it is ok for commands to call `widen' when they want to.
Some commands will do this in order to go to positions outside
@ -9505,9 +9535,9 @@ call `normal-erase-is-backspace-mode' (which see) instead."
:set (lambda (symbol value)
;; The fboundp is because of a problem with :set when
;; dumping Emacs. It doesn't really matter.
(if (fboundp 'normal-erase-is-backspace-mode)
(normal-erase-is-backspace-mode (or value 0))
(set-default symbol value))))
(when (fboundp 'normal-erase-is-backspace-mode)
(normal-erase-is-backspace-mode (or value 0)))
(set-default symbol value)))
(defun normal-erase-is-backspace-setup-frame (&optional frame)
"Set up `normal-erase-is-backspace-mode' on FRAME, if necessary."

1
lisp/startup.el
View file

@ -2393,6 +2393,7 @@ nil default-directory" name)
(command-line-normalize-file-name name)
dir))
(buf (find-file-noselect file)))
(file-name-history--add file)
(setq displayable-buffers (cons buf displayable-buffers))
;; Set the file buffer to the current buffer so
;; that it will be used with "--eval" and

11
lisp/subr.el
View file

@ -31,7 +31,8 @@
"Tell the byte-compiler that function FN is defined, in FILE.
The FILE argument is not used by the byte-compiler, but by the
`check-declare' package, which checks that FILE contains a
definition for FN.
definition for FN. (FILE can be nil, and that disables this
check.)
FILE can be either a Lisp file (in which case the \".el\"
extension is optional), or a C file. C files are expanded
@ -6311,4 +6312,12 @@ of fill.el (for example `fill-region')."
This is intended for internal use only."
(internal--fill-string-single-line (apply #'format string objects)))
(defun json-available-p ()
"Return non-nil if Emacs has libjansson support."
(and (fboundp 'json-serialize)
(condition-case nil
(json-serialize t)
(:success t)
(json-unavailable nil))))
;;; subr.el ends here

2
lisp/tab-bar.el
View file

@ -136,7 +136,7 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
;; Replace default value with a condition that supports displaying
;; global-mode-string in the tab bar instead of the mode line.
(when (and (memq 'tab-bar-format-global tab-bar-format)
(member '(global-mode-string ("" global-mode-string " "))
(member '(global-mode-string ("" global-mode-string))
mode-line-misc-info))
(setf (alist-get 'global-mode-string mode-line-misc-info)
'(("" (:eval (if (and tab-bar-mode

30
lisp/term.el
View file

@ -864,8 +864,30 @@ is buffer-local."
["Paging" term-pager-toggle :style toggle :selected term-pager-count
:help "Toggle paging feature"]))
(defun term--update-term-menu (&optional force)
(when (and (lookup-key term-mode-map [menu-bar terminal])
(or force (frame-or-buffer-changed-p)))
(let ((buffer-list
(seq-filter
(lambda (buffer)
(provided-mode-derived-p (buffer-local-value 'major-mode buffer)
'term-mode))
(buffer-list))))
(easy-menu-change
'("Terminal")
"Terminal Buffers"
(mapcar
(lambda (buffer)
(vector (format "%s (%s)" (buffer-name buffer)
(abbreviate-file-name
(buffer-local-value 'default-directory buffer)))
(lambda ()
(interactive)
(switch-to-buffer buffer))))
buffer-list)))))
(easy-menu-define term-signals-menu
(list term-mode-map term-raw-map term-pager-break-map)
(list term-mode-map term-raw-map term-pager-break-map)
"Signals menu for Term mode."
'("Signals"
["BREAK" term-interrupt-subjob :active t
@ -1076,6 +1098,7 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(setq-local term-pending-delete-marker (make-marker))
(make-local-variable 'term-current-face)
(term-ansi-reset)
(add-hook 'menu-bar-update-hook 'term--update-term-menu)
(setq-local term-pending-frame nil)
;; Cua-mode's keybindings interfere with the term keybindings, disable it.
(setq-local cua-mode nil)
@ -1275,7 +1298,10 @@ without any interpretation."
(defun term-char-mode ()
"Switch to char (\"raw\") sub-mode of term mode.
Each character you type is sent directly to the inferior without
intervention from Emacs, except for the escape character (usually C-c)."
intervention from Emacs, except for the escape character (usually C-c).
This command will send existing partial lines to the terminal
process."
(interactive)
;; FIXME: Emit message? Cfr ilisp-raw-message
(when (term-in-line-mode)

11
lisp/textmodes/fill.el
View file

@ -133,6 +133,8 @@ A nil return value means the function has not determined the fill prefix."
(defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks.
"Whether or not filling should try to use the major mode's indentation.")
(defvar current-fill-column--has-warned nil)
(defun current-fill-column ()
"Return the fill-column to use for this line.
The fill-column to use for a buffer is stored in the variable `fill-column',
@ -158,7 +160,14 @@ number equals or exceeds the local fill-column - right-margin difference."
(< col fill-col)))
(setq here change
here-col col))
(max here-col fill-col)))))
(max here-col fill-col))
;; This warning was added in 28.1. It should be removed later,
;; and this function changed to never return nil.
(unless current-fill-column--has-warned
(lwarn '(fill-column) :warning
"Setting this variable to nil is obsolete; use `(auto-fill-mode -1)' instead")
(setq current-fill-column--has-warned t))
most-positive-fixnum)))
(defun canonically-space-region (beg end)
"Remove extra spaces between words in region.

18
lisp/textmodes/remember.el
View file

@ -223,8 +223,10 @@ recorded somewhere by that function."
;;; Internal Variables:
(defvar remember-buffer "*Remember*"
"The name of the remember data entry buffer.")
(defcustom remember-buffer "*Remember*"
"The name of the remember data entry buffer."
:version "28.1"
:type 'string)
(defcustom remember-save-after-remembering t
"Non-nil means automatically save after remembering."
@ -240,10 +242,10 @@ recorded somewhere by that function."
(defvar remember-annotation nil
"Current annotation.")
(defvar remember-initial-contents nil
"Initial contents to place into *Remember* buffer.")
"Initial contents to place into `remember-buffer'.")
(defcustom remember-before-remember-hook nil
"Functions run before switching to the *Remember* buffer."
"Functions run before switching to the `remember-buffer'."
:type 'hook)
(defcustom remember-run-all-annotation-functions-flag nil
@ -253,8 +255,8 @@ recorded somewhere by that function."
;;;###autoload
(defun remember (&optional initial)
"Remember an arbitrary piece of data.
INITIAL is the text to initially place in the *Remember* buffer,
or nil to bring up a blank *Remember* buffer.
INITIAL is the text to initially place in the `remember-buffer',
or nil to bring up a blank `remember-buffer'.
With a prefix or a visible region, use the region as INITIAL."
(interactive
@ -422,7 +424,7 @@ return the text to be remembered."
(defun remember-region (&optional beg end)
"Remember the data from BEG to END.
It is called from within the *Remember* buffer to save the text
It is called from within the `remember-buffer' to save the text
that was entered.
If BEG and END are nil, the entire buffer will be remembered.
@ -478,7 +480,7 @@ Most useful for remembering things from other applications."
(remember-region (point-min) (point-max)))
(defun remember-destroy ()
"Destroy the current *Remember* buffer."
"Destroy the current `remember-buffer'."
(interactive)
(when (equal remember-buffer (buffer-name))
(kill-buffer (current-buffer))

3
lisp/time.el
View file

@ -205,7 +205,8 @@ depend on `display-time-day-and-date' and `display-time-24hr-format'."
'mouse-face 'mode-line-highlight
'local-map (make-mode-line-mouse-map 'mouse-2
read-mail-command)))
""))
"")
" ")
"List of expressions governing display of the time in the mode line.
For most purposes, you can control the time format using `display-time-format'
which is a more standard interface.

7
lisp/url/url.el
View file

@ -208,9 +208,10 @@ URL-encoded before it's used."
(url-find-proxy-for-url url (url-host url))))
(buffer nil)
(asynch (url-scheme-get-property (url-type url) 'asynchronous-p)))
(if url-using-proxy
(setq asynch t
loader #'url-proxy))
(when url-using-proxy
(setf asynch t
loader #'url-proxy
(url-asynchronous url) t))
(if asynch
(let ((url-current-object url))
(setq buffer (funcall loader url callback cbargs)))

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

@ -375,7 +375,7 @@ in the order given by `git status'."
"Return a string for `vc-mode-line' to put in the mode line for FILE."
(let* ((rev (vc-working-revision file 'Git))
(disp-rev (or (vc-git--symbolic-ref file)
(substring rev 0 7)))
(and rev (substring rev 0 7))))
(def-ml (vc-default-mode-line-string 'Git file))
(help-echo (get-text-property 0 'help-echo def-ml))
(face (get-text-property 0 'face def-ml)))
@ -1772,6 +1772,7 @@ The difference to vc-do-command is that this function always invokes
(process-environment
(append
`("GIT_DIR"
"GIT_LITERAL_PATHSPECS=1"
;; Avoid repository locking during background operations
;; (bug#21559).
,@(when revert-buffer-in-progress-p
@ -1806,6 +1807,7 @@ The difference to vc-do-command is that this function always invokes
(process-environment
(append
`("GIT_DIR"
"GIT_LITERAL_PATHSPECS=1"
;; Avoid repository locking during background operations
;; (bug#21559).
,@(when revert-buffer-in-progress-p

120
lisp/wdired.el
View file

@ -297,26 +297,28 @@ or \\[wdired-abort-changes] to abort changes")))
(defun wdired--before-change-fn (beg end)
(save-match-data
(save-excursion
;; Make sure to process entire lines.
(goto-char end)
(setq end (line-end-position))
(goto-char beg)
(forward-line 0)
(save-restriction
(widen)
;; Make sure to process entire lines.
(goto-char end)
(setq end (line-end-position))
(goto-char beg)
(forward-line 0)
(while (< (point) end)
(unless (wdired--line-preprocessed-p)
(while (< (point) end)
(unless (wdired--line-preprocessed-p)
(with-silent-modifications
(put-text-property (point) (1+ (point)) 'front-sticky t)
(wdired--preprocess-files)
(when wdired-allow-to-change-permissions
(wdired--preprocess-perms))
(when (fboundp 'make-symbolic-link)
(wdired--preprocess-symlinks))))
(forward-line))
(when (eobp)
(with-silent-modifications
(put-text-property (point) (1+ (point)) 'front-sticky t)
(wdired--preprocess-files)
(when wdired-allow-to-change-permissions
(wdired--preprocess-perms))
(when (fboundp 'make-symbolic-link)
(wdired--preprocess-symlinks))))
(forward-line))
(when (eobp)
(with-silent-modifications
;; Is this good enough? Assumes no extra white lines from dired.
(put-text-property (1- (point-max)) (point-max) 'read-only t))))))
;; Is this good enough? Assumes no extra white lines from dired.
(put-text-property (1- (point-max)) (point-max) 'read-only t)))))))
(defun wdired-isearch-filter-read-only (beg end)
"Skip matches that have a read-only property."
@ -700,47 +702,49 @@ Optional arguments are ignored."
(defun wdired--restore-properties (beg end _len)
(save-match-data
(save-excursion
(let ((lep (line-end-position))
(used-F (dired-check-switches
dired-actual-switches
"F" "classify")))
;; Deleting the space between the link name and the arrow (a
;; noop) also deletes the end-name property, so restore it.
(when (and (save-excursion
(re-search-backward dired-permission-flags-regexp nil t)
(looking-at "l"))
(get-text-property (1- (point)) 'dired-filename)
(not (get-text-property (point) 'dired-filename))
(not (get-text-property (point) 'end-name)))
(save-restriction
(widen)
(let ((lep (line-end-position))
(used-F (dired-check-switches
dired-actual-switches
"F" "classify")))
;; Deleting the space between the link name and the arrow (a
;; noop) also deletes the end-name property, so restore it.
(when (and (save-excursion
(re-search-backward dired-permission-flags-regexp nil t)
(looking-at "l"))
(get-text-property (1- (point)) 'dired-filename)
(not (get-text-property (point) 'dired-filename))
(not (get-text-property (point) 'end-name)))
(put-text-property (point) (1+ (point)) 'end-name t))
(beginning-of-line)
(when (re-search-forward
directory-listing-before-filename-regexp lep t)
(setq beg (point)
end (if (or
;; If the file is a symlink, put the
;; dired-filename property only on the link
;; name. (Using (file-symlink-p
;; (dired-get-filename)) fails in
;; wdired-mode, bug#32673.)
(and (re-search-backward
dired-permission-flags-regexp nil t)
(looking-at "l")
;; macOS and Ultrix adds "@" to the end
;; of symlinks when using -F.
(if (and used-F
dired-ls-F-marks-symlinks)
(re-search-forward "@? -> " lep t)
(search-forward " -> " lep t)))
;; When dired-listing-switches includes "F"
;; or "classify", don't treat appended
;; indicator characters as part of the file
;; name (bug#34915).
(and used-F
(re-search-forward "[*/@|=>]$" lep t)))
(goto-char (match-beginning 0))
lep))
(put-text-property beg end 'dired-filename t))))))
(beginning-of-line)
(when (re-search-forward
directory-listing-before-filename-regexp lep t)
(setq beg (point)
end (if (or
;; If the file is a symlink, put the
;; dired-filename property only on the link
;; name. (Using (file-symlink-p
;; (dired-get-filename)) fails in
;; wdired-mode, bug#32673.)
(and (re-search-backward
dired-permission-flags-regexp nil t)
(looking-at "l")
;; macOS and Ultrix adds "@" to the end
;; of symlinks when using -F.
(if (and used-F
dired-ls-F-marks-symlinks)
(re-search-forward "@? -> " lep t)
(search-forward " -> " lep t)))
;; When dired-listing-switches includes "F"
;; or "classify", don't treat appended
;; indicator characters as part of the file
;; name (bug#34915).
(and used-F
(re-search-forward "[*/@|=>]$" lep t)))
(goto-char (match-beginning 0))
lep))
(put-text-property beg end 'dired-filename t)))))))
(defun wdired-next-line (arg)
"Move down lines then position at filename or the current column.

6
lisp/woman.el
View file

@ -1274,9 +1274,11 @@ cache to be re-read."
;; Complete topic more carefully, i.e. use the completion
;; rather than the string entered by the user:
((setq files (all-completions topic woman-topic-all-completions))
(while (/= (length topic) (length (car files)))
(while (and files
(/= (length topic) (length (car files))))
(setq files (cdr files)))
(setq files (woman-file-name-all-completions (car files)))))
(when files
(setq files (woman-file-name-all-completions (car files))))))
(cond
((null files) nil) ; no file found for topic.
((null (cdr files)) (car (car files))) ; only 1 file for topic.

3
m4/gnulib-comp.m4
View file

@ -89,6 +89,7 @@ AC_DEFUN([gl_EARLY],
# Code from module fcntl:
# Code from module fcntl-h:
# Code from module fdopendir:
# Code from module file-has-acl:
# Code from module filemode:
# Code from module filename:
# Code from module filevercmp:
@ -287,6 +288,7 @@ AC_DEFUN([gl_INIT],
fi
gl_DIRENT_MODULE_INDICATOR([fdopendir])
gl_MODULE_INDICATOR([fdopendir])
gl_FILE_HAS_ACL
gl_FILEMODE
AC_C_FLEXIBLE_ARRAY_MEMBER
gl_FUNC_FPENDING
@ -1045,6 +1047,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/fcntl.c
lib/fcntl.in.h
lib/fdopendir.c
lib/file-has-acl.c
lib/filemode.c
lib/filemode.h
lib/filename.h

1
nt/gnulib-cfg.mk
View file

@ -68,3 +68,4 @@ OMIT_GNULIB_MODULE_fchmodat = true
OMIT_GNULIB_MODULE_lchmod = true
OMIT_GNULIB_MODULE_futimens = true
OMIT_GNULIB_MODULE_utimensat = true
OMIT_GNULIB_MODULE_file-has-acl = true

32
src/buffer.c
View file

@ -781,15 +781,22 @@ fetch_buffer_markers (struct buffer *b)
DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
2, 3,
2, 4,
"bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
BASE-BUFFER should be a live buffer, or the name of an existing buffer.
NAME should be a string which is not the name of an existing buffer.
Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
such as major and minor modes, in the indirect buffer.
CLONE nil means the indirect buffer's state is reset to default values. */)
(Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone)
CLONE nil means the indirect buffer's state is reset to default values.
If optional argument INHIBIT-BUFFER-HOOKS is non-nil, the new buffer
does not run the hooks `kill-buffer-hook',
`kill-buffer-query-functions', and `buffer-list-update-hook'. */)
(Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone,
Lisp_Object inhibit_buffer_hooks)
{
Lisp_Object buf, tem;
struct buffer *b;
@ -834,6 +841,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
b->pt_byte = b->base_buffer->pt_byte;
b->begv_byte = b->base_buffer->begv_byte;
b->zv_byte = b->base_buffer->zv_byte;
b->inhibit_buffer_hooks = !NILP (inhibit_buffer_hooks);
b->newline_cache = 0;
b->width_run_cache = 0;
@ -1076,12 +1084,12 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
for (newlist = Qnil; CONSP (list); list = XCDR (list))
{
Lisp_Object elt = XCAR (list);
/* Preserve element ELT if it's t,
if it is a function with a `permanent-local-hook' property,
or if it's not a symbol. */
if (! SYMBOLP (elt)
|| EQ (elt, Qt)
|| !NILP (Fget (elt, Qpermanent_local_hook)))
/* Preserve element ELT if it's t, or if it is a
function with a `permanent-local-hook'
property. */
if (EQ (elt, Qt)
|| (SYMBOLP (elt)
&& !NILP (Fget (elt, Qpermanent_local_hook))))
newlist = Fcons (elt, newlist);
}
newlist = Fnreverse (newlist);
@ -4214,7 +4222,11 @@ OVERLAY. */)
DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 2, 0,
doc: /* Return a list of the overlays that contain the character at POS.
If SORTED is non-nil, then sort them by decreasing priority. */)
If SORTED is non-nil, then sort them by decreasing priority.
Zero-length overlays that start and stop at POS are not included in
the return value. Instead use `overlays-in' if those overlays are of
interest. */)
(Lisp_Object pos, Lisp_Object sorted)
{
ptrdiff_t len, noverlays;

5
src/callint.c
View file

@ -892,7 +892,10 @@ behave as if the mark were still active. */);
Vmark_even_if_inactive = Qt;
DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
doc: /* Hook to run when about to switch windows with a mouse command.
doc: /* Hook run when the user mouse-clicks in a window.
It can be run both before and after switching windows, or even when
not actually switching windows.
Its purpose is to give temporary modes such as Isearch mode
a way to turn themselves off when a mouse command switches windows. */);
Vmouse_leave_buffer_hook = Qnil;

104
src/chartab.c
View file

@ -62,6 +62,9 @@ typedef Lisp_Object (*uniprop_encoder_t) (Lisp_Object, Lisp_Object);
static Lisp_Object uniprop_table_uncompress (Lisp_Object, int);
static uniprop_decoder_t uniprop_get_decoder (Lisp_Object);
static Lisp_Object
sub_char_table_ref_and_range (Lisp_Object, int, int *, int *,
Lisp_Object, bool);
/* 1 iff TABLE is a uniprop table. */
#define UNIPROP_TABLE_P(TABLE) \
@ -247,6 +250,23 @@ char_table_ref (Lisp_Object table, int c)
return val;
}
static inline Lisp_Object
char_table_ref_simple (Lisp_Object table, int idx, int c, int *from, int *to,
Lisp_Object defalt, bool is_uniprop, bool is_subtable)
{
Lisp_Object val = is_subtable ?
XSUB_CHAR_TABLE (table)->contents[idx]:
XCHAR_TABLE (table)->contents[idx];
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
val = uniprop_table_uncompress (table, idx);
if (SUB_CHAR_TABLE_P (val))
val = sub_char_table_ref_and_range (val, c, from, to,
defalt, is_uniprop);
else if (NILP (val))
val = defalt;
return val;
}
static Lisp_Object
sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to,
Lisp_Object defalt, bool is_uniprop)
@ -254,31 +274,18 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to,
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = tbl->depth, min_char = tbl->min_char;
int chartab_idx = CHARTAB_IDX (c, depth, min_char), idx;
Lisp_Object val;
val = tbl->contents[chartab_idx];
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
val = uniprop_table_uncompress (table, chartab_idx);
if (SUB_CHAR_TABLE_P (val))
val = sub_char_table_ref_and_range (val, c, from, to, defalt, is_uniprop);
else if (NILP (val))
val = defalt;
Lisp_Object val
= char_table_ref_simple (table, chartab_idx, c, from, to,
defalt, is_uniprop, true);
idx = chartab_idx;
while (idx > 0 && *from < min_char + idx * chartab_chars[depth])
{
Lisp_Object this_val;
c = min_char + idx * chartab_chars[depth] - 1;
idx--;
this_val = tbl->contents[idx];
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
this_val = uniprop_table_uncompress (table, idx);
if (SUB_CHAR_TABLE_P (this_val))
this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt,
is_uniprop);
else if (NILP (this_val))
this_val = defalt;
Lisp_Object this_val
= char_table_ref_simple (table, idx, c, from, to,
defalt, is_uniprop, true);
if (! EQ (this_val, val))
{
@ -290,17 +297,11 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to,
< chartab_chars[depth - 1])
&& (c += min_char) <= *to)
{
Lisp_Object this_val;
chartab_idx++;
this_val = tbl->contents[chartab_idx];
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
this_val = uniprop_table_uncompress (table, chartab_idx);
if (SUB_CHAR_TABLE_P (this_val))
this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt,
is_uniprop);
else if (NILP (this_val))
this_val = defalt;
Lisp_Object this_val
= char_table_ref_simple (table, chartab_idx, c, from, to,
defalt, is_uniprop, true);
if (! EQ (this_val, val))
{
*to = c - 1;
@ -321,37 +322,26 @@ Lisp_Object
char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
int chartab_idx = CHARTAB_IDX (c, 0, 0), idx;
Lisp_Object val;
int chartab_idx = CHARTAB_IDX (c, 0, 0);
bool is_uniprop = UNIPROP_TABLE_P (table);
val = tbl->contents[chartab_idx];
if (*from < 0)
*from = 0;
if (*to < 0)
*to = MAX_CHAR;
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
val = uniprop_table_uncompress (table, chartab_idx);
if (SUB_CHAR_TABLE_P (val))
val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt,
is_uniprop);
else if (NILP (val))
val = tbl->defalt;
idx = chartab_idx;
Lisp_Object val
= char_table_ref_simple (table, chartab_idx, c, from, to,
tbl->defalt, is_uniprop, false);
int idx = chartab_idx;
while (*from < idx * chartab_chars[0])
{
Lisp_Object this_val;
c = idx * chartab_chars[0] - 1;
idx--;
this_val = tbl->contents[idx];
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
this_val = uniprop_table_uncompress (table, idx);
if (SUB_CHAR_TABLE_P (this_val))
this_val = sub_char_table_ref_and_range (this_val, c, from, to,
tbl->defalt, is_uniprop);
else if (NILP (this_val))
this_val = tbl->defalt;
Lisp_Object this_val
= char_table_ref_simple (table, idx, c, from, to,
tbl->defalt, is_uniprop, false);
if (! EQ (this_val, val))
{
@ -361,18 +351,12 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
}
while (*to >= (chartab_idx + 1) * chartab_chars[0])
{
Lisp_Object this_val;
chartab_idx++;
c = chartab_idx * chartab_chars[0];
this_val = tbl->contents[chartab_idx];
if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
this_val = uniprop_table_uncompress (table, chartab_idx);
if (SUB_CHAR_TABLE_P (this_val))
this_val = sub_char_table_ref_and_range (this_val, c, from, to,
tbl->defalt, is_uniprop);
else if (NILP (this_val))
this_val = tbl->defalt;
Lisp_Object this_val
= char_table_ref_simple (table, chartab_idx, c, from, to,
tbl->defalt, is_uniprop, false);
if (! EQ (this_val, val))
{
*to = c - 1;

2
src/coding.c
View file

@ -9476,7 +9476,7 @@ not fully specified.) */)
}
/* Whether STRING only contains chars in the 0..127 range. */
static bool
bool
string_ascii_p (Lisp_Object string)
{
ptrdiff_t nbytes = SBYTES (string);

2
src/data.c
View file

@ -3901,6 +3901,7 @@ syms_of_data (void)
DEFSYM (Qerror, "error");
DEFSYM (Quser_error, "user-error");
DEFSYM (Qquit, "quit");
DEFSYM (Qminibuffer_quit, "minibuffer-quit");
DEFSYM (Qwrong_length_argument, "wrong-length-argument");
DEFSYM (Qwrong_type_argument, "wrong-type-argument");
DEFSYM (Qargs_out_of_range, "args-out-of-range");
@ -3973,6 +3974,7 @@ syms_of_data (void)
Fput (sym, Qerror_message, build_pure_c_string (msg))
PUT_ERROR (Qquit, Qnil, "Quit");
PUT_ERROR (Qminibuffer_quit, pure_cons (Qquit, Qnil), "Quit");
PUT_ERROR (Quser_error, error_tail, "");
PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument");

14
src/eval.c
View file

@ -2026,6 +2026,18 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
return 0;
}
/* Say whether SIGNAL is a `quit' symbol (or inherits from it). */
bool
signal_quit_p (Lisp_Object signal)
{
Lisp_Object list;
return EQ (signal, Qquit)
|| (!NILP (Fsymbolp (signal))
&& CONSP (list = Fget (signal, Qerror_conditions))
&& !NILP (Fmemq (Qquit, list)));
}
/* Call the debugger if calling it is currently enabled for CONDITIONS.
SIG and DATA describe the signal. There are two ways to pass them:
= SIG is the error symbol, and DATA is the rest of the data.
@ -2044,7 +2056,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
! input_blocked_p ()
&& NILP (Vinhibit_debugger)
/* Does user want to enter debugger for this kind of error? */
&& (EQ (sig, Qquit)
&& (signal_quit_p (sig)
? debug_on_quit
: wants_debugger (Vdebug_on_error, conditions))
&& ! skip_debugger (conditions, combined_data)

109
src/fileio.c
View file

@ -749,6 +749,114 @@ For that reason, you should normally use `make-temp-file' instead. */)
empty_unibyte_string, Qnil);
}
DEFUN ("file-name-concat", Ffile_name_concat, Sfile_name_concat, 1, MANY, 0,
doc: /* Append COMPONENTS to DIRECTORY and return the resulting string.
Elements in COMPONENTS must be a string or nil.
DIRECTORY or the non-final elements in COMPONENTS may or may not end
with a slash -- if they don't end with a slash, a slash will be
inserted before contatenating.
usage: (record DIRECTORY &rest COMPONENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t chars = 0, bytes = 0, multibytes = 0, eargs = 0;
Lisp_Object *elements = args;
Lisp_Object result;
ptrdiff_t i;
/* First go through the list to check the types and see whether
they're all of the same multibytedness. */
for (i = 0; i < nargs; i++)
{
Lisp_Object arg = args[i];
/* Skip empty and nil elements. */
if (NILP (arg))
continue;
CHECK_STRING (arg);
if (SCHARS (arg) == 0)
continue;
eargs++;
/* Multibyte and non-ASCII. */
if (STRING_MULTIBYTE (arg) && SCHARS (arg) != SBYTES (arg))
multibytes++;
/* We're not adding a slash to the final part. */
if (i == nargs - 1
|| IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1)))
{
bytes += SBYTES (arg);
chars += SCHARS (arg);
}
else
{
bytes += SBYTES (arg) + 1;
chars += SCHARS (arg) + 1;
}
}
/* Convert if needed. */
if ((multibytes != 0 && multibytes != nargs)
|| eargs != nargs)
{
int j = 0;
elements = xmalloc (eargs * sizeof *elements);
bytes = 0;
chars = 0;
/* Filter out nil/"". */
for (i = 0; i < nargs; i++)
{
Lisp_Object arg = args[i];
if (!NILP (arg) && SCHARS (arg) != 0)
elements[j++] = arg;
}
for (i = 0; i < eargs; i++)
{
Lisp_Object arg = elements[i];
/* Use multibyte or all-ASCII strings as is. */
if (!STRING_MULTIBYTE (arg) && !string_ascii_p (arg))
elements[i] = Fstring_to_multibyte (arg);
arg = elements[i];
/* We have to recompute the number of bytes. */
if (i == eargs - 1
|| IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1)))
{
bytes += SBYTES (arg);
chars += SCHARS (arg);
}
else
{
bytes += SBYTES (arg) + 1;
chars += SCHARS (arg) + 1;
}
}
}
/* Allocate an empty string. */
if (multibytes == 0)
result = make_uninit_string (chars);
else
result = make_uninit_multibyte_string (chars, bytes);
/* Null-terminate the string. */
*(SSDATA (result) + SBYTES (result)) = 0;
/* Copy over the data. */
char *p = SSDATA (result);
for (i = 0; i < eargs; i++)
{
Lisp_Object arg = elements[i];
memcpy (p, SSDATA (arg), SBYTES (arg));
p += SBYTES (arg);
/* The last element shouldn't have a slash added at the end. */
if (i < eargs - 1 && !IS_DIRECTORY_SEP (*(p - 1)))
*p++ = DIRECTORY_SEP;
}
if (elements != args)
xfree (elements);
return result;
}
/* NAME must be a string. */
static bool
file_name_absolute_no_tilde_p (Lisp_Object name)
@ -6488,6 +6596,7 @@ This includes interactive calls to `delete-file' and
defsubr (&Sdirectory_file_name);
defsubr (&Smake_temp_file_internal);
defsubr (&Smake_temp_name);
defsubr (&Sfile_name_concat);
defsubr (&Sexpand_file_name);
defsubr (&Ssubstitute_in_file_name);
defsubr (&Scopy_file);

2
src/filelock.c
View file

@ -673,7 +673,7 @@ lock_file (Lisp_Object fn)
Lisp_Object subject_buf = get_truename_buffer (fn);
if (!NILP (subject_buf)
&& NILP (Fverify_visited_file_modtime (subject_buf))
&& !NILP (Ffile_exists_p (lock_filename))
&& !NILP (Ffile_exists_p (fn))
&& current_lock_owner (NULL, lfname) != -2)
call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);

12
src/fns.c
View file

@ -3955,7 +3955,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
if (c == '=')
continue;
if (v1 < 0)
if (v1 == 0)
return -1;
value += v1 - 1;
@ -5769,16 +5769,6 @@ characters. */ )
return list3 (make_int (lines), make_int (longest), make_float (mean));
}
static bool
string_ascii_p (Lisp_Object string)
{
ptrdiff_t nbytes = SBYTES (string);
for (ptrdiff_t i = 0; i < nbytes; i++)
if (SREF (string, i) > 127)
return false;
return true;
}
DEFUN ("string-search", Fstring_search, Sstring_search, 2, 3, 0,
doc: /* Search for the string NEEDLE in the string HAYSTACK.
The return value is the position of the first occurrence of NEEDLE in

20
src/frame.c
View file

@ -1021,6 +1021,10 @@ make_frame (bool mini_p)
rw->total_lines = FRAME_LINES (f) - (mini_p ? 1 : 0);
rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f);
fset_face_hash_table
(f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
DEFAULT_REHASH_THRESHOLD, Qnil, false));
if (mini_p)
{
mw->top_line = rw->total_lines;
@ -1329,7 +1333,7 @@ affects all frames on the same terminal device. */)
{
struct frame *f;
struct terminal *t = NULL;
Lisp_Object frame, tem;
Lisp_Object frame;
struct frame *sf = SELECTED_FRAME ();
#ifdef MSDOS
@ -1411,14 +1415,16 @@ affects all frames on the same terminal device. */)
store_in_alist (&parms, Qminibuffer, Qt);
Fmodify_frame_parameters (frame, parms);
/* Make the frame face alist be frame-specific, so that each
/* Make the frame face hash be frame-specific, so that each
frame could change its face definitions independently. */
fset_face_alist (f, Fcopy_alist (sf->face_alist));
/* Simple Fcopy_alist isn't enough, because we need the contents of
the vectors which are the CDRs of associations in face_alist to
fset_face_hash_table (f, Fcopy_hash_table (sf->face_hash_table));
/* Simple copy_hash_table isn't enough, because we need the contents of
the vectors which are the values in face_hash_table to
be copied as well. */
for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
ptrdiff_t idx = 0;
struct Lisp_Hash_Table *table = XHASH_TABLE (f->face_hash_table);
for (idx = 0; idx < table->count; ++idx)
set_hash_value_slot (table, idx, Fcopy_sequence (HASH_VALUE (table, idx)));
f->can_set_window_size = true;
f->after_make_frame = true;

8
src/frame.h
View file

@ -158,8 +158,8 @@ struct frame
There are four additional elements of nil at the end, to terminate. */
Lisp_Object menu_bar_items;
/* Alist of elements (FACE-NAME . FACE-VECTOR-DATA). */
Lisp_Object face_alist;
/* Hash table of FACE-NAME keys and FACE-VECTOR-DATA values. */
Lisp_Object face_hash_table;
/* A vector that records the entire structure of this frame's menu bar.
For the format of the data, see extensive comments in xmenu.c.
@ -673,9 +673,9 @@ fset_condemned_scroll_bars (struct frame *f, Lisp_Object val)
f->condemned_scroll_bars = val;
}
INLINE void
fset_face_alist (struct frame *f, Lisp_Object val)
fset_face_hash_table (struct frame *f, Lisp_Object val)
{
f->face_alist = val;
f->face_hash_table = val;
}
#if defined (HAVE_WINDOW_SYSTEM)
INLINE void

21
src/ftfont.c
View file

@ -2798,10 +2798,31 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
if (gstring.used > LGSTRING_GLYPH_LEN (lgstring))
return Qnil;
/* mflt_run may fail to set g->g.to (which must be a valid index
into lgstring) correctly if the font has an OTF table that is
different from what the m17n library expects. */
for (i = 0; i < gstring.used; i++)
{
MFLTGlyphFT *g = (MFLTGlyphFT *) (gstring.glyphs) + i;
if (g->g.to >= len)
{
/* Invalid g->g.to. */
g->g.to = len - 1;
int from = g->g.from;
/* Fix remaining glyphs. */
for (++i; i < gstring.used; i++)
{
g = (MFLTGlyphFT *) (gstring.glyphs) + i;
g->g.from = from;
g->g.to = len - 1;
}
}
}
for (i = 0; i < gstring.used; i++)
{
MFLTGlyphFT *g = (MFLTGlyphFT *) (gstring.glyphs) + i;
g->g.from = LGLYPH_FROM (LGSTRING_GLYPH (lgstring, g->g.from));
g->g.to = LGLYPH_TO (LGSTRING_GLYPH (lgstring, g->g.to));
}

Some files were not shown because too many files have changed in this diff Show more