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-18 18:44:54 +09:00
commit b242394f24
137 changed files with 4819 additions and 2073 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
doc/emacs/back.texi
View file

@ -15,21 +15,18 @@
@sp 1 @sp 1
@quotation @quotation
GNU Emacs is much more than a text editor; over the years, it has GNU Emacs is much @strong{more than a text editor;} over the years, it
expanded to become an entire workflow environment, impressing has expanded to become @strong{an entire workflow environment,}
programmers with its integrated debugging and project-management impressing programmers with its integrated debugging and
features. It is also a multi-lingual word processor, can handle all project-management features. It is also a multi-lingual word
your email and Usenet news needs, display web pages, and even has a processor, can handle all your email and Usenet news needs, display
diary and a calendar for your appointments! web pages, and even has a diary and a calendar for your appointments!
And when you tire of all the work you can accomplish with it, Emacs Features include:
contains games to play.
@strong{Features include:}
@itemize @bullet @itemize @bullet
@item @item
Special editing modes for @strong{27 programing languages}, including C, Special editing modes for @strong{27 programming languages,} including C,
C@t{++}, Fortran, Java, JavaScript, Lisp, Objective C, Pascal, Perl, C@t{++}, Fortran, Java, JavaScript, Lisp, Objective C, Pascal, Perl,
and Scheme. and Scheme.
@ -39,7 +36,7 @@ and creating Makefiles for GNU/Linux, UNIX, Windows/DOS, and VMS
systems. systems.
@item @item
Support for typing and displaying in @strong{60 non-English languages}, Support for typing and displaying in @strong{60 non-English languages,}
including Arabic, Chinese, Czech, Hebrew, Hindi, Japanese, Korean, including Arabic, Chinese, Czech, Hebrew, Hindi, Japanese, Korean,
Russian, Vietnamese, and all Western European languages. Russian, Vietnamese, and all Western European languages.
@ -48,18 +45,18 @@ The ability to:
@itemize @minus @itemize @minus
@item @item
Create @strong{PostScript output} from plain-text files (special editing Create @strong{PostScript output} from plain-text files (special
modes for @LaTeX{} and @TeX{} are included). editing modes for @LaTeX{} and @TeX{} are included).
@item @item
@strong{Compile} and @strong{debug} from inside Emacs. @strong{Compile} and @strong{debug} from inside Emacs.
@item @item
Maintain program @strong{ChangeLogs}. Maintain program @strong{ChangeLogs.}
@item @item
Flag, move, and delete files and sub-directories recursively Flag, move, and delete files and sub-directories recursively
(@strong{directory navigation}). @strong{(directory navigation).}
@item @item
Run @strong{shell commands} from inside Emacs, or even use Emacs itself Run @strong{shell commands} from inside Emacs, or even use Emacs itself
@ -69,8 +66,8 @@ as a shell (Eshell).
Enjoy the use of extensive @strong{merge} and @strong{diff} functions. Enjoy the use of extensive @strong{merge} and @strong{diff} functions.
@item @item
Take advantage of built-in support for many @strong{version control} Take advantage of built-in support for many @strong{version control
systems, including Git, Mercurial, Bazaar, Subversion, and CVS. systems}, including Git, Mercurial, Bazaar, Subversion, and CVS.
@item @item
And much more! And much more!
@ -78,20 +75,24 @@ And much more!
@end itemize @end itemize
Emacs comes with an introductory online tutorial available in many Emacs comes with an introductory online tutorial available in many
languages. This book picks up where that tutorial ends. It explains languages, and this nineteenth edition of the manual picks up where
the full range of Emacs's power and contains reference material useful that tutorial ends. It explains the full range of the power of Emacs,
to expert users. now up to @strong[version 27.2,} and contains reference material
useful to expert users. It also includes appendices with specific
material about X and GTK resources, and with details for users of
macOS and Microsoft Windows.
Appendices are included, with specific material about X and GTK And when you tire of all the work you can accomplish with it, Emacs
resources, and with details for users of Macintosh and Microsoft OS. contains games to play.
@strong{About the Author:} @strong{About the original and principal author:}
Richard M.@: Stallman developed the first Emacs in 1975 and wrote GNU Richard M.@: Stallman developed the first Emacs in 1976 and wrote GNU
Emacs in 1984/85. He has received the ACM Grace Hopper Award, a Emacs in 1984/85. He has received the ACM Grace Hopper Award, a
MacArthur Foundation fellowship, the Electronic Frontier Foundation's MacArthur Foundation fellowship, the Electronic Frontier Foundation's
Pioneer award, and the Takeda Award for Social/Economic Betterment, as Pioneer award, the Takeda Award for Social/Economic Betterment, and
well as several honorary doctorates. the ACM Software and System Award, as well as several doctorates
honoris causa.
@end quotation @end quotation
@hfil @hfil

4
doc/emacs/book-spine.texi
View file

@ -13,8 +13,8 @@
@center @titlefont{GNU Emacs Manual} @center @titlefont{GNU Emacs Manual}
@sp 5 @sp 5
@center @value{EDITION} Edition, for Emacs Version @value{EMACSVER} @center @value{EDITION} edition, for Emacs Version @value{EMACSVER}
@sp 5 @sp 5
@center by Richard M.@: Stallman @center by Richard M.@: Stallman et al.
@bye @bye

9
doc/emacs/dired.texi
View file

@ -457,6 +457,15 @@ Visit the parent directory of the current directory
for @file{..} and typing @kbd{f} there. for @file{..} and typing @kbd{f} there.
@end table @end table
@defopt dired-kill-when-opening-new-dired-buffer
When visiting a new sub-directory in Dired, Emacs will (by default)
open a new buffer to display this new directory, and leave the old
Dired buffer as is. If this user option is non-@code{nil}, the old
Dired buffer will be killed after selecting the new directory. This
means that if you're traversing a directory structure in Dired, you
won't end up with more than a single Dired buffer.
@end defopt
@node Marks vs Flags @node Marks vs Flags
@section Dired Marks vs.@: Flags @section Dired Marks vs.@: Flags

4
doc/emacs/display.texi
View file

@ -1189,8 +1189,8 @@ that has some special meaning for formatting the source code of a
program. program.
To activate the fill-column indication display, use the minor modes To activate the fill-column indication display, use the minor modes
@kbd{M-x display-fill-@-column-indicator-mode} and @code{display-fill-@-column-indicator-mode} and
@kbd{M-x global-display-fill-column-indicator-mode}, which enable @code{global-display-fill-column-indicator-mode}, which enable
the indicator locally or globally, respectively. the indicator locally or globally, respectively.
Alternatively, you can set the two buffer-local variables Alternatively, you can set the two buffer-local variables

2
doc/emacs/emacs.texi
View file

@ -95,7 +95,7 @@ Boston, MA 02110-1301 USA @*
ISBN 978-0-9831592-8-5 ISBN 978-0-9831592-8-5
@sp 2 @sp 2
Cover art by Etienne Suvasa; cover design by Matt Lee. Cover art by Etienne Suvasa; cover design by FSF staff.
@end titlepage @end titlepage

21
doc/emacs/files.texi
View file

@ -227,6 +227,15 @@ File Names}, for information on how to visit a file whose name
actually contains wildcard characters. You can disable the wildcard actually contains wildcard characters. You can disable the wildcard
feature by customizing @code{find-file-wildcards}. feature by customizing @code{find-file-wildcards}.
@vindex query-about-changed-file
If you're asking to visit a file that's already visited in a buffer,
but the file has changed externally, Emacs normally asks you whether
you want to re-read the file from disk. But if you set
@code{query-about-changed-file} to @code{nil}, Emacs won't query you,
but will instead just display the buffer's contents before the
changes, and show an echo-area message telling you how to revert the
buffer from the file.
@kindex C-x C-v @kindex C-x C-v
@findex find-alternate-file @findex find-alternate-file
If you visit the wrong file unintentionally by typing its name If you visit the wrong file unintentionally by typing its name
@ -789,7 +798,9 @@ Emacs buffer visiting it has unsaved changes.
@vindex create-lockfiles @vindex create-lockfiles
You can prevent the creation of lock files by setting the variable You can prevent the creation of lock files by setting the variable
@code{create-lockfiles} to @code{nil}. @strong{Caution:} by @code{create-lockfiles} to @code{nil}. @strong{Caution:} by
doing so you will lose the benefits that this feature provides. doing so you will lose the benefits that this feature provides. You
can also control where lock files are written by using the
@code{lock-file-name-transforms} variable.
@cindex collision @cindex collision
If you begin to modify the buffer while the visited file is locked by If you begin to modify the buffer while the visited file is locked by
@ -834,6 +845,14 @@ warning message and asks for confirmation before saving; answer
place, one way to compare the buffer to its file is the @kbd{M-x place, one way to compare the buffer to its file is the @kbd{M-x
diff-buffer-with-file} command. @xref{Comparing Files}. diff-buffer-with-file} command. @xref{Comparing Files}.
@vindex remote-file-name-inhibit-locks
You can prevent the creation of remote lock files by setting the
variable @code{remote-file-name-inhibit-locks} to @code{t}.
@cindex lock-file-mode
The minor mode @code{lock-file-mode}, called interactively, toggles
the local value of @code{create-lockfiles} in the current buffer.
@node File Shadowing @node File Shadowing
@subsection Shadowing Files @subsection Shadowing Files
@cindex shadow files @cindex shadow files

10
doc/emacs/maintaining.texi
View file

@ -3132,10 +3132,12 @@ one is able to set the variables.
Setup for version-controlled files configurable by the variable Setup for version-controlled files configurable by the variable
@code{bug-reference-setup-from-vc-alist}. The default is able to @code{bug-reference-setup-from-vc-alist}. The default is able to
setup GNU projects where @url{https://debbugs.gnu.org} is used as setup GNU projects where @url{https://debbugs.gnu.org} is used as
issue tracker, Github projects where both bugs and pull requests are issue tracker and issues are usually referenced as @code{bug#13} (but
referenced using the @code{#42} notation, and GitLab projects where many different notations are considered, too), Sourcehut projects
bugs are references with @code{#17}, too, but merge requests use the where issues are referenced using the notation @code{#17}, Codeberg
@code{!18} notation. and Github projects where both bugs and pull requests are referenced
using the same notation, and GitLab projects where bugs are referenced
with @code{#17}, too, but merge requests use the @code{!18} notation.
@item @item
Setup for email guessing from mail folder/mbox names, and mail header Setup for email guessing from mail folder/mbox names, and mail header

2
doc/emacs/misc.texi
View file

@ -2031,7 +2031,7 @@ evaluation performed is for side-effect rather than result.
Connect to the Emacs server named @var{server-name}. (This option is Connect to the Emacs server named @var{server-name}. (This option is
not supported on MS-Windows.) The server name is given by the not supported on MS-Windows.) The server name is given by the
variable @code{server-name} on the Emacs server. If this option is variable @code{server-name} on the Emacs server. If this option is
omitted, @command{emacsclient} connects to the first server it finds. omitted, @command{emacsclient} connects to the default socket.
If you set @code{server-name} of the Emacs server to an absolute file If you set @code{server-name} of the Emacs server to an absolute file
name, give the same absolute file name as @var{server-name} to this name, give the same absolute file name as @var{server-name} to this
option to instruct @command{emacsclient} to connect to that server. option to instruct @command{emacsclient} to connect to that server.

6
doc/emacs/mule.texi
View file

@ -174,8 +174,10 @@ characters in the range @code{#x0080..#x00FF}.
@cindex font of character at point @cindex font of character at point
@cindex text properties at point @cindex text properties at point
@cindex face at point @cindex face at point
With a prefix argument (@kbd{C-u C-x =}), this command displays a @findex describe-char
detailed description of the character in a window: With a prefix argument (@kbd{C-u C-x =}), this command additionally
calls the command @code{describe-char}, which displays a detailed
description of the character:
@itemize @bullet @itemize @bullet
@item @item

38
doc/lispref/files.texi
View file

@ -772,6 +772,20 @@ and otherwise ignores the error.
If this variable is @code{nil}, Emacs does not lock files. If this variable is @code{nil}, Emacs does not lock files.
@end defopt @end defopt
@defopt lock-file-name-transforms
By default, Emacs creates the lock files in the same directory as the
files that are being locked. This can be changed by customizing this
variable. Is has the same syntax as
@code{auto-save-file-name-transforms} (@pxref{Auto-Saving}). For
instance, to make Emacs write all the lock files to @file{/var/tmp/},
you could say something like:
@lisp
(setq lock-file-name-transforms
'(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
@end lisp
@end defopt
@defun ask-user-about-lock file other-user @defun ask-user-about-lock file other-user
This function is called when the user tries to modify @var{file}, but it This function is called when the user tries to modify @var{file}, but it
is locked by another user named @var{other-user}. The default is locked by another user named @var{other-user}. The default
@ -807,6 +821,16 @@ If you wish, you can replace the @code{ask-user-about-lock} function
with your own version that makes the decision in another way. with your own version that makes the decision in another way.
@end defun @end defun
@defopt remote-file-name-inhibit-locks
You can prevent the creation of remote lock files by setting the
variable @code{remote-file-name-inhibit-locks} to @code{t}.
@end defopt
@deffn Command lock-file-mode
This command, called interactively, toggles the local value of
@code{create-lockfiles} in the current buffer.
@end deffn
@node Information about Files @node Information about Files
@section Information about Files @section Information about Files
@cindex file, information about @cindex file, information about
@ -3273,7 +3297,7 @@ first, before handlers for jobs such as remote file access.
@code{file-equal-p}, @code{file-equal-p},
@code{file-executable-p}, @code{file-exists-p}, @code{file-executable-p}, @code{file-exists-p},
@code{file-in-directory-p}, @code{file-in-directory-p},
@code{file-local-copy}, @code{file-local-copy}, @code{file-locked-p},
@code{file-modes}, @code{file-name-all-completions}, @code{file-modes}, @code{file-name-all-completions},
@code{file-name-as-directory}, @code{file-name-as-directory},
@code{file-name-case-insensitive-p}, @code{file-name-case-insensitive-p},
@ -3292,10 +3316,11 @@ first, before handlers for jobs such as remote file access.
@code{get-file-buffer}, @code{get-file-buffer},
@code{insert-directory}, @code{insert-directory},
@code{insert-file-contents},@* @code{insert-file-contents},@*
@code{load}, @code{load}, @code{lock-file},
@code{make-auto-save-file-name}, @code{make-auto-save-file-name},
@code{make-directory}, @code{make-directory},
@code{make-directory-internal}, @code{make-directory-internal},
@code{make-lock-file-name},
@code{make-nearby-temp-file}, @code{make-nearby-temp-file},
@code{make-process}, @code{make-process},
@code{make-symbolic-link},@* @code{make-symbolic-link},@*
@ -3307,6 +3332,7 @@ first, before handlers for jobs such as remote file access.
@code{substitute-in-file-name},@* @code{substitute-in-file-name},@*
@code{temporary-file-directory}, @code{temporary-file-directory},
@code{unhandled-file-name-directory}, @code{unhandled-file-name-directory},
@code{unlock-file},
@code{vc-registered}, @code{vc-registered},
@code{verify-visited-file-modtime},@* @code{verify-visited-file-modtime},@*
@code{write-region}. @code{write-region}.
@ -3331,7 +3357,7 @@ first, before handlers for jobs such as remote file access.
@code{file-equal-p}, @code{file-equal-p},
@code{file-executable-p}, @code{file-exists-p}, @code{file-executable-p}, @code{file-exists-p},
@code{file-in-directory-p}, @code{file-in-directory-p},
@code{file-local-copy}, @code{file-local-copy}, @code{file-locked-p},
@code{file-modes}, @code{file-name-all-completions}, @code{file-modes}, @code{file-name-all-completions},
@code{file-name-as-directory}, @code{file-name-as-directory},
@code{file-name-case-insensitive-p}, @code{file-name-case-insensitive-p},
@ -3350,10 +3376,12 @@ first, before handlers for jobs such as remote file access.
@code{get-file-buffer}, @code{get-file-buffer},
@code{insert-directory}, @code{insert-directory},
@code{insert-file-contents}, @code{insert-file-contents},
@code{load}, @code{load}, @code{lock-file},
@code{make-auto-save-file-name}, @code{make-auto-save-file-name},
@code{make-direc@discretionary{}{}{}tory}, @code{make-direc@discretionary{}{}{}tory},
@code{make-direc@discretionary{}{}{}tory-internal}, @code{make-direc@discretionary{}{}{}tory-internal},
@code{make-lock-file-name},
@code{make-nearby-temp-file},
@code{make-process}, @code{make-process},
@code{make-symbolic-link}, @code{make-symbolic-link},
@code{process-file}, @code{process-file},
@ -3362,7 +3390,9 @@ first, before handlers for jobs such as remote file access.
@code{set-visited-file-modtime}, @code{shell-command}, @code{set-visited-file-modtime}, @code{shell-command},
@code{start-file-process}, @code{start-file-process},
@code{substitute-in-file-name}, @code{substitute-in-file-name},
@code{temporary-file-directory},
@code{unhandled-file-name-directory}, @code{unhandled-file-name-directory},
@code{unlock-file},
@code{vc-regis@discretionary{}{}{}tered}, @code{vc-regis@discretionary{}{}{}tered},
@code{verify-visited-file-modtime}, @code{verify-visited-file-modtime},
@code{write-region}. @code{write-region}.

2
doc/lispref/intro.texi
View file

@ -89,7 +89,7 @@ you are criticizing.
@cindex suggestions @cindex suggestions
Please send comments and corrections using @kbd{M-x Please send comments and corrections using @kbd{M-x
report-emacs-bug}. If you wish to contribute new code (or send a report-emacs-bug}. If you wish to contribute new code (or send a
patch to fix a problem), use @kbd{M-x submit-emacs-patch}). patch to fix a problem), use @kbd{M-x submit-emacs-patch}.
@node Lisp History @node Lisp History
@section Lisp History @section Lisp History

4
doc/lispref/lists.texi
View file

@ -1804,7 +1804,7 @@ through a simple example:
(let-alist colors (let-alist colors
(if (eq .rose 'red) (if (eq .rose 'red)
.lily)) .lily))
=> white @result{} white
@end lisp @end lisp
The @var{body} is inspected at compilation time, and only the symbols The @var{body} is inspected at compilation time, and only the symbols
@ -1820,7 +1820,7 @@ Nested association lists is supported:
(let-alist colors (let-alist colors
(if (eq .rose 'red) (if (eq .rose 'red)
.lily.belladonna)) .lily.belladonna))
=> yellow @result{} yellow
@end lisp @end lisp
Nesting @code{let-alist} inside each other is allowed, but the code in Nesting @code{let-alist} inside each other is allowed, but the code in

13
doc/lispref/modes.texi
View file

@ -3551,7 +3551,7 @@ which will instruct font-lock not to start or end the scan in the
middle of the construct. middle of the construct.
@end itemize @end itemize
There are three ways to do rehighlighting of multiline constructs: There are several ways to do rehighlighting of multiline constructs:
@itemize @itemize
@item @item
@ -3573,6 +3573,17 @@ This works only if @code{jit-lock-contextually} is used, and with the
same delay before rehighlighting, but like @code{font-lock-multiline}, same delay before rehighlighting, but like @code{font-lock-multiline},
it also handles the case where highlighting depends on it also handles the case where highlighting depends on
subsequent lines. subsequent lines.
@item
If parsing the @emph{syntax} of a construct depends on it being parsed in one
single chunk, you can add the @code{syntax-multiline} text property
over the construct in question. The most common use for this is when
the syntax property to apply to @samp{FOO} depend on some later text
@samp{BAR}: By placing this text property over the whole of
@samp{FOO...BAR}, you make sure that any change of @samp{BAR} will
also cause the syntax property of @samp{FOO} to be recomputed.
Note: For this to work, the mode needs to add
@code{syntax-propertize-multiline} to
@code{syntax-propertize-extend-region-functions}.
@end itemize @end itemize
@menu @menu

7
doc/lispref/objects.texi
View file

@ -1001,6 +1001,13 @@ It looks like this:
@end example @end example
@end ifnottex @end ifnottex
As a somewhat peculiar side effect of @code{(a b . c)} and
@code{(a . (b . c))} being equivalent, for consistency this means
that if you replace @code{b} here with the empty sequence, then it
follows that @code{(a . c)} and @code{(a . ( . c))} are equivalent,
too. This also means that @code{( . c)} is equivalent to @code{c},
but this is seldom used.
@node Association List Type @node Association List Type
@subsubsection Association List Type @subsubsection Association List Type

5
doc/lispref/os.texi
View file

@ -2167,6 +2167,11 @@ if @var{time} is @code{t}, then the timer runs whenever the time is a
multiple of @var{repeat} seconds after the epoch. This is useful for multiple of @var{repeat} seconds after the epoch. This is useful for
functions like @code{display-time}. functions like @code{display-time}.
If Emacs didn't get any CPU time when the timer would have run (for
example if the system was busy running another process or if the
computer was sleeping or in a suspended state), the timer will run as
soon as Emacs resumes and is idle.
The function @code{run-at-time} returns a timer value that identifies The function @code{run-at-time} returns a timer value that identifies
the particular scheduled future action. You can use this value to call the particular scheduled future action. You can use this value to call
@code{cancel-timer} (see below). @code{cancel-timer} (see below).

10
doc/lispref/processes.texi
View file

@ -247,6 +247,16 @@ protected by @code{shell-quote-argument};
@code{combine-and-quote-strings} is @emph{not} intended to protect @code{combine-and-quote-strings} is @emph{not} intended to protect
special characters from shell evaluation. special characters from shell evaluation.
@defun split-string-shell-command string
This function splits @var{string} into substrings, respecting double
and single quotes, as well as backslash quoting.
@smallexample
(split-string-shell-command "ls /tmp/'foo bar'")
@result{} ("ls" "/tmp/foo bar")
@end smallexample
@end defun
@defun split-string-and-unquote string &optional separators @defun split-string-and-unquote string &optional separators
This function splits @var{string} into substrings at matches for the This function splits @var{string} into substrings at matches for the
regular expression @var{separators}, like @code{split-string} does regular expression @var{separators}, like @code{split-string} does

22
doc/lispref/text.texi
View file

@ -500,6 +500,15 @@ We hold these truth@point{}
@defun insert-buffer-substring-no-properties from-buffer-or-name &optional start end @defun insert-buffer-substring-no-properties from-buffer-or-name &optional start end
This is like @code{insert-buffer-substring} except that it does not This is like @code{insert-buffer-substring} except that it does not
copy any text properties. copy any text properties.
@end defun
@defun insert-into-buffer to-buffer &optional start end
This is like @code{insert-buffer-substring}, but works in the opposite
direction: The text is copied from the current buffer into
@var{to-buffer}. The block of text is copied to the current point in
@var{to-buffer}, and point (in that buffer) is advanced to after the
end of the copied text. Is @code{start}/@code{end} is @code{nil}, the
entire text in the current buffer is copied over.
@end defun @end defun
@xref{Sticky Properties}, for other insertion functions that inherit @xref{Sticky Properties}, for other insertion functions that inherit
@ -4399,7 +4408,8 @@ based on their character codes.
@cindex replace characters @cindex replace characters
This function replaces all occurrences of the character @var{old-char} This function replaces all occurrences of the character @var{old-char}
with the character @var{new-char} in the region of the current buffer with the character @var{new-char} in the region of the current buffer
defined by @var{start} and @var{end}. defined by @var{start} and @var{end}. Both characters must have the
same length of their multibyte form.
@cindex undo avoidance @cindex undo avoidance
If @var{noundo} is non-@code{nil}, then @code{subst-char-in-region} does If @var{noundo} is non-@code{nil}, then @code{subst-char-in-region} does
@ -4428,6 +4438,16 @@ ThXs Xs the contents of the buffer before.
@end example @end example
@end defun @end defun
@defun subst-char-in-string fromchar tochar string &optional inplace
@cindex replace characters in string
This function replaces all occurrences of the character @var{fromchar}
with @var{tochar} in @var{string}. By default, substitution occurs in
a copy of @var{string}, but if the optional argument @var{inplace} is
non-@code{nil}, the function modifies the @var{string} itself. In any
case, the function returns the resulting string.
@end defun
@deffn Command translate-region start end table @deffn Command translate-region start end table
This function applies a translation table to the characters in the This function applies a translation table to the characters in the
buffer between positions @var{start} and @var{end}. buffer between positions @var{start} and @var{end}.

11
doc/lispref/tips.texi
View file

@ -168,11 +168,12 @@ follow the naming conventions for hooks. @xref{Hooks}.
@item @item
@cindex unloading packages, preparing for @cindex unloading packages, preparing for
If loading the file adds functions to hooks, define a function Using @code{unload-feature} will undo the changes usually done by
@code{@var{feature}-unload-function}, where @var{feature} is the name loading a feature (like adding functions to hooks). However, if
of the feature the package provides, and make it undo any such loading @var{feature} does something unusual and more complex, you can
changes. Using @code{unload-feature} to unload the file will run this define a function named @code{@var{feature}-unload-function}, and make
function. @xref{Unloading}. it undo any such special changes. @code{unload-feature} will then
automatically run this function if it exists. @xref{Unloading}.
@item @item
It is a bad idea to define aliases for the Emacs primitives. Normally It is a bad idea to define aliases for the Emacs primitives. Normally

34
doc/misc/efaq.texi
View file

@ -1519,6 +1519,7 @@ of files from Macintosh, Microsoft, and Unix platforms.
* Documentation for etags:: * Documentation for etags::
* Disabling backups:: * Disabling backups::
* Disabling auto-save-mode:: * Disabling auto-save-mode::
* Not writing files to the current directory::
* Going to a line by number:: * Going to a line by number::
* Modifying pull-down menus:: * Modifying pull-down menus::
* Deleting menus and menu options:: * Deleting menus and menu options::
@ -2620,6 +2621,39 @@ such as @file{/tmp}.
To disable or change how @code{auto-save-mode} works, To disable or change how @code{auto-save-mode} works,
@pxref{Auto Save,,, emacs, The GNU Emacs Manual}. @pxref{Auto Save,,, emacs, The GNU Emacs Manual}.
@node Not writing files to the current directory
@section Making Emacs write all auxiliary files somewhere else
@cindex Writing all auxiliary files to the same directory
By default, Emacs may create many new files in the directory where
you're editing a file. If you're editing the file
@file{/home/user/foo.txt}, Emacs will create the lock file
@file{/home/user/.#foo.txt}, the auto-save file
@file{/home/user/#foo.txt#}, and when you save the file, Emacs will
create the backup file @file{/home/user/foo.txt~}. (The first two
files are deleted when you save the file.)
This may be inconvenient in some setups, so Emacs has mechanisms for
changing the locations of all these files.
@table @code
@item auto-save-file-name-transforms (@pxref{Auto-Saving,,,elisp, GNU Emacs Lisp Reference Manual}).
@item lock-file-name-transforms (@pxref{File Locks,,,elisp, GNU Emacs Lisp Reference Manual}).
@item backup-directory-alist (@pxref{Making Backups,,,elisp, GNU Emacs Lisp Reference Manual}).
@end table
For instance, to write all these things to
@file{~/.emacs.d/aux/}:
@lisp
(setq lock-file-name-transforms
'(("\\`/.*/\\([^/]+\\)\\'" "~/.emacs.d/aux/\\1" t)))
(setq auto-save-file-name-transforms
'(("\\`/.*/\\([^/]+\\)\\'" "~/.emacs.d/aux/\\1" t)))
(setq backup-directory-alist
'((".*" . "~/.emacs.d/aux/")))
@end lisp
@node Going to a line by number @node Going to a line by number
@section How can I go to a certain line given its number? @section How can I go to a certain line given its number?
@cindex Going to a line by number @cindex Going to a line by number

1281
doc/misc/modus-themes.org
View file

File diff suppressed because it is too large Load diff

34
doc/misc/tramp.texi
View file

@ -142,7 +142,8 @@ Configuring @value{tramp} for use
* Remote shell setup:: Remote shell setup hints. * Remote shell setup:: Remote shell setup hints.
* FUSE setup:: @acronym{FUSE} setup hints. * FUSE setup:: @acronym{FUSE} setup hints.
* Android shell setup:: Android shell setup hints. * Android shell setup:: Android shell setup hints.
* Auto-save and Backup:: Auto-save and Backup. * Auto-save File Lock and Backup::
Auto-save, File Lock and Backup.
* Keeping files encrypted:: Protect remote files by encryption. * Keeping files encrypted:: Protect remote files by encryption.
* Windows setup hints:: Issues with Cygwin ssh. * Windows setup hints:: Issues with Cygwin ssh.
@ -691,7 +692,8 @@ may be used in your init file:
* Remote shell setup:: Remote shell setup hints. * Remote shell setup:: Remote shell setup hints.
* FUSE setup:: @acronym{FUSE} setup hints. * FUSE setup:: @acronym{FUSE} setup hints.
* Android shell setup:: Android shell setup hints. * Android shell setup:: Android shell setup hints.
* Auto-save and Backup:: Auto-save and Backup. * Auto-save File Lock and Backup::
Auto-save, File Lock and Backup.
* Keeping files encrypted:: Protect remote files by encryption. * Keeping files encrypted:: Protect remote files by encryption.
* Windows setup hints:: Issues with Cygwin ssh. * Windows setup hints:: Issues with Cygwin ssh.
@end menu @end menu
@ -2745,9 +2747,10 @@ Open a remote connection with a more concise command @kbd{C-x C-f
@end itemize @end itemize
@node Auto-save and Backup @node Auto-save File Lock and Backup
@section Auto-save and Backup configuration @section Auto-save, File Lock and Backup configuration
@cindex auto-save @cindex auto-save
@cindex file-lock
@cindex backup @cindex backup
@vindex backup-directory-alist @vindex backup-directory-alist
@ -2842,11 +2845,28 @@ auto-saved files to the same directory as the original file.
Alternatively, set the user option @code{tramp-auto-save-directory} Alternatively, set the user option @code{tramp-auto-save-directory}
to direct all auto saves to that location. to direct all auto saves to that location.
@vindex lock-file-name-transforms
And still more issues to handle. Since @w{Emacs 28}, file locks use a
similar user option as auto-save files, called
@code{lock-file-name-transforms}. By default this user option is
@code{nil}, meaning to keep file locks in the same directory as the
original file.
If you change @code{lock-file-name-transforms} in order to keep file
locks for remote files somewhere else, you will loose Emacs' feature
to warn you, if a file is changed in parallel from different Emacs
sessions, or via different remote connections. Be careful with such
settings.
@vindex remote-file-name-inhibit-locks
Setting @code{remote-file-name-inhibit-locks} to non-@code{nil}
prevents the creation of remote lock files at all.
@vindex tramp-allow-unsafe-temporary-files @vindex tramp-allow-unsafe-temporary-files
Per default, @value{tramp} asks for confirmation if a Per default, @value{tramp} asks for confirmation if a
@samp{root}-owned backup or auto-save remote file has to be written to @samp{root}-owned remote backup, auto-save or lock file has to be
your local temporary directory. If you want to suppress this written to your local temporary directory. If you want to suppress
confirmation question, set user option this confirmation question, set user option
@code{tramp-allow-unsafe-temporary-files} to @code{t}. @code{tramp-allow-unsafe-temporary-files} to @code{t}.

114
etc/NEWS
View file

@ -308,6 +308,14 @@ default, 9.5 MiB). Press '?' or 'C-h' in that prompt to read more
about the different options to visit a file, how you can disable the about the different options to visit a file, how you can disable the
prompt, and how you can tweak the file size threshold. prompt, and how you can tweak the file size threshold.
+++
** New user option 'query-about-changed-file'.
If non-nil (the default), users are prompted as before when
re-visiting a file that has changed externally after it was visited
the first time. If nil, the user is not prompted, but instead the
buffer is opened with its contents before the change, and the user is
given instructions how to revert the buffer.
+++ +++
** Improved support for terminal emulators that encode the Meta flag. ** Improved support for terminal emulators that encode the Meta flag.
Some terminal emulators set the 8th bit of Meta characters, and then Some terminal emulators set the 8th bit of Meta characters, and then
@ -323,6 +331,7 @@ emulators by using the new input-meta-mode with the special value
** New frame parameter 'drag-with-tab-line'. ** New frame parameter 'drag-with-tab-line'.
This parameter, similar to 'drag-with-header-line', allows moving frames This parameter, similar to 'drag-with-header-line', allows moving frames
by dragging the tab lines of their topmost windows with the mouse. by dragging the tab lines of their topmost windows with the mouse.
* Editing Changes in Emacs 28.1 * Editing Changes in Emacs 28.1
@ -777,6 +786,11 @@ time zones will use a form like "+0100" instead of "CET".
** Dired ** Dired
+++
*** New user option 'dired-kill-when-opening-new-dired-buffer'.
If non-nil, Dired will kill the current buffer when selecting a new
directory to display.
--- ---
*** Behavior change on 'dired-clean-confirm-killing-deleted-buffers'. *** Behavior change on 'dired-clean-confirm-killing-deleted-buffers'.
Previously, if 'dired-clean-up-buffers-too' was non-nil, and Previously, if 'dired-clean-up-buffers-too' was non-nil, and
@ -1139,6 +1153,11 @@ any directory names on the 'find' command lines end in a slash.
This change is for better compatibility with old versions of non-GNU This change is for better compatibility with old versions of non-GNU
'find', such as the one used on macOS. 'find', such as the one used on macOS.
---
*** New utility function 'grep-file-at-point'.
This returns the name of the file at point (if any) in 'grep-mode'
buffers.
** Help ** Help
+++ +++
@ -1185,6 +1204,16 @@ can provide a better overview in a long list of available bindings.
In previous Emacs versions, the "*Help*" buffer was killed instead when In previous Emacs versions, the "*Help*" buffer was killed instead when
clicking the "X" icon in the tool bar. clicking the "X" icon in the tool bar.
** Info
---
*** New user option 'Info-warn-on-index-alternatives-wrap'.
This option affects what happens when using the ',' command after
looking up an entry with 'i' in info buffers. If non-nil (the
default), the ',' command will now warn you when proceeding beyond the
final entry, and tapping ',' once more will then take you to the
first entry.
+++ +++
** New command 'lossage-size'. ** New command 'lossage-size'.
It allows users to set the maximum number of keystrokes and commands It allows users to set the maximum number of keystrokes and commands
@ -1266,6 +1295,9 @@ To revert to the previous behavior,
** Customize ** Customize
---
*** Customize buffers can now be reverted with 'C-x x g'.
*** Most customize commands now hide obsolete user options. *** Most customize commands now hide obsolete user options.
Obsolete user options are no longer shown in the listings produced by Obsolete user options are no longer shown in the listings produced by
the commands 'customize', 'customize-group', 'customize-apropos' and the commands 'customize', 'customize-group', 'customize-apropos' and
@ -1450,9 +1482,15 @@ buffer to a file under the "/tmp/" directory. This is useful, if (in
rare cases) Tramp blocks Emacs, and we need further debug information. rare cases) Tramp blocks Emacs, and we need further debug information.
+++ +++
*** Writing sensitive auto-save or backup files to the local temporary *** Tramp supports lock files now.
directory must be confirmed. In order to suppress this confirmation, In order to deactivate this, set user option
set user option 'tramp-allow-unsafe-temporary-files' to t. 'remote-file-name-inhibit-locks' to t.
+++
*** Writing sensitive auto-save, backup or lock files to the local
temporary directory must be confirmed. In order to suppress this
confirmation, set user option 'tramp-allow-unsafe-temporary-files' to
t.
** Tempo ** Tempo
@ -1476,6 +1514,14 @@ This is a slightly deeper copy than the previous 'copy-sequence'.
** Package ** Package
---
*** '/ s' ('package-menu-filter-by-status') changes parameter handling.
The command was documented to take a comma-separated list of statuses
to filter by, but instead it used the parameter as a regexp. The
command has been changed so that it now works as documented, and
checks statuses not as a regexp, but instead an exact match from the
comma-separated list.
+++ +++
*** New command 'package-browse-url' and keystroke 'w'. *** New command 'package-browse-url' and keystroke 'w'.
@ -1617,6 +1663,10 @@ t, which preserves the original behavior.
If set non-nil, showing an unseen message will set the Rmail buffer's If set non-nil, showing an unseen message will set the Rmail buffer's
modified flag. modified flag.
---
*** New faces for heading elements.
Those are 'shr-h1', 'shr-h2', 'shr-h3', 'shr-h4', 'shr-h5', 'shr-h6'.
** Apropos ** Apropos
*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'. *** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'.
@ -2146,8 +2196,40 @@ Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text.
If the 'EMACS_TEST_VERBOSE' environment variable is set, failure If the 'EMACS_TEST_VERBOSE' environment variable is set, failure
summaries will include the failing condition. summaries will include the failing condition.
** File Locks
+++
*** New user option 'lock-file-name-transforms'.
This option allows controlling where lock files are written. It uses
the same syntax as 'auto-save-file-name-transforms'.
+++
*** New user option 'remote-file-name-inhibit-locks'.
When non-nil, this option suppresses lock files for remote files.
+++
*** New minor mode 'lock-file-mode'.
This command, called interactively, toggles the local value of
'create-lockfiles' in the current buffer.
** Miscellaneous ** Miscellaneous
---
*** New user option 'save-place-abbreviate-file-names'.
---
*** 'tabulated-list-mode' can now restore original display order.
Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode',
and that mode allow the user to sort on any column. There was
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.
+++
*** New utility function 'insert-into-buffer'.
This is like 'insert-buffer-substring', but works in the opposite
direction.
+++ +++
*** New user option 'kill-transform-function'. *** New user option 'kill-transform-function'.
This can be used to transform (and suppress) strings from entering the This can be used to transform (and suppress) strings from entering the
@ -2384,12 +2466,6 @@ leak information from the reporting user.
*** 'count-windows' now takes an optional parameter ALL-FRAMES. *** 'count-windows' now takes an optional parameter ALL-FRAMES.
The semantics are as with 'walk-windows'. The semantics are as with 'walk-windows'.
---
*** Killing virtual ido buffers interactively will make them go away.
Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't
do anything. This has now been changed, and killing virtual buffers
with that command will remove the buffer from recentf.
--- ---
*** New variable 'ffap-file-name-with-spaces'. *** New variable 'ffap-file-name-with-spaces'.
If non-nil, 'find-file-at-point' and friends will try to guess more If non-nil, 'find-file-at-point' and friends will try to guess more
@ -2464,6 +2540,17 @@ height of lines or width of chars.
When non-nil, use a new xwidget webkit session after bookmark jump. When non-nil, use a new xwidget webkit session after bookmark jump.
Otherwise, it will use 'xwidget-webkit-last-session'. Otherwise, it will use 'xwidget-webkit-last-session'.
** ido
---
*** Switching on 'ido-mode' now also overrides 'ffap-file-finder'.
---
*** Killing virtual ido buffers interactively will make them go away.
Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't
do anything. This has now been changed, and killing virtual buffers
with that command will remove the buffer from recentf.
** Flymake mode ** Flymake mode
+++ +++
@ -2914,6 +3001,15 @@ The former is now declared obsolete.
* Lisp Changes in Emacs 28.1 * Lisp Changes in Emacs 28.1
+++
*** New function 'split-string-shell-command'.
This splits a shell command string into separate components,
respecting quoting with single ('like this') and double ("like this")
quotes, as well as backslash quoting (like\ this).
---
*** ':safe' settings in 'defcustom' are now propagated to the loaddefs files.
+++ +++
** New function 'syntax-class-to-char'. ** New function 'syntax-class-to-char'.
This does almost the opposite of 'string-to-syntax' -- it returns the This does almost the opposite of 'string-to-syntax' -- it returns the

2
etc/themes/modus-operandi-theme.el
View file

@ -4,7 +4,7 @@
;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://gitlab.com/protesilaos/modus-themes ;; URL: https://gitlab.com/protesilaos/modus-themes
;; Version: 1.4.0 ;; Version: 1.5.0
;; Package-Requires: ((emacs "26.1")) ;; Package-Requires: ((emacs "26.1"))
;; Keywords: faces, theme, accessibility ;; Keywords: faces, theme, accessibility

2497
etc/themes/modus-themes.el
View file

File diff suppressed because it is too large Load diff

2
etc/themes/modus-vivendi-theme.el
View file

@ -4,7 +4,7 @@
;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://gitlab.com/protesilaos/modus-themes ;; URL: https://gitlab.com/protesilaos/modus-themes
;; Version: 1.4.0 ;; Version: 1.5.0
;; Package-Requires: ((emacs "26.1")) ;; Package-Requires: ((emacs "26.1"))
;; Keywords: faces, theme, accessibility ;; Keywords: faces, theme, accessibility

47
lib-src/etags.c
View file

@ -340,7 +340,6 @@ typedef struct regexp
struct re_pattern_buffer *pat; /* the compiled pattern */ struct re_pattern_buffer *pat; /* the compiled pattern */
struct re_registers regs; /* re registers */ struct re_registers regs; /* re registers */
bool error_signaled; /* already signaled for this regexp */ bool error_signaled; /* already signaled for this regexp */
bool force_explicit_name; /* do not allow implicit tag name */
bool ignore_case; /* ignore case when matching */ bool ignore_case; /* ignore case when matching */
bool multi_line; /* do a multi-line match on the whole file */ bool multi_line; /* do a multi-line match on the whole file */
} regexp; } regexp;
@ -6910,7 +6909,6 @@ add_regex (char *regexp_pattern, language *lang)
struct re_pattern_buffer *patbuf; struct re_pattern_buffer *patbuf;
regexp *rp; regexp *rp;
bool bool
force_explicit_name = true, /* do not use implicit tag names */
ignore_case = false, /* case is significant */ ignore_case = false, /* case is significant */
multi_line = false, /* matches are done one line at a time */ multi_line = false, /* matches are done one line at a time */
single_line = false; /* dot does not match newline */ single_line = false; /* dot does not match newline */
@ -6949,7 +6947,8 @@ add_regex (char *regexp_pattern, language *lang)
case 'N': case 'N':
if (modifiers == name) if (modifiers == name)
error ("forcing explicit tag name but no name, ignoring"); error ("forcing explicit tag name but no name, ignoring");
force_explicit_name = true; /* This option has no effect and is present only for backward
compatibility. */
break; break;
case 'i': case 'i':
ignore_case = true; ignore_case = true;
@ -7004,7 +7003,6 @@ add_regex (char *regexp_pattern, language *lang)
p_head->pat = patbuf; p_head->pat = patbuf;
p_head->name = savestr (name); p_head->name = savestr (name);
p_head->error_signaled = false; p_head->error_signaled = false;
p_head->force_explicit_name = force_explicit_name;
p_head->ignore_case = ignore_case; p_head->ignore_case = ignore_case;
p_head->multi_line = multi_line; p_head->multi_line = multi_line;
} }
@ -7144,20 +7142,15 @@ regex_tag_multiline (void)
name = NULL; name = NULL;
else /* make a named tag */ else /* make a named tag */
name = substitute (buffer, rp->name, &rp->regs); name = substitute (buffer, rp->name, &rp->regs);
if (rp->force_explicit_name)
{
/* Force explicit tag name, if a name is there. */
pfnote (name, true, buffer + linecharno,
charno - linecharno + 1, lineno, linecharno);
if (debug) /* Force explicit tag name, if a name is there. */
fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n", pfnote (name, true, buffer + linecharno,
name ? name : "(unnamed)", curfdp->taggedfname, charno - linecharno + 1, lineno, linecharno);
lineno, buffer + linecharno);
} if (debug)
else fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n",
make_tag (name, strlen (name), true, buffer + linecharno, name ? name : "(unnamed)", curfdp->taggedfname,
charno - linecharno + 1, lineno, linecharno); lineno, buffer + linecharno);
break; break;
} }
} }
@ -7471,18 +7464,14 @@ readline (linebuffer *lbp, FILE *stream)
name = NULL; name = NULL;
else /* make a named tag */ else /* make a named tag */
name = substitute (lbp->buffer, rp->name, &rp->regs); name = substitute (lbp->buffer, rp->name, &rp->regs);
if (rp->force_explicit_name)
{ /* Force explicit tag name, if a name is there. */
/* Force explicit tag name, if a name is there. */ pfnote (name, true, lbp->buffer, match, lineno, linecharno);
pfnote (name, true, lbp->buffer, match, lineno, linecharno);
if (debug) if (debug)
fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n", fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n",
name ? name : "(unnamed)", curfdp->taggedfname, name ? name : "(unnamed)", curfdp->taggedfname,
lineno, lbp->buffer); lineno, lbp->buffer);
}
else
make_tag (name, strlen (name), true,
lbp->buffer, match, lineno, linecharno);
break; break;
} }
} }

14
lib-src/movemail.c
View file

@ -270,6 +270,7 @@ main (int argc, char **argv)
You might also wish to verify that your system is one which You might also wish to verify that your system is one which
uses lock files for this purpose. Some systems use other methods. */ uses lock files for this purpose. Some systems use other methods. */
bool lockname_unlinked = false;
inname_len = strlen (inname); inname_len = strlen (inname);
lockname = xmalloc (inname_len + sizeof ".lock"); lockname = xmalloc (inname_len + sizeof ".lock");
strcpy (lockname, inname); strcpy (lockname, inname);
@ -312,15 +313,10 @@ main (int argc, char **argv)
Five minutes should be good enough to cope with crashes Five minutes should be good enough to cope with crashes
and wedgitude, and long enough to avoid being fooled and wedgitude, and long enough to avoid being fooled
by time differences between machines. */ by time differences between machines. */
if (stat (lockname, &st) >= 0) if (!lockname_unlinked
{ && stat (lockname, &st) == 0
time_t now = time (0); && st.st_ctime < time (0) - 300)
if (st.st_ctime < now - 300) lockname_unlinked = unlink (lockname) == 0 || errno == ENOENT;
{
unlink (lockname);
lockname = 0;
}
}
} }
delete_lockname = lockname; delete_lockname = lockname;

42
lisp/apropos.el
View file

@ -724,22 +724,27 @@ the output includes key-bindings of commands."
;; (autoload (push (cdr x) autoloads)) ;; (autoload (push (cdr x) autoloads))
('require (push (cdr x) requires)) ('require (push (cdr x) requires))
('provide (push (cdr x) provides)) ('provide (push (cdr x) provides))
('t nil) ; Skip "was an autoload" entries. ('t nil) ; Skip "was an autoload" entries.
;; FIXME: Print information about each individual method: both ;; FIXME: Print information about each individual method: both
;; its docstring and specializers (bug#21422). ;; its docstring and specializers (bug#21422).
('cl-defmethod (push (cadr x) provides)) ('cl-defmethod (push (cadr x) provides))
(_ (push (or (cdr-safe x) x) symbols)))) (_ (push (or (cdr-safe x) x) symbols))))
(let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal. (let ((apropos-pattern "") ;Dummy binding for apropos-symbols-internal.
(apropos-symbols-internal (text
symbols apropos-do-all (concat
(concat (format-message
(format-message "Library `%s' provides: %s\nand requires: %s"
"Library `%s' provides: %s\nand requires: %s" file
file (mapconcat #'apropos-library-button
(mapconcat #'apropos-library-button (or provides '(nil)) " and ")
(or provides '(nil)) " and ") (mapconcat #'apropos-library-button
(mapconcat #'apropos-library-button (or requires '(nil)) " and ")))))
(or requires '(nil)) " and "))))))) (if (null symbols)
(with-output-to-temp-buffer "*Apropos*"
(with-current-buffer standard-output
(apropos-mode)
(apropos--preamble text)))
(apropos-symbols-internal symbols apropos-do-all text)))))
(defun apropos-symbols-internal (symbols keys &optional text) (defun apropos-symbols-internal (symbols keys &optional text)
;; Filter out entries that are marked as apropos-inhibit. ;; Filter out entries that are marked as apropos-inhibit.
@ -1154,10 +1159,7 @@ as a heading."
symbol item) symbol item)
(set-buffer standard-output) (set-buffer standard-output)
(apropos-mode) (apropos-mode)
(insert (substitute-command-keys "Type \\[apropos-follow] on ") (apropos--preamble text)
(if apropos-multi-type "a type label" "an entry")
" to view its full documentation.\n\n")
(if text (insert text "\n\n"))
(dolist (apropos-item p) (dolist (apropos-item p)
(when (and spacing (not (bobp))) (when (and spacing (not (bobp)))
(princ spacing)) (princ spacing))
@ -1287,6 +1289,14 @@ as a heading."
(fill-region opoint (point) nil t))) (fill-region opoint (point) nil t)))
(or (bolp) (terpri))))) (or (bolp) (terpri)))))
(defun apropos--preamble (text)
(let ((inhibit-read-only t))
(insert (substitute-command-keys "Type \\[apropos-follow] on ")
(if apropos-multi-type "a type label" "an entry")
" to view its full documentation.\n\n")
(when text
(insert text "\n\n"))))
(defun apropos-follow () (defun apropos-follow ()
"Invokes any button at point, otherwise invokes the nearest label button." "Invokes any button at point, otherwise invokes the nearest label button."
(interactive) (interactive)

22
lisp/bookmark.el
View file

@ -467,18 +467,18 @@ See user option `bookmark-fontify'."
"Remove a bookmark's colorized overlay. "Remove a bookmark's colorized overlay.
BM is a bookmark as returned from function `bookmark-get-bookmark'. BM is a bookmark as returned from function `bookmark-get-bookmark'.
See user option `bookmark-fontify'." See user option `bookmark-fontify'."
(let ((filename (assq 'filename bm)) (let ((filename (cdr (assq 'filename bm)))
(pos (assq 'position bm)) (pos (cdr (assq 'position bm)))
overlays found temp) overlays found temp)
(when filename (setq filename (expand-file-name (cdr filename)))) (when (and pos filename)
(when pos (setq pos (cdr pos))) (setq filename (expand-file-name filename))
(dolist (buf (buffer-list)) (dolist (buf (buffer-list))
(with-current-buffer buf (with-current-buffer buf
(when (equal filename buffer-file-name) (when (equal filename buffer-file-name)
(setq overlays (overlays-at pos)) (setq overlays (overlays-at pos))
(while (and (not found) (setq temp (pop overlays))) (while (and (not found) (setq temp (pop overlays)))
(when (eq 'bookmark (overlay-get temp 'category)) (when (eq 'bookmark (overlay-get temp 'category))
(delete-overlay (setq found temp))))))))) (delete-overlay (setq found temp))))))))))
(defun bookmark-completing-read (prompt &optional default) (defun bookmark-completing-read (prompt &optional default)
"Prompting with PROMPT, read a bookmark name in completion. "Prompting with PROMPT, read a bookmark name in completion.

13
lisp/cus-edit.el
View file

@ -1665,8 +1665,11 @@ Otherwise use brackets."
'custom-button-pressed 'custom-button-pressed
'custom-button-pressed-unraised)))) 'custom-button-pressed-unraised))))
(defvar custom--invocation-options nil)
(defun custom-buffer-create-internal (options &optional _description) (defun custom-buffer-create-internal (options &optional _description)
(Custom-mode) (Custom-mode)
(setq custom--invocation-options options)
(let ((init-file (or custom-file user-init-file))) (let ((init-file (or custom-file user-init-file)))
;; Insert verbose help at the top of the custom buffer. ;; Insert verbose help at the top of the custom buffer.
(when custom-buffer-verbose-help (when custom-buffer-verbose-help
@ -2821,7 +2824,7 @@ the present value is saved to its :shown-value property instead."
(list (widget-value (list (widget-value
(car-safe (car-safe
(widget-get widget :children))))) (widget-get widget :children)))))
(error "There are unsaved changes"))) (message "Note: There are unsaved changes")))
(widget-put widget :documentation-shown nil) (widget-put widget :documentation-shown nil)
(widget-put widget :custom-state 'hidden)) (widget-put widget :custom-state 'hidden))
(custom-redraw widget) (custom-redraw widget)
@ -5152,11 +5155,19 @@ if that value is non-nil."
:label (nth 5 arg))) :label (nth 5 arg)))
custom-commands) custom-commands)
(setq custom-tool-bar-map map)))) (setq custom-tool-bar-map map))))
(setq-local custom--invocation-options nil)
(setq-local revert-buffer-function #'custom--revert-buffer)
(make-local-variable 'custom-options) (make-local-variable 'custom-options)
(make-local-variable 'custom-local-buffer) (make-local-variable 'custom-local-buffer)
(custom--initialize-widget-variables) (custom--initialize-widget-variables)
(add-hook 'widget-edit-functions 'custom-state-buffer-message nil t)) (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t))
(defun custom--revert-buffer (_ignore-auto _noconfirm)
(unless custom--invocation-options
(error "Insufficient data to revert"))
(custom-buffer-create custom--invocation-options
(buffer-name)))
(put 'Custom-mode 'mode-class 'special) (put 'Custom-mode 'mode-class 'special)
(provide 'cus-edit) (provide 'cus-edit)

5
lisp/desktop.el
View file

@ -759,7 +759,10 @@ is nil, ask the user where to save the desktop."
(unless (yes-or-no-p "Error while saving the desktop. Ignore? ") (unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
(signal (car err) (cdr err)))))) (signal (car err) (cdr err))))))
;; If we own it, we don't anymore. ;; If we own it, we don't anymore.
(when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock)) (when (eq (emacs-pid) (desktop-owner))
;; Allow exiting Emacs even if we can't delete the desktop file.
(ignore-error 'file-error
(desktop-release-lock)))
t) t)
;; ---------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------

82
lisp/dired.el
View file

@ -163,7 +163,7 @@ always set this variable to t."
:type 'boolean :type 'boolean
:group 'dired-mark) :group 'dired-mark)
(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`#") (defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`\\.?#")
"Regexp of files to skip when finding first file of a directory. "Regexp of files to skip when finding first file of a directory.
A value of nil means move to the subdir line. A value of nil means move to the subdir line.
A value of t means move to first file." A value of t means move to first file."
@ -356,6 +356,11 @@ is anywhere on its Dired line, except the beginning of the line."
:group 'dired :group 'dired
:version "28.1") :version "28.1")
(defcustom dired-kill-when-opening-new-dired-buffer nil
"If non-nil, kill the current buffer when selecting a new directory."
:type 'boolean
:version "28.1")
;;; Internal variables ;;; Internal variables
@ -615,6 +620,31 @@ Subexpression 2 must end right before the \\n.")
(list dired-re-dir (list dired-re-dir
'(".+" (dired-move-to-filename) nil (0 dired-directory-face))) '(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
;; ;;
;; Files suffixed with `completion-ignored-extensions'.
'(eval .
;; It is quicker to first find just an extension, then go back to the
;; start of that file name. So we do this complex MATCH-ANCHORED form.
(list (concat
"\\(" (regexp-opt completion-ignored-extensions)
"\\|#\\|\\.#.+\\)$")
'(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
;;
;; Files suffixed with `completion-ignored-extensions'
;; plus a character put in by -F.
'(eval .
(list (concat "\\(" (regexp-opt completion-ignored-extensions)
"\\|#\\|\\.#.+\\)[*=|]$")
'(".+" (progn
(end-of-line)
;; If the last character is not part of the filename,
;; move back to the start of the filename
;; so it can be fontified.
;; Otherwise, leave point at the end of the line;
;; that way, nothing is fontified.
(unless (get-text-property (1- (point)) 'mouse-face)
(dired-move-to-filename)))
nil (0 dired-ignored-face))))
;;
;; Broken Symbolic link. ;; Broken Symbolic link.
(list dired-re-sym (list dired-re-sym
(list (lambda (end) (list (lambda (end)
@ -659,29 +689,6 @@ Subexpression 2 must end right before the \\n.")
(list dired-re-special (list dired-re-special
'(".+" (dired-move-to-filename) nil (0 'dired-special))) '(".+" (dired-move-to-filename) nil (0 'dired-special)))
;; ;;
;; Files suffixed with `completion-ignored-extensions'.
'(eval .
;; It is quicker to first find just an extension, then go back to the
;; start of that file name. So we do this complex MATCH-ANCHORED form.
(list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
'(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
;;
;; Files suffixed with `completion-ignored-extensions'
;; plus a character put in by -F.
'(eval .
(list (concat "\\(" (regexp-opt completion-ignored-extensions)
"\\|#\\)[*=|]$")
'(".+" (progn
(end-of-line)
;; If the last character is not part of the filename,
;; move back to the start of the filename
;; so it can be fontified.
;; Otherwise, leave point at the end of the line;
;; that way, nothing is fontified.
(unless (get-text-property (1- (point)) 'mouse-face)
(dired-move-to-filename)))
nil (0 dired-ignored-face))))
;;
;; Explicitly put the default face on file names ending in a colon to ;; Explicitly put the default face on file names ending in a colon to
;; avoid fontifying them as directory header. ;; avoid fontifying them as directory header.
(list (concat dired-re-maybe-mark dired-re-inode-size dired-re-perms ".*:$") (list (concat dired-re-maybe-mark dired-re-inode-size dired-re-perms ".*:$")
@ -2377,7 +2384,7 @@ directory in another window."
(progn (progn
(if other-window (if other-window
(dired-other-window up) (dired-other-window up)
(dired up)) (dired--find-possibly-alternative-file up))
(dired-goto-file dir))))) (dired-goto-file dir)))))
(defun dired-get-file-for-visit () (defun dired-get-file-for-visit ()
@ -2401,7 +2408,16 @@ directory in another window."
(defun dired-find-file () (defun dired-find-file ()
"In Dired, visit the file or directory named on this line." "In Dired, visit the file or directory named on this line."
(interactive) (interactive)
(dired--find-file #'find-file (dired-get-file-for-visit))) (dired--find-possibly-alternative-file (dired-get-file-for-visit)))
(defun dired--find-possibly-alternative-file (file)
"Find FILE, but respect `dired-kill-when-opening-new-dired-buffer'."
(if (and dired-kill-when-opening-new-dired-buffer
(file-directory-p file))
(progn
(set-buffer-modified-p nil)
(dired--find-file #'find-alternate-file file))
(dired--find-file #'find-file file)))
(defun dired--find-file (find-file-function file) (defun dired--find-file (find-file-function file)
"Call FIND-FILE-FUNCTION on FILE, but bind some relevant variables." "Call FIND-FILE-FUNCTION on FILE, but bind some relevant variables."
@ -3834,13 +3850,13 @@ object files--just `.o' will mark more than you might think."
when (stringp file) when (stringp file)
sum (file-attribute-size (file-attributes file))))) sum (file-attribute-size (file-attributes file)))))
(if (zerop nmarked) (if (zerop nmarked)
(message "No marked files")) (message "No marked files")
(message "%d marked file%s (%s total size)" (message "%d marked file%s (%s total size)"
nmarked nmarked
(if (= nmarked 1) (if (= nmarked 1)
"" ""
"s") "s")
(funcall byte-count-to-string-function size)))) (funcall byte-count-to-string-function size)))))
(defun dired-mark-files-containing-regexp (regexp &optional marker-char) (defun dired-mark-files-containing-regexp (regexp &optional marker-char)
"Mark all files with contents containing REGEXP for use in later commands. "Mark all files with contents containing REGEXP for use in later commands.

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

@ -250,7 +250,10 @@ expression, in which case we want to handle forms differently."
(custom-autoload ',varname ,file (custom-autoload ',varname ,file
,(condition-case nil ,(condition-case nil
(null (plist-get props :set)) (null (plist-get props :set))
(error nil)))))) (error nil)))
;; Propagate the :safe property to the loaddefs file.
,@(when-let ((safe (plist-get props :safe)))
`((put ',varname 'safe-local-variable ,safe))))))
((eq car 'defgroup) ((eq car 'defgroup)
;; In Emacs this is normally handled separately by cus-dep.el, but for ;; In Emacs this is normally handled separately by cus-dep.el, but for

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

@ -1627,7 +1627,7 @@ the `\\\\=[command]' ones that are assumed to be of length
`byte-compile--wide-docstring-substitution-len'. Also ignore `byte-compile--wide-docstring-substitution-len'. Also ignore
URLs." URLs."
(string-match (string-match
(format "^.\\{%s,\\}$" (int-to-string (1+ col))) (format "^.\\{%d,\\}$" (min (1+ col) #xffff)) ; Heed RE_DUP_MAX.
(replace-regexp-in-string (replace-regexp-in-string
(rx (or (rx (or
;; Ignore some URLs. ;; Ignore some URLs.
@ -1857,8 +1857,7 @@ also be compiled."
(file-readable-p source) (file-readable-p source)
(not (string-match "\\`\\.#" file)) (not (string-match "\\`\\.#" file))
(not (auto-save-file-name-p source)) (not (auto-save-file-name-p source))
(not (string-equal dir-locals-file (not (member source (dir-locals--all-files directory))))
(file-name-nondirectory source))))
(progn (cl-incf (progn (cl-incf
(pcase (byte-recompile-file source force arg) (pcase (byte-recompile-file source force arg)
('no-byte-compile skip-count) ('no-byte-compile skip-count)

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

@ -259,7 +259,8 @@ Returns a form where all lambdas don't have any free variables."
(not (intern-soft var)) (not (intern-soft var))
(eq ?_ (aref (symbol-name var) 0)) (eq ?_ (aref (symbol-name var) 0))
;; As a special exception, ignore "ignore". ;; As a special exception, ignore "ignore".
(eq var 'ignored)) (eq var 'ignored)
(not (byte-compile-warning-enabled-p 'unbound var)))
(let ((suggestions (help-uni-confusable-suggestions (symbol-name var)))) (let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
(format "Unused lexical %s `%S'%s" (format "Unused lexical %s `%S'%s"
varkind var varkind var

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

@ -53,6 +53,7 @@
(message eieio-version)) (message eieio-version))
(require 'eieio-core) (require 'eieio-core)
(eval-when-compile (require 'subr-x))
;;; Defining a new class ;;; Defining a new class
@ -740,31 +741,37 @@ Called from the constructor routine."
"Construct the new object THIS based on SLOTS.") "Construct the new object THIS based on SLOTS.")
(cl-defmethod initialize-instance ((this eieio-default-superclass) (cl-defmethod initialize-instance ((this eieio-default-superclass)
&optional slots) &optional args)
"Construct the new object THIS based on SLOTS. "Construct the new object THIS based on SLOTS.
SLOTS is a tagged list where odd numbered elements are tags, and ARGS is a property list where odd numbered elements are tags, and
even numbered elements are the values to store in the tagged slot. even numbered elements are the values to store in the tagged slot.
If you overload the `initialize-instance', there you will need to If you overload the `initialize-instance', there you will need to
call `shared-initialize' yourself, or you can call `call-next-method' call `shared-initialize' yourself, or you can call `call-next-method'
to have this constructor called automatically. If these steps are to have this constructor called automatically. If these steps are
not taken, then new objects of your class will not have their values not taken, then new objects of your class will not have their values
dynamically set from SLOTS." dynamically set from ARGS."
;; First, see if any of our defaults are `lambda', and
;; re-evaluate them and apply the value to our slots.
(let* ((this-class (eieio--object-class this)) (let* ((this-class (eieio--object-class this))
(initargs args)
(slots (eieio--class-slots this-class))) (slots (eieio--class-slots this-class)))
(dotimes (i (length slots)) (dotimes (i (length slots))
;; For each slot, see if we need to evaluate it. ;; For each slot, see if we need to evaluate its initform.
(let* ((slot (aref slots i)) (let* ((slot (aref slots i))
(slot-name (eieio-slot-descriptor-name slot))
(initform (cl--slot-descriptor-initform slot))) (initform (cl--slot-descriptor-initform slot)))
;; Those slots whose initform is constant already have the right (unless (or (when-let ((initarg
;; value set in the default-object. (car (rassq slot-name
(unless (macroexp-const-p initform) (eieio--class-initarg-tuples
;; FIXME: We should be able to just do (aset this (+ i <cst>) dflt)! this-class)))))
(eieio-oset this (cl--slot-descriptor-name slot) (plist-get initargs initarg))
(eval initform t)))))) ;; Those slots whose initform is constant already have
;; Shared initialize will parse our slots for us. ;; the right value set in the default-object.
(shared-initialize this slots)) (macroexp-const-p initform))
;; FIXME: Use `aset' instead of `eieio-oset', relying on that
;; vector returned by `eieio--class-slots'
;; should be congruent with the object itself.
(eieio-oset this slot-name (eval initform t))))))
;; Shared initialize will parse our args for us.
(shared-initialize this args))
(cl-defgeneric slot-missing (object slot-name _operation &optional _new-value) (cl-defgeneric slot-missing (object slot-name _operation &optional _new-value)
"Method invoked when an attempt to access a slot in OBJECT fails. "Method invoked when an attempt to access a slot in OBJECT fails.

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

@ -318,16 +318,20 @@ Assumes the caller has bound `macroexpand-all-environment'."
(`(,(or 'function 'quote) . ,_) form) (`(,(or 'function 'quote) . ,_) form)
(`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
pcase--dontcare)) pcase--dontcare))
(macroexp--cons fun (macroexp--cons
(macroexp--cons (macroexp--all-clauses bindings 1) fun
(if (null body) (macroexp--cons
(macroexp-unprogn (macroexp--all-clauses bindings 1)
(macroexp-warn-and-return (if (null body)
(format "Empty %s body" fun) (macroexp-unprogn
nil t)) (macroexp-warn-and-return
(macroexp--all-forms body)) (and (or (not (fboundp 'byte-compile-warning-enabled-p))
(cdr form)) (byte-compile-warning-enabled-p t))
form)) (format "Empty %s body" fun))
nil t))
(macroexp--all-forms body))
(cdr form))
form))
(`(,(and fun `(lambda . ,_)) . ,args) (`(,(and fun `(lambda . ,_)) . ,args)
;; Embedded lambda in function position. ;; Embedded lambda in function position.
;; If the byte-optimizer is loaded, try to unfold this, ;; If the byte-optimizer is loaded, try to unfold this,

2
lisp/emacs-lisp/memory-report.el
View file

@ -44,6 +44,8 @@ by counted more than once."
(pop-to-buffer "*Memory Report*") (pop-to-buffer "*Memory Report*")
(special-mode) (special-mode)
(button-mode 1) (button-mode 1)
(setq-local revert-buffer-function (lambda (_ignore-auto _noconfirm)
(memory-report)))
(setq truncate-lines t) (setq truncate-lines t)
(message "Gathering data...") (message "Gathering data...")
(let ((reports (append (memory-report--garbage-collect) (let ((reports (append (memory-report--garbage-collect)

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

@ -3954,9 +3954,14 @@ packages."
(package--ensure-package-menu-mode) (package--ensure-package-menu-mode)
(if (or (not status) (string-empty-p status)) (if (or (not status) (string-empty-p status))
(package-menu--generate t t) (package-menu--generate t t)
(package-menu--filter-by (lambda (pkg-desc) (let ((status-list
(string-match-p status (package-desc-status pkg-desc))) (if (listp status)
(format "status:%s" status)))) status
(split-string status ","))))
(package-menu--filter-by
(lambda (pkg-desc)
(member (package-desc-status pkg-desc) status-list))
(format "status:%s" (string-join status-list ","))))))
(defun package-menu-filter-by-version (version predicate) (defun package-menu-filter-by-version (version predicate)
"Filter the \"*Packages*\" buffer by VERSION and PREDICATE. "Filter the \"*Packages*\" buffer by VERSION and PREDICATE.

15
lisp/emacs-lisp/re-builder.el
View file

@ -355,11 +355,16 @@ provided in the Commentary section of this library."
(reb-delete-overlays)) (reb-delete-overlays))
(setq reb-target-buffer (current-buffer) (setq reb-target-buffer (current-buffer)
reb-target-window (selected-window)) reb-target-window (selected-window))
(select-window (or (get-buffer-window reb-buffer) (select-window
(progn (or (get-buffer-window reb-buffer)
(setq reb-window-config (current-window-configuration)) (let ((dir (if (window-parameter nil 'window-side)
(split-window (selected-window) (- (window-height) 4))))) 'bottom 'down)))
(switch-to-buffer (get-buffer-create reb-buffer)) (setq reb-window-config (current-window-configuration))
(display-buffer
(get-buffer-create reb-buffer)
`((display-buffer-in-direction)
(direction . ,dir)
(dedicated . t))))))
(font-lock-mode 1) (font-lock-mode 1)
(reb-initialize-buffer))) (reb-initialize-buffer)))

9
lisp/emacs-lisp/shadow.el
View file

@ -115,9 +115,12 @@ See the documentation for `list-load-path-shadows' for further information."
;; FILE now contains the current file name, with no suffix. ;; FILE now contains the current file name, with no suffix.
(unless (or (member file files-seen-this-dir) (unless (or (member file files-seen-this-dir)
;; Ignore these files. ;; Ignore these files.
(member file (list "subdirs" "leim-list" (member file
(file-name-sans-extension (list "subdirs" "leim-list"
dir-locals-file)))) (file-name-sans-extension dir-locals-file)
(concat
(file-name-sans-extension dir-locals-file)
"-2"))))
;; File has not been seen yet in this directory. ;; File has not been seen yet in this directory.
;; This test prevents us declaring that XXX.el shadows ;; This test prevents us declaring that XXX.el shadows
;; XXX.elc (or vice-versa) when they are in the same directory. ;; XXX.elc (or vice-versa) when they are in the same directory.

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

@ -162,6 +162,10 @@ There can be any number of :example/:result elements."
:eval (split-string "foo bar") :eval (split-string "foo bar")
:eval (split-string "|foo|bar|" "|") :eval (split-string "|foo|bar|" "|")
:eval (split-string "|foo|bar|" "|" t)) :eval (split-string "|foo|bar|" "|" t))
(split-string-and-unquote
:eval (split-string-and-unquote "foo \"bar zot\""))
(split-string-shell-command
:eval (split-string-shell-command "ls /tmp/'foo bar'"))
(string-lines (string-lines
:eval (string-lines "foo\n\nbar") :eval (string-lines "foo\n\nbar")
:eval (string-lines "foo\n\nbar" t)) :eval (string-lines "foo\n\nbar" t))
@ -499,9 +503,13 @@ There can be any number of :example/:result elements."
(flatten-tree (flatten-tree
:eval (flatten-tree '(1 (2 3) 4))) :eval (flatten-tree '(1 (2 3) 4)))
(car (car
:eval (car '(one two three))) :eval (car '(one two three))
:eval (car '(one . two))
:eval (car nil))
(cdr (cdr
:eval (cdr '(one two three))) :eval (cdr '(one two three))
:eval (cdr '(one . two))
:eval (cdr nil))
(last (last
:eval (last '(one two three))) :eval (last '(one two three)))
(butlast (butlast
@ -1137,8 +1145,9 @@ There can be any number of :example/:result elements."
:eval (sqrt -1))) :eval (sqrt -1)))
;;;###autoload ;;;###autoload
(defun shortdoc-display-group (group) (defun shortdoc-display-group (group &optional function)
"Pop to a buffer with short documentation summary for functions in GROUP." "Pop to a buffer with short documentation summary for functions in GROUP.
If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)."
(interactive (list (completing-read "Show summary for functions in: " (interactive (list (completing-read "Show summary for functions in: "
(mapcar #'car shortdoc--groups)))) (mapcar #'car shortdoc--groups))))
(when (stringp group) (when (stringp group)
@ -1169,15 +1178,17 @@ There can be any number of :example/:result elements."
(setq prev t) (setq prev t)
(shortdoc--display-function data)))) (shortdoc--display-function data))))
(cdr (assq group shortdoc--groups)))) (cdr (assq group shortdoc--groups))))
(goto-char (point-min))) (goto-char (point-min))
(when function
(text-property-search-forward 'shortdoc-function function t)
(beginning-of-line)))
(defun shortdoc--display-function (data) (defun shortdoc--display-function (data)
(let ((function (pop data)) (let ((function (pop data))
(start-section (point)) (start-section (point))
arglist-start) arglist-start)
;; Function calling convention. ;; Function calling convention.
(insert (propertize "(" (insert (propertize "(" 'shortdoc-function function))
'shortdoc-function t))
(if (plist-get data :no-manual) (if (plist-get data :no-manual)
(insert-text-button (insert-text-button
(symbol-name function) (symbol-name function)
@ -1308,16 +1319,15 @@ Example:
(define-derived-mode shortdoc-mode special-mode "shortdoc" (define-derived-mode shortdoc-mode special-mode "shortdoc"
"Mode for shortdoc.") "Mode for shortdoc.")
(defmacro shortdoc--goto-section (arg sym &optional reverse) (defun shortdoc--goto-section (arg sym &optional reverse)
`(progn (unless (natnump arg)
(unless (natnump ,arg) (setq arg 1))
(setq ,arg 1)) (while (> arg 0)
(while (< 0 ,arg) (funcall
(,(if reverse (if reverse 'text-property-search-backward
'text-property-search-backward 'text-property-search-forward)
'text-property-search-forward) sym nil t t)
,sym t) (setq arg (1- arg))))
(setq ,arg (1- ,arg)))))
(defun shortdoc-next (&optional arg) (defun shortdoc-next (&optional arg)
"Move cursor to the next function. "Move cursor to the next function.

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

@ -36,6 +36,8 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl-lib))
(defgroup tabulated-list nil (defgroup tabulated-list nil
"Tabulated-list customization group." "Tabulated-list customization group."
:group 'convenience :group 'convenience
@ -645,18 +647,41 @@ this is the vector stored within it."
(defun tabulated-list-sort (&optional n) (defun tabulated-list-sort (&optional n)
"Sort Tabulated List entries by the column at point. "Sort Tabulated List entries by the column at point.
With a numeric prefix argument N, sort the Nth column." With a numeric prefix argument N, sort the Nth column.
If the numeric prefix is -1, restore order the list was
originally displayed in."
(interactive "P") (interactive "P")
(let ((name (if n (if (equal n -1)
(car (aref tabulated-list-format n)) ;; Restore original order.
(get-text-property (point) (progn
'tabulated-list-column-name)))) (unless tabulated-list--original-order
(if (nth 2 (assoc name (append tabulated-list-format nil))) (error "Order is already in original order"))
(tabulated-list--sort-by-column-name name) (setq tabulated-list-entries
(user-error "Cannot sort by %s" name)))) (sort tabulated-list-entries
(lambda (e1 e2)
(< (gethash e1 tabulated-list--original-order)
(gethash e2 tabulated-list--original-order)))))
(setq tabulated-list-sort-key nil)
(tabulated-list-init-header)
(tabulated-list-print t))
;; Sort based on a column name.
(let ((name (if n
(car (aref tabulated-list-format n))
(get-text-property (point)
'tabulated-list-column-name))))
(if (nth 2 (assoc name (append tabulated-list-format nil)))
(tabulated-list--sort-by-column-name name)
(user-error "Cannot sort by %s" name)))))
(defun tabulated-list--sort-by-column-name (name) (defun tabulated-list--sort-by-column-name (name)
(when (and name (derived-mode-p 'tabulated-list-mode)) (when (and name (derived-mode-p 'tabulated-list-mode))
(unless tabulated-list--original-order
;; Store the original order so that we can restore it later.
(setq tabulated-list--original-order (make-hash-table))
(cl-loop for elem in tabulated-list-entries
for i from 0
do (setf (gethash elem tabulated-list--original-order) i)))
;; Flip the sort order on a second click. ;; Flip the sort order on a second click.
(if (equal name (car tabulated-list-sort-key)) (if (equal name (car tabulated-list-sort-key))
(setcdr tabulated-list-sort-key (setcdr tabulated-list-sort-key
@ -717,6 +742,8 @@ Interactively, N is the prefix numeric argument, and defaults to
;;; The mode definition: ;;; The mode definition:
(defvar tabulated-list--original-order nil)
(define-derived-mode tabulated-list-mode special-mode "Tabulated" (define-derived-mode tabulated-list-mode special-mode "Tabulated"
"Generic major mode for browsing a list of items. "Generic major mode for browsing a list of items.
This mode is usually not used directly; instead, other major This mode is usually not used directly; instead, other major
@ -757,6 +784,7 @@ as the ewoc pretty-printer."
(setq-local glyphless-char-display (setq-local glyphless-char-display
(tabulated-list-make-glyphless-char-display-table)) (tabulated-list-make-glyphless-char-display-table))
(setq-local text-scale-remap-header-line t) (setq-local text-scale-remap-header-line t)
(setq-local tabulated-list--original-order nil)
;; Avoid messing up the entries' display just because the first ;; Avoid messing up the entries' display just because the first
;; column of the first entry happens to begin with a R2L letter. ;; column of the first entry happens to begin with a R2L letter.
(setq bidi-paragraph-direction 'left-to-right) (setq bidi-paragraph-direction 'left-to-right)

12
lisp/facemenu.el
View file

@ -244,6 +244,10 @@ return a string which is inserted. It may set `facemenu-end-add-face'."
(define-key map [fc] (cons "Face" 'facemenu-face-menu))) (define-key map [fc] (cons "Face" 'facemenu-face-menu)))
(defalias 'facemenu-menu facemenu-menu) (defalias 'facemenu-menu facemenu-menu)
;;;###autoload (autoload 'facemenu-menu "facemenu" nil nil 'keymap)
;;;###autoload
(define-key global-map [C-down-mouse-2] 'facemenu-menu)
(easy-menu-add-item (easy-menu-add-item
menu-bar-edit-menu nil menu-bar-edit-menu nil
["Text Properties" facemenu-menu]) ["Text Properties" facemenu-menu])
@ -714,7 +718,13 @@ they are used to set the face information.
As a special case, if FACE is `default', then the region is left with NO face As a special case, if FACE is `default', then the region is left with NO face
text property. Otherwise, selecting the default face would not have any text property. Otherwise, selecting the default face would not have any
effect. See `facemenu-remove-face-function'." effect. See `facemenu-remove-face-function'."
(interactive "*xFace: \nr") (interactive (list (progn
(barf-if-buffer-read-only)
(read-face-name "Use face" (face-at-point t)))
(if (and mark-active (not current-prefix-arg))
(region-beginning))
(if (and mark-active (not current-prefix-arg))
(region-end))))
(cond (cond
((and (eq face 'default) ((and (eq face 'default)
(not (eq facemenu-remove-face-function t))) (not (eq facemenu-remove-face-function t)))

23
lisp/faces.el
View file

@ -2914,23 +2914,30 @@ It is used for characters of no fonts too."
;; Faces for TTY menus. ;; Faces for TTY menus.
(defface tty-menu-enabled-face (defface tty-menu-enabled-face
'((t '((((class color))
:foreground "yellow" :background "blue" :weight bold)) :foreground "yellow" :background "blue" :weight bold)
(t :weight bold))
"Face for displaying enabled items in TTY menus." "Face for displaying enabled items in TTY menus."
:group 'basic-faces) :group 'basic-faces
:version "28.1")
(defface tty-menu-disabled-face (defface tty-menu-disabled-face
'((((class color) (min-colors 16)) '((((class color) (min-colors 16))
:foreground "lightgray" :background "blue") :foreground "lightgray" :background "blue")
(t (((class color))
:foreground "white" :background "blue")) :foreground "white" :background "blue")
(t :inherit shadow))
"Face for displaying disabled items in TTY menus." "Face for displaying disabled items in TTY menus."
:group 'basic-faces) :group 'basic-faces
:version "28.1")
(defface tty-menu-selected-face (defface tty-menu-selected-face
'((t :background "red")) '((((class color))
:background "red")
(t :inverse-video t))
"Face for displaying the currently selected item in TTY menus." "Face for displaying the currently selected item in TTY menus."
:group 'basic-faces) :group 'basic-faces
:version "28.1")
(defgroup paren-showing-faces nil (defgroup paren-showing-faces nil
"Faces used to highlight paren matches." "Faces used to highlight paren matches."

1
lisp/ffap.el
View file

@ -260,6 +260,7 @@ ffap most of the time."
:type 'boolean :type 'boolean
:group 'ffap) :group 'ffap)
;;;###autoload
(defcustom ffap-file-finder 'find-file (defcustom ffap-file-finder 'find-file
"The command called by `find-file-at-point' to find a file." "The command called by `find-file-at-point' to find a file."
:type 'function :type 'function

176
lisp/files.el
View file

@ -465,6 +465,31 @@ If `silently', don't ask the user before saving."
:type '(choice (const t) (const nil) (const silently)) :type '(choice (const t) (const nil) (const silently))
:group 'abbrev) :group 'abbrev)
(defcustom lock-file-name-transforms nil
"Transforms to apply to buffer file name before making a lock file name.
This has the same syntax as
`auto-save-file-name-transforms' (which see), but instead of
applying to auto-save file names, it's applied to lock file names.
By default, a lock file is put into the same directory as the
file it's locking, and it has the same name, but with \".#\" prepended."
:group 'files
:type '(repeat (list (regexp :tag "Regexp")
(string :tag "Replacement")
(boolean :tag "Uniquify")))
:version "28.1")
(defcustom remote-file-name-inhibit-locks nil
"Whether to use file locks for remote files."
:group 'files
:version "28.1"
:type 'boolean)
(define-minor-mode lock-file-mode
"Toggle file locking in the current buffer (Lock File mode)."
:version "28.1"
(setq-local create-lockfiles (and lock-file-mode t)))
(defcustom find-file-run-dired t (defcustom find-file-run-dired t
"Non-nil means allow `find-file' to visit directories. "Non-nil means allow `find-file' to visit directories.
To visit the directory, `find-file' runs `find-directory-functions'." To visit the directory, `find-file' runs `find-directory-functions'."
@ -2133,6 +2158,19 @@ think it does, because \"free\" is pretty hard to define in practice."
:version "25.1" :version "25.1"
:type '(choice integer (const :tag "Never issue warning" nil))) :type '(choice integer (const :tag "Never issue warning" nil)))
(defcustom query-about-changed-file t
"If non-nil, query the user when re-visiting a file that has changed.
This happens if the file is already visited in a buffer, the
file was changed externally, and the user re-visits the file.
If nil, don't prompt the user, but instead provide instructions for
reverting, after switching to the buffer with its contents before
the external changes."
:group 'files
:group 'find-file
:version "28.1"
:type 'boolean)
(declare-function x-popup-dialog "menu.c" (position contents &optional header)) (declare-function x-popup-dialog "menu.c" (position contents &optional header))
(defun files--ask-user-about-large-file-help-text (op-type size) (defun files--ask-user-about-large-file-help-text (op-type size)
@ -2315,6 +2353,14 @@ the various files."
(message "Reverting file %s..." filename) (message "Reverting file %s..." filename)
(revert-buffer t t) (revert-buffer t t)
(message "Reverting file %s...done" filename))) (message "Reverting file %s...done" filename)))
((not query-about-changed-file)
(message
(substitute-command-keys
"File %s changed on disk. \\[revert-buffer] to load new contents%s")
(file-name-nondirectory filename)
(if (buffer-modified-p buf)
" and discard your edits"
"")))
((yes-or-no-p ((yes-or-no-p
(if (string= (file-name-nondirectory filename) (if (string= (file-name-nondirectory filename)
(buffer-name buf)) (buffer-name buf))
@ -6664,67 +6710,15 @@ Does not consider `auto-save-visited-file-name' as that variable is checked
before calling this function. before calling this function.
See also `auto-save-file-name-p'." See also `auto-save-file-name-p'."
(if buffer-file-name (if buffer-file-name
(let ((handler (find-file-name-handler buffer-file-name (let ((handler (find-file-name-handler
'make-auto-save-file-name))) buffer-file-name 'make-auto-save-file-name)))
(if handler (if handler
(funcall handler 'make-auto-save-file-name) (funcall handler 'make-auto-save-file-name)
(let ((list auto-save-file-name-transforms) (files--transform-file-name
(filename buffer-file-name) buffer-file-name auto-save-file-name-transforms
result uniq) "#" "#")))
;; Apply user-specified translations
;; to the file name.
(while (and list (not result))
(if (string-match (car (car list)) filename)
(setq result (replace-match (cadr (car list)) t nil
filename)
uniq (car (cddr (car list)))))
(setq list (cdr list)))
(if result
(setq filename
(cond
((memq uniq (secure-hash-algorithms))
(concat
(file-name-directory result)
(secure-hash uniq filename)))
(uniq
(concat
(file-name-directory result)
(subst-char-in-string
?/ ?!
(replace-regexp-in-string
"!" "!!" filename))))
(t result))))
(setq result
(if (and (eq system-type 'ms-dos)
(not (msdos-long-file-names)))
;; We truncate the file name to DOS 8+3 limits
;; before doing anything else, because the regexp
;; passed to string-match below cannot handle
;; extensions longer than 3 characters, multiple
;; dots, and other atrocities.
(let ((fn (dos-8+3-filename
(file-name-nondirectory buffer-file-name))))
(string-match
"\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
fn)
(concat (file-name-directory buffer-file-name)
"#" (match-string 1 fn)
"." (match-string 3 fn) "#"))
(concat (file-name-directory filename)
"#"
(file-name-nondirectory filename)
"#")))
;; Make sure auto-save file names don't contain characters
;; invalid for the underlying filesystem.
(if (and (memq system-type '(ms-dos windows-nt cygwin))
;; Don't modify remote filenames
(not (file-remote-p result)))
(convert-standard-filename result)
result))))
;; Deal with buffers that don't have any associated files. (Mail ;; Deal with buffers that don't have any associated files. (Mail
;; mode tends to create a good number of these.) ;; mode tends to create a good number of these.)
(let ((buffer-name (buffer-name)) (let ((buffer-name (buffer-name))
(limit 0) (limit 0)
file-name) file-name)
@ -6772,6 +6766,74 @@ See also `auto-save-file-name-p'."
(file-error nil)) (file-error nil))
file-name))) file-name)))
(defun files--transform-file-name (filename transforms prefix suffix)
"Transform FILENAME according to TRANSFORMS.
See `auto-save-file-name-transforms' for the format of
TRANSFORMS. PREFIX is prepended to the non-directory portion of
the resulting file name, and SUFFIX is appended."
(save-match-data
(let (result uniq)
;; Apply user-specified translations to the file name.
(while (and transforms (not result))
(if (string-match (car (car transforms)) filename)
(setq result (replace-match (cadr (car transforms)) t nil
filename)
uniq (car (cddr (car transforms)))))
(setq transforms (cdr transforms)))
(when result
(setq filename
(cond
((memq uniq (secure-hash-algorithms))
(concat
(file-name-directory result)
(secure-hash uniq filename)))
(uniq
(concat
(file-name-directory result)
(subst-char-in-string
?/ ?!
(replace-regexp-in-string
"!" "!!" filename))))
(t result))))
(setq result
(if (and (eq system-type 'ms-dos)
(not (msdos-long-file-names)))
;; We truncate the file name to DOS 8+3 limits before
;; doing anything else, because the regexp passed to
;; string-match below cannot handle extensions longer
;; than 3 characters, multiple dots, and other
;; atrocities.
(let ((fn (dos-8+3-filename
(file-name-nondirectory buffer-file-name))))
(string-match
"\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
fn)
(concat (file-name-directory buffer-file-name)
prefix (match-string 1 fn)
"." (match-string 3 fn) suffix))
(concat (file-name-directory filename)
prefix
(file-name-nondirectory filename)
suffix)))
;; Make sure auto-save file names don't contain characters
;; invalid for the underlying filesystem.
(expand-file-name
(if (and (memq system-type '(ms-dos windows-nt cygwin))
;; Don't modify remote filenames
(not (file-remote-p result)))
(convert-standard-filename result)
result)))))
(defun make-lock-file-name (filename)
"Make a lock file name for FILENAME.
By default, this just prepends \".#\" to the non-directory part
of FILENAME, but the transforms in `lock-file-name-transforms'
are done first."
(let ((handler (find-file-name-handler filename 'make-lock-file-name)))
(if handler
(funcall handler 'make-lock-file-name filename)
(files--transform-file-name filename lock-file-name-transforms ".#" ""))))
(defun auto-save-file-name-p (filename) (defun auto-save-file-name-p (filename)
"Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
FILENAME should lack slashes. FILENAME should lack slashes.

10
lisp/frame.el
View file

@ -1397,7 +1397,7 @@ FRAME defaults to the selected frame."
(declare-function x-list-fonts "xfaces.c" (declare-function x-list-fonts "xfaces.c"
(pattern &optional face frame maximum width)) (pattern &optional face frame maximum width))
(defun set-frame-font (font &optional keep-size frames) (defun set-frame-font (font &optional keep-size frames inhibit-customize)
"Set the default font to FONT. "Set the default font to FONT.
When called interactively, prompt for the name of a font, and use When called interactively, prompt for the name of a font, and use
that font on the selected frame. When called from Lisp, FONT that font on the selected frame. When called from Lisp, FONT
@ -1414,7 +1414,10 @@ If FRAMES is non-nil, it should be a list of frames to act upon,
or t meaning all existing graphical frames. or t meaning all existing graphical frames.
Also, if FRAMES is non-nil, alter the user's Customization settings Also, if FRAMES is non-nil, alter the user's Customization settings
as though the font-related attributes of the `default' face had been as though the font-related attributes of the `default' face had been
\"set in this session\", so that the font is applied to future frames." \"set in this session\", so that the font is applied to future frames.
If INHIBIT-CUSTOMIZE is non-nil, don't update the user's
Customization settings."
(interactive (interactive
(let* ((completion-ignore-case t) (let* ((completion-ignore-case t)
(default (frame-parameter nil 'font)) (default (frame-parameter nil 'font))
@ -1451,7 +1454,8 @@ as though the font-related attributes of the `default' face had been
f f
(list (cons 'height (round height (frame-char-height f))) (list (cons 'height (round height (frame-char-height f)))
(cons 'width (round width (frame-char-width f)))))))) (cons 'width (round width (frame-char-width f))))))))
(when frames (when (and frames
(not inhibit-customize))
;; Alter the user's Custom setting of the `default' face, but ;; Alter the user's Custom setting of the `default' face, but
;; only for font-related attributes. ;; only for font-related attributes.
(let ((specs (cadr (assq 'user (get 'default 'theme-face)))) (let ((specs (cadr (assq 'user (get 'default 'theme-face))))

23
lisp/gnus/gnus-art.el
View file

@ -6039,7 +6039,28 @@ If nil, don't show those extra buttons."
(ignored gnus-ignored-mime-types) (ignored gnus-ignored-mime-types)
(mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight)) (mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight))
(not-attachment t) (not-attachment t)
display text) ;; Arrange a callback from `mm-inline-message' if we're
;; displaying a message/rfc822 part.
(mm-inline-message-prepare-function
(lambda (charset)
(let ((handles
(let (gnus-article-mime-handles
;; disable prepare hook
gnus-article-prepare-hook
(gnus-newsgroup-charset
;; mm-uu might set it.
(unless (eq charset 'gnus-decoded)
(or charset gnus-newsgroup-charset))))
(let ((gnus-original-article-buffer
(mm-handle-buffer handle)))
(run-hooks 'gnus-article-decode-hook))
(gnus-article-prepare-display)
gnus-article-mime-handles)))
(when handles
(setq gnus-article-mime-handles
(mm-merge-handles gnus-article-mime-handles handles))))))
display text
gnus-displaying-mime)
(catch 'ignored (catch 'ignored
(progn (progn
(while ignored (while ignored

4
lisp/gnus/gnus-msg.el
View file

@ -1597,6 +1597,10 @@ this is a reply."
(if (stringp gnus-gcc-externalize-attachments) (if (stringp gnus-gcc-externalize-attachments)
(string-match gnus-gcc-externalize-attachments group) (string-match gnus-gcc-externalize-attachments group)
gnus-gcc-externalize-attachments)) gnus-gcc-externalize-attachments))
;; If we want to externalize stuff when GCC-ing, then we
;; can't use the cache, because that has all the contents.
(when mml-externalize-attachments
(setq encoded-cache nil))
(save-excursion (save-excursion
(nnheader-set-temp-buffer " *acc*") (nnheader-set-temp-buffer " *acc*")
(setq message-options (with-current-buffer cur message-options)) (setq message-options (with-current-buffer cur message-options))

136
lisp/gnus/gnus-search.el
View file

@ -448,10 +448,10 @@ auto-completion of contact names and addresses for keys like
Date values (any key in `gnus-search-date-keys') can be provided Date values (any key in `gnus-search-date-keys') can be provided
in any format that `parse-time-string' can parse (note that this in any format that `parse-time-string' can parse (note that this
can produce weird results). Dates with missing bits will be can produce weird results). Dates with missing bits will be
interpreted as the most recent occurence thereof (ie \"march 03\" interpreted as the most recent occurrence thereof (i.e. \"march
is the most recent March 3rd). Lastly, relative specifications 03\" is the most recent March 3rd). Lastly, relative
such as 1d (one day ago) are understood. This also accepts w, m, specifications such as 1d (one day ago) are understood. This
and y. m is assumed to be 30 days. also accepts w, m, and y. m is assumed to be 30 days.
This function will accept pretty much anything as input. Its This function will accept pretty much anything as input. Its
only job is to parse the query into a sexp, and pass that on -- only job is to parse the query into a sexp, and pass that on --
@ -629,25 +629,30 @@ gnus-*-mark marks, and return an appropriate string."
mark)) mark))
(defun gnus-search-query-expand-key (key) (defun gnus-search-query-expand-key (key)
(cond ((test-completion key gnus-search-expandable-keys) "Attempt to expand KEY to a full keyword.
;; We're done! Use `gnus-search-expandable-keys' as a completion table; return
key) KEY directly if it can't be completed. Raise an error if KEY is
;; There is more than one possible completion. ambiguous, meaning that it is a prefix of multiple known
((consp (cdr (completion-all-completions keywords. This means that it's not possible to enter a custom
key gnus-search-expandable-keys #'stringp 0))) keyword that happens to be a prefix of a known keyword."
(signal 'gnus-search-parse-error (let ((comp (try-completion key gnus-search-expandable-keys)))
(list (format "Ambiguous keyword: %s" key)))) (if (or (eql comp 't) ; Already a key.
;; Return KEY, either completed or untouched. (null comp)) ; An unknown key.
((car-safe (completion-try-completion key
key gnus-search-expandable-keys (if (null (member comp gnus-search-expandable-keys))
#'stringp 0))))) ;; KEY is a prefix of multiple known keywords, and could not
;; be completed to something unique.
(signal 'gnus-search-parse-error
(list (format "Ambiguous keyword: %s" key)))
;; We completed to a unique known key.
comp))))
(defun gnus-search-query-return-string (&optional delimited trim) (defun gnus-search-query-return-string (&optional delimited trim)
"Return a string from the current buffer. "Return a string from the current buffer.
If DELIMITED is non-nil, assume the next character is a delimiter If DELIMITED is non-nil, assume the next character is a delimiter
character, and return everything between point and the next character, and return everything between point and the next
occurence of the delimiter, including the delimiters themselves. occurrence of the delimiter, including the delimiters themselves.
If TRIM is non-nil, do not return the delimiters. Otherwise, If TRIM is non-nil, do not return the delimiters. Otherwise,
return one word." return one word."
;; This function cannot handle nested delimiters, as it's not a ;; This function cannot handle nested delimiters, as it's not a
;; proper parser. Ie, you cannot parse "to:bob or (from:bob or ;; proper parser. Ie, you cannot parse "to:bob or (from:bob or
@ -1351,68 +1356,59 @@ Returns a list of [group article score] vectors."
(cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed) (cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed)
server query &optional groups) server query &optional groups)
(let ((prefix (slot-value engine 'remove-prefix)) (let ((prefix (or (slot-value engine 'remove-prefix)
(group-regexp (when groups ""))
(mapconcat artlist article group)
(lambda (group-name)
(mapconcat #'regexp-quote
(split-string
(gnus-group-real-name group-name)
"[.\\/]")
"[.\\\\/]"))
groups
"\\|")))
artlist vectors article group)
(goto-char (point-min)) (goto-char (point-min))
;; Prep prefix, we want to at least be removing the root
;; filesystem separator.
(when (stringp prefix)
(setq prefix (file-name-as-directory
(expand-file-name prefix "/"))))
(while (not (or (eobp) (while (not (or (eobp)
(looking-at-p (looking-at-p
"\\(?:[[:space:]\n]+\\)?Process .+ finished"))) "\\(?:[[:space:]\n]+\\)?Process .+ finished")))
(pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine))) (pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine)))
(when (and f-name (when (and f-name
(file-readable-p f-name) (file-readable-p f-name)
(null (file-directory-p f-name)) (null (file-directory-p f-name)))
(or (null groups) (setq group
(and (gnus-search-single-p query) (replace-regexp-in-string
(alist-get 'thread query)) "[/\\]" "."
(string-match-p group-regexp f-name))) (replace-regexp-in-string
(push (list f-name score) artlist)))) "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
(replace-regexp-in-string
"\\`\\." ""
(string-remove-prefix
prefix (file-name-directory f-name))
nil t)
nil t)
nil t))
(setq group (gnus-group-full-name group server))
(setq article (file-name-nondirectory f-name)
article
;; TODO: Provide a cleaner way of producing final
;; article numbers for the various backends.
(if (string-match-p "\\`[[:digit:]]+\\'" article)
(string-to-number article)
(nnmaildir-base-name-to-article-number
(substring article 0 (string-match ":" article))
group (string-remove-prefix "nnmaildir:" server))))
(when (and (numberp article)
(or (null groups)
(member group groups)))
(push (list f-name article group score)
artlist)))))
;; Are we running an additional grep query? ;; Are we running an additional grep query?
(when-let ((grep-reg (alist-get 'grep query))) (when-let ((grep-reg (alist-get 'grep query)))
(setq artlist (gnus-search-grep-search engine artlist grep-reg))) (setq artlist (gnus-search-grep-search engine artlist grep-reg)))
;; Prep prefix. ;; Munge into the list of vectors expected by nnselect.
(when (and prefix (null (string-empty-p prefix))) (mapcar (pcase-lambda (`(,_ ,article ,group ,score))
(setq prefix (file-name-as-directory (expand-file-name prefix)))) (vector group article
;; Turn (file-name score) into [group article score]. (if (numberp score)
(pcase-dolist (`(,f-name ,score) artlist) score
(setq article (file-name-nondirectory f-name) (string-to-number score))))
group (file-name-directory f-name)) artlist)))
;; Remove prefix.
(when prefix
(setq group (string-remove-prefix prefix group)))
;; Break the directory name down until it's something that
;; (probably) can be used as a group name.
(setq group
(replace-regexp-in-string
"[/\\]" "."
(replace-regexp-in-string
"/?\\(cur\\|new\\|tmp\\)?/\\'" ""
(replace-regexp-in-string
"^[./\\]" ""
group nil t)
nil t)
nil t))
(push (vector (gnus-group-full-name group server)
(if (string-match-p "\\`[[:digit:]]+\\'" article)
(string-to-number article)
(nnmaildir-base-name-to-article-number
(substring article 0 (string-match ":" article))
group (string-remove-prefix "nnmaildir:" server)))
(if (numberp score)
score
(string-to-number score)))
vectors))
vectors))
(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed)) (cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed))
"Base implementation treats the whole line as a filename, and "Base implementation treats the whole line as a filename, and

20
lisp/gnus/message.el
View file

@ -1658,6 +1658,11 @@ starting with `not' and followed by regexps."
"Face used for displaying MML." "Face used for displaying MML."
:group 'message-faces) :group 'message-faces)
(defface message-signature-separator '((t :bold t))
"Face used for displaying the signature separator."
:group 'message-faces
:version "28.1")
(defun message-match-to-eoh (_limit) (defun message-match-to-eoh (_limit)
(let ((start (point))) (let ((start (point)))
(rfc822-goto-eoh) (rfc822-goto-eoh)
@ -1751,9 +1756,22 @@ number of levels specified in the faces `message-cited-text-*'."
(0 ',cited-text-face)) (0 ',cited-text-face))
keywords)) keywords))
(setq level (1+ level))) (setq level (1+ level)))
keywords)) keywords)
;; Match signature. This `field' stuff ensures that hitting `RET'
;; after the signature separator doesn't remove the trailing space.
(list
'(message--match-signature (0 '( face message-signature-separator
rear-nonsticky t
field signature)))))
"Additional expressions to highlight in Message mode.") "Additional expressions to highlight in Message mode.")
(defun message--match-signature (limit)
(save-excursion
(and (re-search-forward message-signature-separator limit t)
;; It's the last one in the buffer.
(not (save-excursion
(re-search-forward message-signature-separator nil t))))))
(defvar message-face-alist (defvar message-face-alist
'((bold . message-bold-region) '((bold . message-bold-region)
(underline . underline-region) (underline . underline-region)

27
lisp/gnus/mm-view.el
View file

@ -418,16 +418,18 @@ This is only used if `mm-inline-large-images' is set to
(fundamental-mode) (fundamental-mode)
(goto-char (point-min))) (goto-char (point-min)))
(defvar gnus-original-article-buffer) (defvar mm-inline-message-prepare-function nil
(defvar gnus-article-prepare-hook) "Function called by `mm-inline-message' to do client specific setup.
(defvar gnus-displaying-mime) It is called with one parameter -- the charset.")
(defun mm-inline-message (handle) (defun mm-inline-message (handle)
"Insert HANDLE (a message/rfc822 part) into the current buffer.
This function will call `mm-inline-message-prepare-function'
after inserting the part."
(let ((b (point)) (let ((b (point))
(bolp (bolp)) (bolp (bolp))
(charset (mail-content-type-get (charset (mail-content-type-get
(mm-handle-type handle) 'charset)) (mm-handle-type handle) 'charset)))
gnus-displaying-mime handles)
(when (and charset (when (and charset
(stringp charset)) (stringp charset))
(setq charset (intern (downcase charset))) (setq charset (intern (downcase charset)))
@ -437,16 +439,8 @@ This is only used if `mm-inline-large-images' is set to
(save-restriction (save-restriction
(narrow-to-region b b) (narrow-to-region b b)
(mm-insert-part handle) (mm-insert-part handle)
(let (gnus-article-mime-handles (when mm-inline-message-prepare-function
;; disable prepare hook (funcall mm-inline-message-prepare-function charset))
gnus-article-prepare-hook
(gnus-newsgroup-charset
(unless (eq charset 'gnus-decoded) ;; mm-uu might set it.
(or charset gnus-newsgroup-charset))))
(let ((gnus-original-article-buffer (mm-handle-buffer handle)))
(run-hooks 'gnus-article-decode-hook))
(gnus-article-prepare-display)
(setq handles gnus-article-mime-handles))
(goto-char (point-min)) (goto-char (point-min))
(unless bolp (unless bolp
(insert "\n")) (insert "\n"))
@ -454,9 +448,6 @@ This is only used if `mm-inline-large-images' is set to
(unless (bolp) (unless (bolp)
(insert "\n")) (insert "\n"))
(insert "----------\n\n") (insert "----------\n\n")
(when handles
(setq gnus-article-mime-handles
(mm-merge-handles gnus-article-mime-handles handles)))
(mm-handle-set-undisplayer (mm-handle-set-undisplayer
handle handle
(let ((beg (point-min-marker)) (let ((beg (point-min-marker))

4
lisp/help-fns.el
View file

@ -752,7 +752,7 @@ FILE is the file where FUNCTION was probably defined."
(insert-text-button (insert-text-button
(symbol-name group) (symbol-name group)
'action (lambda (_) 'action (lambda (_)
(shortdoc-display-group group)) (shortdoc-display-group group object))
'follow-link t 'follow-link t
'help-echo (purecopy "mouse-1, RET: show documentation group"))) 'help-echo (purecopy "mouse-1, RET: show documentation group")))
groups) groups)
@ -1901,7 +1901,7 @@ documentation for the major and minor modes of that buffer."
;; Ignore aliases. ;; Ignore aliases.
(not (symbolp (symbol-function sym))) (not (symbolp (symbol-function sym)))
;; Ignore everything bound. ;; Ignore everything bound.
(not (where-is-internal sym)) (not (where-is-internal sym nil t))
(apply #'derived-mode-p (command-modes sym))) (apply #'derived-mode-p (command-modes sym)))
(push sym functions)))) (push sym functions))))
(with-temp-buffer (with-temp-buffer

2
lisp/hi-lock.el
View file

@ -111,7 +111,7 @@ highlighting will be applied throughout the buffer."
:group 'hi-lock) :group 'hi-lock)
(defcustom hi-lock-exclude-modes (defcustom hi-lock-exclude-modes
'(rmail-mode mime/viewer-mode gnus-article-mode) '(rmail-mode mime/viewer-mode gnus-article-mode term-mode)
"List of major modes in which hi-lock will not run. "List of major modes in which hi-lock will not run.
For security reasons since font lock patterns can specify function For security reasons since font lock patterns can specify function
calls." calls."

24
lisp/hilit-chg.el
View file

@ -492,9 +492,9 @@ This allows you to manually remove highlighting from uninteresting changes."
;; otherwise an undone change shows up as changed. While the properties ;; otherwise an undone change shows up as changed. While the properties
;; are automatically restored by undo, we must fix up the overlay. ;; are automatically restored by undo, we must fix up the overlay.
(save-match-data (save-match-data
(let (;;(beg-decr 1) (let ((end-incr 1)
(end-incr 1) (type 'hilit-chg)
(type 'hilit-chg)) (property 'hilit-chg))
(if undo-in-progress (if undo-in-progress
(if (and highlight-changes-mode (if (and highlight-changes-mode
highlight-changes-visible-mode) highlight-changes-visible-mode)
@ -515,7 +515,8 @@ This allows you to manually remove highlighting from uninteresting changes."
;; (setq beg-decr 0)))) ;; (setq beg-decr 0))))
;; (setq beg (max (- beg beg-decr) (point-min))) ;; (setq beg (max (- beg beg-decr) (point-min)))
(setq end (min (+ end end-incr) (point-max))) (setq end (min (+ end end-incr) (point-max)))
(setq type 'hilit-chg-delete)) (setq type 'hilit-chg-delete
property 'hilit-chg-delete))
;; Not a deletion. ;; Not a deletion.
;; Most of the time the following is not necessary, but ;; Most of the time the following is not necessary, but
;; if the current text was marked as a deletion then ;; if the current text was marked as a deletion then
@ -523,14 +524,15 @@ This allows you to manually remove highlighting from uninteresting changes."
;; text where she earlier deleted text, we have to remove the ;; text where she earlier deleted text, we have to remove the
;; deletion marking, and replace it explicitly with a `changed' ;; deletion marking, and replace it explicitly with a `changed'
;; marking, otherwise its highlighting would disappear. ;; marking, otherwise its highlighting would disappear.
(if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete) (when (eq (get-text-property end 'hilit-chg-delete)
(save-restriction 'hilit-chg-delete)
(widen) (save-restriction
(put-text-property end (+ end 1) 'hilit-chg 'hilit-chg) (widen)
(if highlight-changes-visible-mode (put-text-property end (+ end 1) 'hilit-chg-delete nil)
(hilit-chg-fixup end (+ end 1)))))) (if highlight-changes-visible-mode
(hilit-chg-fixup end (+ end 1))))))
(unless no-property-change (unless no-property-change
(put-text-property beg end 'hilit-chg type)) (put-text-property beg end property type))
(if (or highlight-changes-visible-mode no-property-change) (if (or highlight-changes-visible-mode no-property-change)
(hilit-chg-make-ov type beg end))))))) (hilit-chg-make-ov type beg end)))))))

4
lisp/ido.el
View file

@ -1521,6 +1521,10 @@ Removes badly formatted data and ignored directories."
:global t :global t
(remove-function read-file-name-function #'ido-read-file-name) (remove-function read-file-name-function #'ido-read-file-name)
(remove-function read-buffer-function #'ido-read-buffer) (remove-function read-buffer-function #'ido-read-buffer)
(when (boundp 'ffap-file-finder)
(remove-function ffap-file-finder #'ido-find-file)
(when ido-mode
(add-function :override ffap-file-finder #'ido-find-file)))
(when ido-everywhere (when ido-everywhere
(if (not ido-mode) (if (not ido-mode)
(ido-mode 'both) (ido-mode 'both)

4
lisp/image.el
View file

@ -1191,7 +1191,9 @@ rotations by only multiples of 90 degrees."
360))))) 360)))))
(defun image-save () (defun image-save ()
"Save the image under point." "Save the image under point.
This writes the original image data to a file. Rotating or
changing the displayed image size does not affect the saved image."
(interactive) (interactive)
(let ((image (image--get-image))) (let ((image (image--get-image)))
(with-temp-buffer (with-temp-buffer

83
lisp/info.el
View file

@ -391,6 +391,14 @@ where SUPPORTS-INDEX-COOKIES can be either t or nil.")
(defvar-local Info-index-alternatives nil (defvar-local Info-index-alternatives nil
"List of possible matches for last `Info-index' command.") "List of possible matches for last `Info-index' command.")
(defvar-local Info--current-index-alternative 0
"Current displayed index alternative.")
(defcustom Info-warn-on-index-alternatives-wrap t
"Warn when wrapping to the beginning/end when displaying index alternatives."
:type 'boolean
:version "28.1")
(defvar Info-point-loc nil (defvar Info-point-loc nil
"Point location within a selected node. "Point location within a selected node.
If string, the point is moved to the proper occurrence of the If string, the point is moved to the proper occurrence of the
@ -3375,39 +3383,56 @@ Give an empty topic name to go to the Index node itself."
(setq exact (cons found exact) (setq exact (cons found exact)
matches (delq found matches))) matches (delq found matches)))
(setq Info-history-list ohist-list) (setq Info-history-list ohist-list)
(setq Info-index-alternatives (nconc exact (nreverse matches))) (setq Info-index-alternatives (nconc exact (nreverse matches))
Info--current-index-alternative 0)
(Info-index-next 0))))) (Info-index-next 0)))))
(defun Info-index-next (num) (defun Info-index-next (num)
"Go to the next matching index item from the last \\<Info-mode-map>\\[Info-index] command." "Go to the next matching index item from the last \\<Info-mode-map>\\[Info-index] command.
If given a numeric prefix, skip that many index items forward (or
backward).
Also see the `Info-warn-on-index-alternatives-wrap' user option."
(interactive "p" Info-mode) (interactive "p" Info-mode)
(or Info-index-alternatives (unless Info-index-alternatives
(user-error "No previous `i' command")) (user-error "No previous `i' command"))
(while (< num 0) (let ((index (+ Info--current-index-alternative num))
(setq num (+ num (length Info-index-alternatives)))) (total (length Info-index-alternatives))
(while (> num 0) (next-key (key-description (where-is-internal
(setq Info-index-alternatives 'Info-index-next overriding-local-map t))))
(nconc (cdr Info-index-alternatives) (if (and Info-warn-on-index-alternatives-wrap
(list (car Info-index-alternatives))) (> total 1)
num (1- num))) (cond
(Info-goto-node (nth 1 (car Info-index-alternatives))) ((< index 0)
(if (> (nth 3 (car Info-index-alternatives)) 0) (setq Info--current-index-alternative (- total 2))
;; Forward 2 lines less because `Info-find-node-2' initially (message
;; puts point to the 2nd line. "No previous matches, use `%s' to continue from end of list"
(forward-line (- (nth 3 (car Info-index-alternatives)) 2)) next-key)
(forward-line 3) ; don't search in headers t)
(let ((name (car (car Info-index-alternatives)))) ((>= index total)
(Info-find-index-name name))) (setq Info--current-index-alternative -1)
(message "Found `%s' in %s. %s" (message
(car (car Info-index-alternatives)) "No previous matches, use `%s' to continue from start of list"
(nth 2 (car Info-index-alternatives)) next-key)
(if (cdr Info-index-alternatives) t)))
(format-message () ; Do nothing
"(%s total; use `%s' for next)" (setq index (mod index total)
(length Info-index-alternatives) Info--current-index-alternative index)
(key-description (where-is-internal (let ((entry (nth index Info-index-alternatives)))
'Info-index-next overriding-local-map t))) (Info-goto-node (nth 1 entry))
"(Only match)"))) (if (> (nth 3 entry) 0)
;; Forward 2 lines less because `Info-find-node-2' initially
;; puts point to the 2nd line.
(forward-line (- (nth 3 entry) 2))
(forward-line 3) ; don't search in headers
(Info-find-index-name (car entry)))
(message "Found `%s' in %s. %s"
(car entry)
(nth 2 entry)
(if (> total 1)
(format-message
"(%s total; use `%s' for next)" total next-key)
"(Only match)"))))))
(defun Info-find-index-name (name) (defun Info-find-index-name (name)
"Move point to the place within the current node where NAME is defined." "Move point to the place within the current node where NAME is defined."

11
lisp/isearch.el
View file

@ -233,6 +233,7 @@ called with the positions of the start and the end of the text
matched by Isearch and replace commands. If this function matched by Isearch and replace commands. If this function
returns nil, Isearch and replace commands will continue searching returns nil, Isearch and replace commands will continue searching
without stopping at resp. replacing this match. without stopping at resp. replacing this match.
This function is expected to be careful not to clobber the match data.
If you use `add-function' to modify this variable, you can use the If you use `add-function' to modify this variable, you can use the
`isearch-message-prefix' advice property to specify the prefix string `isearch-message-prefix' advice property to specify the prefix string
@ -3529,11 +3530,14 @@ Optional third argument, if t, means if fail just return nil (no error).
;; Clear RETRY unless the search predicate says ;; Clear RETRY unless the search predicate says
;; to skip this search hit. ;; to skip this search hit.
(if (or (not isearch-success) (if (or (not isearch-success)
(bobp) (eobp)
(= (match-beginning 0) (match-end 0))
(funcall isearch-filter-predicate (funcall isearch-filter-predicate
(match-beginning 0) (match-end 0))) (match-beginning 0) (match-end 0)))
(setq retry nil))) (setq retry nil)
;; Advance point on empty matches before retrying
(when (= (match-beginning 0) (match-end 0))
(if (if isearch-forward (eobp) (bobp))
(setq retry nil isearch-success nil)
(forward-char (if isearch-forward 1 -1))))))
(setq isearch-just-started nil) (setq isearch-just-started nil)
(when isearch-success (when isearch-success
(setq isearch-other-end (setq isearch-other-end
@ -4044,7 +4048,6 @@ Attempt to do the search exactly the way the pending Isearch would."
;; Clear RETRY unless the search predicate says ;; Clear RETRY unless the search predicate says
;; to skip this search hit. ;; to skip this search hit.
(if (or (not success) (if (or (not success)
(= (point) bound) ; like (bobp) (eobp) in `isearch-search'.
(= (match-beginning 0) (match-end 0)) (= (match-beginning 0) (match-end 0))
(funcall isearch-filter-predicate (funcall isearch-filter-predicate
(match-beginning 0) (match-end 0))) (match-beginning 0) (match-end 0)))

29
lisp/jka-cmpr-hook.el
View file

@ -104,6 +104,9 @@ Otherwise, it is nil.")
(defun jka-compr-info-can-append (info) (aref info 7)) (defun jka-compr-info-can-append (info) (aref info 7))
(defun jka-compr-info-strip-extension (info) (aref info 8)) (defun jka-compr-info-strip-extension (info) (aref info 8))
(defun jka-compr-info-file-magic-bytes (info) (aref info 9)) (defun jka-compr-info-file-magic-bytes (info) (aref info 9))
(defun jka-compr-info-uncompress-function (info)
(and (> (length info) 10)
(aref info 10)))
(defun jka-compr-get-compression-info (filename) (defun jka-compr-get-compression-info (filename)
@ -197,13 +200,15 @@ options through Custom does this automatically."
;;[regexp ;;[regexp
;; compr-message compr-prog compr-args ;; compr-message compr-prog compr-args
;; uncomp-message uncomp-prog uncomp-args ;; uncomp-message uncomp-prog uncomp-args
;; can-append strip-extension-flag file-magic-bytes] ;; can-append strip-extension-flag file-magic-bytes
;; uncompress-function]
(mapcar 'purecopy (mapcar 'purecopy
'(["\\.Z\\'" '(["\\.Z\\'"
"compressing" "compress" ("-c") "compressing" "compress" ("-c")
;; gzip is more common than uncompress. It can only read, not write. ;; gzip is more common than uncompress. It can only read, not write.
"uncompressing" "gzip" ("-c" "-q" "-d") "uncompressing" "gzip" ("-c" "-q" "-d")
nil t "\037\235"] nil t "\037\235"
zlib-decompress-region]
;; Formerly, these had an additional arg "-c", but that fails with ;; Formerly, these had an additional arg "-c", but that fails with
;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and
;; "Version 0.9.0b, 9-Sept-98". ;; "Version 0.9.0b, 9-Sept-98".
@ -218,11 +223,13 @@ options through Custom does this automatically."
["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'" ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'"
"compressing" "gzip" ("-c" "-q") "compressing" "gzip" ("-c" "-q")
"uncompressing" "gzip" ("-c" "-q" "-d") "uncompressing" "gzip" ("-c" "-q" "-d")
t nil "\037\213"] t nil "\037\213"
zlib-decompress-region]
["\\.g?z\\'" ["\\.g?z\\'"
"compressing" "gzip" ("-c" "-q") "compressing" "gzip" ("-c" "-q")
"uncompressing" "gzip" ("-c" "-q" "-d") "uncompressing" "gzip" ("-c" "-q" "-d")
t t "\037\213"] t t "\037\213"
zlib-decompress-region]
["\\.lz\\'" ["\\.lz\\'"
"Lzip compressing" "lzip" ("-c" "-q") "Lzip compressing" "lzip" ("-c" "-q")
"Lzip uncompressing" "lzip" ("-c" "-q" "-d") "Lzip uncompressing" "lzip" ("-c" "-q" "-d")
@ -259,7 +266,7 @@ options through Custom does this automatically."
Each element, which describes a compression technique, is a vector of Each element, which describes a compression technique, is a vector of
the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where: APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS UNCOMPRESS-FUNCTION], where:
regexp is a regexp that matches filenames that are regexp is a regexp that matches filenames that are
compressed with this format compressed with this format
@ -275,7 +282,7 @@ APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
uncompress-msg is the message to issue to the user when doing this uncompress-msg is the message to issue to the user when doing this
type of uncompression (nil means no message) type of uncompression (nil means no message)
uncompress-program is a program that performs this compression uncompress-program is a program that performs this uncompression
uncompress-args is a list of args to pass to the uncompress program uncompress-args is a list of args to pass to the uncompress program
@ -288,6 +295,9 @@ APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
file-magic-chars is a string of characters that you would find file-magic-chars is a string of characters that you would find
at the beginning of a file compressed in this way. at the beginning of a file compressed in this way.
uncompress-function is a function that performs uncompression, if
uncompress-program is not found.
If you set this outside Custom while Auto Compression mode is If you set this outside Custom while Auto Compression mode is
already enabled \(as it is by default), you have to call already enabled \(as it is by default), you have to call
`jka-compr-update' after setting it to properly update other `jka-compr-update' after setting it to properly update other
@ -309,9 +319,12 @@ variables. Setting this through Custom does that automatically."
(repeat :tag "Uncompress Arguments" string) (repeat :tag "Uncompress Arguments" string)
(boolean :tag "Append") (boolean :tag "Append")
(boolean :tag "Strip Extension") (boolean :tag "Strip Extension")
(string :tag "Magic Bytes"))) (string :tag "Magic Bytes")
(choice :tag "Uncompress Function"
(symbol)
(const :tag "None" nil))))
:set 'jka-compr-set :set 'jka-compr-set
:version "24.1" ; removed version extension piece :version "28.1" ; add uncompress-function
:group 'jka-compr) :group 'jka-compr)
(defcustom jka-compr-mode-alist-additions (defcustom jka-compr-mode-alist-additions

121
lisp/jka-compr.el
View file

@ -386,6 +386,7 @@ There should be no more than seven characters after the final `/'."
(let ((uncompress-message (jka-compr-info-uncompress-message info)) (let ((uncompress-message (jka-compr-info-uncompress-message info))
(uncompress-program (jka-compr-info-uncompress-program info)) (uncompress-program (jka-compr-info-uncompress-program info))
(uncompress-function (jka-compr-info-uncompress-function info))
(uncompress-args (jka-compr-info-uncompress-args info)) (uncompress-args (jka-compr-info-uncompress-args info))
(base-name (file-name-nondirectory filename)) (base-name (file-name-nondirectory filename))
(notfound nil) (notfound nil)
@ -409,58 +410,76 @@ There should be no more than seven characters after the final `/'."
jka-compr-verbose jka-compr-verbose
(message "%s %s..." uncompress-message base-name)) (message "%s %s..." uncompress-message base-name))
(condition-case error-code (if (and (not (executable-find uncompress-program))
uncompress-function
(fboundp uncompress-function))
;; If we don't have the uncompression program, then use the
;; internal uncompression function (if we have one).
(let ((buf (current-buffer)))
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-file-contents-literally file)
(funcall uncompress-function (point-min) (point-max))
(when end
(delete-region end (point-max)))
(when beg
(delete-region (point-min) beg))
(setq size (buffer-size))
(insert-into-buffer buf))
(goto-char (point-min)))
;; Use the external uncompression program.
(condition-case error-code
(let ((coding-system-for-read 'no-conversion)) (let ((coding-system-for-read 'no-conversion))
(if replace (if replace
(goto-char (point-min))) (goto-char (point-min)))
(setq start (point)) (setq start (point))
(if (or beg end) (if (or beg end)
(jka-compr-partial-uncompress uncompress-program (jka-compr-partial-uncompress
(concat uncompress-message uncompress-program
" " base-name) (concat uncompress-message " " base-name)
uncompress-args uncompress-args
local-file local-file
(or beg 0) (or beg 0)
(if (and beg end) (if (and beg end)
(- end beg) (- end beg)
end)) end))
;; If visiting, bind off buffer-file-name so that ;; If visiting, bind off buffer-file-name so that
;; file-locking will not ask whether we should ;; file-locking will not ask whether we should
;; really edit the buffer. ;; really edit the buffer.
(let ((buffer-file-name (let ((buffer-file-name
(if visit nil buffer-file-name))) (if visit nil buffer-file-name)))
(jka-compr-call-process uncompress-program (jka-compr-call-process uncompress-program
(concat uncompress-message (concat uncompress-message
" " base-name) " " base-name)
local-file local-file
t t
nil nil
uncompress-args))) uncompress-args)))
(setq size (- (point) start)) (setq size (- (point) start))
(if replace (if replace
(delete-region (point) (point-max))) (delete-region (point) (point-max)))
(goto-char start)) (goto-char start))
(error (error
;; If the file we wanted to uncompress does not exist, ;; If the file we wanted to uncompress does not exist,
;; handle that according to VISIT as `insert-file-contents' ;; handle that according to VISIT as `insert-file-contents'
;; would, maybe signaling the same error it normally would. ;; would, maybe signaling the same error it normally would.
(if (and (eq (car error-code) 'file-missing) (if (and (eq (car error-code) 'file-missing)
(eq (nth 3 error-code) local-file)) (eq (nth 3 error-code) local-file))
(if visit (if visit
(setq notfound error-code) (setq notfound error-code)
(signal 'file-missing (signal 'file-missing
(cons "Opening input file" (cons "Opening input file"
(nthcdr 2 error-code)))) (nthcdr 2 error-code))))
;; If the uncompression program can't be found, ;; If the uncompression program can't be found,
;; signal that as a non-file error ;; signal that as a non-file error
;; so that find-file-noselect-1 won't handle it. ;; so that find-file-noselect-1 won't handle it.
(if (and (memq 'file-error (get (car error-code) (if (and (memq 'file-error (get (car error-code)
'error-conditions)) 'error-conditions))
(equal (cadr error-code) "Searching for program")) (equal (cadr error-code) "Searching for program"))
(error "Uncompression program `%s' not found" (error "Uncompression program `%s' not found"
(nth 3 error-code))) (nth 3 error-code)))
(signal (car error-code) (cdr error-code)))))) (signal (car error-code) (cdr error-code)))))))
(and (and
local-copy local-copy

4
lisp/menu-bar.el
View file

@ -570,7 +570,9 @@
(defun clipboard-yank () (defun clipboard-yank ()
"Insert the clipboard contents, or the last stretch of killed text." "Insert the clipboard contents, or the last stretch of killed text."
(interactive "*") (interactive "*")
(let ((select-enable-clipboard t)) (let ((select-enable-clipboard t)
;; Ensure that we defeat the DWIM login in `gui-selection-value'.
(gui--last-selected-text-clipboard nil))
(yank))) (yank)))
(defun clipboard-kill-ring-save (beg end &optional region) (defun clipboard-kill-ring-save (beg end &optional region)

4
lisp/mouse.el
View file

@ -1208,7 +1208,7 @@ overlay property, the value of that property determines what to do.
for the `follow-link' event, the binding of that event determines for the `follow-link' event, the binding of that event determines
what to do. what to do.
The resulting value determine whether POS is inside a link: The resulting value determines whether POS is inside a link:
- If the value is `mouse-face', POS is inside a link if there - If the value is `mouse-face', POS is inside a link if there
is a non-nil `mouse-face' property at POS. Return t in this case. is a non-nil `mouse-face' property at POS. Return t in this case.
@ -2881,8 +2881,8 @@ is copied instead of being cut."
(set-marker (nth 2 state) nil)) (set-marker (nth 2 state) nil))
(with-current-buffer (window-buffer window) (with-current-buffer (window-buffer window)
(setq cursor-type (nth 3 state))))))) (setq cursor-type (nth 3 state)))))))
;;; Bindings for mouse commands. ;;; Bindings for mouse commands.
(global-set-key [down-mouse-1] 'mouse-drag-region) (global-set-key [down-mouse-1] 'mouse-drag-region)

41
lisp/net/shr.el
View file

@ -183,6 +183,33 @@ temporarily blinks with this face."
"Face for <abbr> elements." "Face for <abbr> elements."
:version "27.1") :version "27.1")
(defface shr-h1
'((t :height 1.3 :weight bold))
"Face for <h1> elements."
:version "28.1")
(defface shr-h2
'((t :weight bold))
"Face for <h2> elements."
:version "28.1")
(defface shr-h3
'((t :slant italic))
"Face for <h3> elements."
:version "28.1")
(defface shr-h4 nil
"Face for <h4> elements."
:version "28.1")
(defface shr-h5 nil
"Face for <h5> elements."
:version "28.1")
(defface shr-h6 nil
"Face for <h6> elements."
:version "28.1")
(defcustom shr-inhibit-images nil (defcustom shr-inhibit-images nil
"If non-nil, inhibit loading images." "If non-nil, inhibit loading images."
:version "28.1" :version "28.1"
@ -1939,24 +1966,22 @@ BASE is the URL of the HTML being rendered."
(shr-generic dom)) (shr-generic dom))
(defun shr-tag-h1 (dom) (defun shr-tag-h1 (dom)
(shr-heading dom (if shr-use-fonts (shr-heading dom 'shr-h1))
'(variable-pitch (:height 1.3 :weight bold))
'bold)))
(defun shr-tag-h2 (dom) (defun shr-tag-h2 (dom)
(shr-heading dom 'bold)) (shr-heading dom 'shr-h2))
(defun shr-tag-h3 (dom) (defun shr-tag-h3 (dom)
(shr-heading dom 'italic)) (shr-heading dom 'shr-h3))
(defun shr-tag-h4 (dom) (defun shr-tag-h4 (dom)
(shr-heading dom)) (shr-heading dom 'shr-h4))
(defun shr-tag-h5 (dom) (defun shr-tag-h5 (dom)
(shr-heading dom)) (shr-heading dom 'shr-h5))
(defun shr-tag-h6 (dom) (defun shr-tag-h6 (dom)
(shr-heading dom)) (shr-heading dom 'shr-h6))
(defun shr-tag-hr (_dom) (defun shr-tag-hr (_dom)
(shr-ensure-newline) (shr-ensure-newline)

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

@ -133,6 +133,7 @@ It is used for TCP/IP devices."
(file-exists-p . tramp-handle-file-exists-p) (file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p) (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-adb-handle-file-local-copy) (file-local-copy . tramp-adb-handle-file-local-copy)
(file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes) (file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-adb-handle-file-name-all-completions) (file-name-all-completions . tramp-adb-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory) (file-name-as-directory . tramp-handle-file-name-as-directory)
@ -159,9 +160,11 @@ It is used for TCP/IP devices."
(insert-directory . tramp-handle-insert-directory) (insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents) (insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load) (load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-adb-handle-make-directory) (make-directory . tramp-adb-handle-make-directory)
(make-directory-internal . ignore) (make-directory-internal . ignore)
(make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-adb-handle-make-process) (make-process . tramp-adb-handle-make-process)
(make-symbolic-link . tramp-handle-make-symbolic-link) (make-symbolic-link . tramp-handle-make-symbolic-link)
@ -180,6 +183,7 @@ It is used for TCP/IP devices."
(tramp-get-remote-uid . ignore) (tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore) (tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore) (unhandled-file-name-directory . ignore)
(unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore) (vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-adb-handle-write-region)) (write-region . tramp-adb-handle-write-region))
@ -535,7 +539,8 @@ But handle the case, if the \"test\" command is not available."
(defun tramp-adb-handle-write-region (defun tramp-adb-handle-write-region
(start end filename &optional append visit lockname mustbenew) (start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files." "Like `write-region' for Tramp files."
(setq filename (expand-file-name filename)) (setq filename (expand-file-name filename)
lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil (with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename) (when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl) (or (eq mustbenew 'excl)
@ -544,15 +549,26 @@ But handle the case, if the \"test\" command is not available."
(format "File %s exists; overwrite anyway? " filename))))) (format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename)) (tramp-error v 'file-already-exists filename))
(let* ((curbuf (current-buffer)) (let (file-locked
(tmpfile (tramp-compat-make-temp-file filename))) (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)))
(setq file-locked t)
;; `lock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'lock-file lockname))
(when (and append (file-exists-p filename)) (when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok) (copy-file filename tmpfile 'ok)
(set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600))) (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
(write-region start end tmpfile append 'no-message lockname) (let (create-lockfiles)
(write-region start end tmpfile append 'no-message))
(with-tramp-progress-reporter (with-tramp-progress-reporter
v 3 (format-message v 3 (format-message
"Moving tmp file `%s' to `%s'" tmpfile filename) "Moving tmp file `%s' to `%s'" tmpfile filename)
(unwind-protect (unwind-protect
(unless (tramp-adb-execute-adb-command (unless (tramp-adb-execute-adb-command
v "push" tmpfile (tramp-compat-file-name-unquote localname)) v "push" tmpfile (tramp-compat-file-name-unquote localname))
@ -575,6 +591,11 @@ But handle the case, if the \"test\" command is not available."
(file-attributes filename)) (file-attributes filename))
(current-time)))) (current-time))))
;; Unlock file.
(when (and file-locked (eq (file-locked-p lockname) t))
;; `unlock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'unlock-file lockname))
;; The end. ;; The end.
(when (and (null noninteractive) (when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit))) (or (eq visit t) (null visit) (stringp visit)))
@ -782,7 +803,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (and (numberp destination) (zerop destination)) (when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return")) (error "Implementation does not handle immediate return"))
(with-parsed-tramp-file-name default-directory nil (with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let (command input tmpinput stderr tmpstderr outbuf ret) (let (command input tmpinput stderr tmpstderr outbuf ret)
;; Compute command. ;; Compute command.
(setq command (mapconcat #'tramp-shell-quote-argument (setq command (mapconcat #'tramp-shell-quote-argument

4
lisp/net/tramp-archive.el
View file

@ -236,6 +236,7 @@ It must be supported by libarchive(3).")
(file-exists-p . tramp-handle-file-exists-p) (file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p) (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-archive-handle-file-local-copy) (file-local-copy . tramp-archive-handle-file-local-copy)
(file-locked-p . ignore)
(file-modes . tramp-handle-file-modes) (file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-archive-handle-file-name-all-completions) (file-name-all-completions . tramp-archive-handle-file-name-all-completions)
;; `file-name-as-directory' performed by default handler. ;; `file-name-as-directory' performed by default handler.
@ -262,9 +263,11 @@ It must be supported by libarchive(3).")
(insert-directory . tramp-archive-handle-insert-directory) (insert-directory . tramp-archive-handle-insert-directory)
(insert-file-contents . tramp-archive-handle-insert-file-contents) (insert-file-contents . tramp-archive-handle-insert-file-contents)
(load . tramp-archive-handle-load) (load . tramp-archive-handle-load)
(lock-file . ignore)
(make-auto-save-file-name . ignore) (make-auto-save-file-name . ignore)
(make-directory . tramp-archive-handle-not-implemented) (make-directory . tramp-archive-handle-not-implemented)
(make-directory-internal . tramp-archive-handle-not-implemented) (make-directory-internal . tramp-archive-handle-not-implemented)
(make-lock-file-name . ignore)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore) (make-process . ignore)
(make-symbolic-link . tramp-archive-handle-not-implemented) (make-symbolic-link . tramp-archive-handle-not-implemented)
@ -283,6 +286,7 @@ It must be supported by libarchive(3).")
(tramp-get-remote-uid . ignore) (tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore) (tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore) (unhandled-file-name-directory . ignore)
(unlock-file . ignore)
(vc-registered . ignore) (vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-archive-handle-not-implemented)) (write-region . tramp-archive-handle-not-implemented))

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

@ -49,6 +49,8 @@
;; an open connection. Examples: "scripts" keeps shell script ;; an open connection. Examples: "scripts" keeps shell script
;; definitions already sent to the remote shell, "last-cmd-time" is ;; definitions already sent to the remote shell, "last-cmd-time" is
;; the time stamp a command has been sent to the remote process. ;; the time stamp a command has been sent to the remote process.
;; "lock-pid" is the timestamp a (network) process is created, it is
;; used instead of the pid in file locks.
;; ;;
;; - The key is nil. These are temporary properties related to the ;; - The key is nil. These are temporary properties related to the
;; local machine. Examples: "parse-passwd" and "parse-group" keep ;; local machine. Examples: "parse-passwd" and "parse-group" keep

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

@ -353,6 +353,16 @@ A nil value for either argument stands for the current time."
(lambda (fromstring tostring instring) (lambda (fromstring tostring instring)
(replace-regexp-in-string (regexp-quote fromstring) tostring instring)))) (replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
;; Function `make-lock-file-name' is new in Emacs 28.1.
(defalias 'tramp-compat-make-lock-file-name
(if (fboundp 'make-lock-file-name)
#'make-lock-file-name
(lambda (filename)
(expand-file-name
(concat
".#" (file-name-nondirectory filename))
(file-name-directory filename)))))
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp)) (dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
(put (intern elt) 'tramp-suppress-trace t)) (put (intern elt) 'tramp-suppress-trace t))

23
lisp/net/tramp-crypt.el
View file

@ -182,6 +182,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
(file-exists-p . tramp-handle-file-exists-p) (file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p) (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy) (file-local-copy . tramp-handle-file-local-copy)
(file-locked-p . tramp-crypt-handle-file-locked-p)
(file-modes . tramp-handle-file-modes) (file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-crypt-handle-file-name-all-completions) (file-name-all-completions . tramp-crypt-handle-file-name-all-completions)
;; `file-name-as-directory' performed by default handler. ;; `file-name-as-directory' performed by default handler.
@ -208,9 +209,11 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
(insert-directory . tramp-crypt-handle-insert-directory) (insert-directory . tramp-crypt-handle-insert-directory)
;; `insert-file-contents' performed by default handler. ;; `insert-file-contents' performed by default handler.
(load . tramp-handle-load) (load . tramp-handle-load)
(lock-file . tramp-crypt-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-crypt-handle-make-directory) (make-directory . tramp-crypt-handle-make-directory)
(make-directory-internal . ignore) (make-directory-internal . ignore)
(make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore) (make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link) (make-symbolic-link . tramp-handle-make-symbolic-link)
@ -229,6 +232,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
;; `tramp-get-remote-uid' performed by default handler. ;; `tramp-get-remote-uid' performed by default handler.
(tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid) (tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore) (unhandled-file-name-directory . ignore)
(unlock-file . tramp-crypt-handle-unlock-file)
(vc-registered . ignore) (vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-handle-write-region)) (write-region . tramp-handle-write-region))
@ -734,6 +738,11 @@ absolute file names."
(let (tramp-crypt-enabled) (let (tramp-crypt-enabled)
(file-executable-p (tramp-crypt-encrypt-file-name filename)))) (file-executable-p (tramp-crypt-encrypt-file-name filename))))
(defun tramp-crypt-handle-file-locked-p (filename)
"Like `file-locked-p' for Tramp files."
(let (tramp-crypt-enabled)
(file-locked-p (tramp-crypt-encrypt-file-name filename))))
(defun tramp-crypt-handle-file-name-all-completions (filename directory) (defun tramp-crypt-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(all-completions (all-completions
@ -797,6 +806,13 @@ WILDCARD is not supported."
(delete-region (prop-match-beginning match) (prop-match-end match)) (delete-region (prop-match-beginning match) (prop-match-end match))
(insert (propertize string 'dired-filename t))))))) (insert (propertize string 'dired-filename t)))))))
(defun tramp-crypt-handle-lock-file (filename)
"Like `lock-file' for Tramp files."
(let (tramp-crypt-enabled)
;; `lock-file' exists since Emacs 28.1.
(tramp-compat-funcall
'lock-file (tramp-crypt-encrypt-file-name filename))))
(defun tramp-crypt-handle-make-directory (dir &optional parents) (defun tramp-crypt-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files." "Like `make-directory' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name dir) nil (with-parsed-tramp-file-name (expand-file-name dir) nil
@ -848,6 +864,13 @@ WILDCARD is not supported."
(tramp-set-file-uid-gid (tramp-set-file-uid-gid
(tramp-crypt-encrypt-file-name filename) uid gid)))) (tramp-crypt-encrypt-file-name filename) uid gid))))
(defun tramp-crypt-handle-unlock-file (filename)
"Like `unlock-file' for Tramp files."
(let (tramp-crypt-enabled)
;; `unlock-file' exists since Emacs 28.1.
(tramp-compat-funcall
'unlock-file (tramp-crypt-encrypt-file-name filename))))
(add-hook 'tramp-unload-hook (add-hook 'tramp-unload-hook
(lambda () (lambda ()
(unload-feature 'tramp-crypt 'force))) (unload-feature 'tramp-crypt 'force)))

17
lisp/net/tramp-fuse.el
View file

@ -164,10 +164,9 @@
(or (tramp-get-connection-property (or (tramp-get-connection-property
(tramp-get-connection-process vec) "mounted" nil) (tramp-get-connection-process vec) "mounted" nil)
(let* ((default-directory (tramp-compat-temporary-file-directory)) (let* ((default-directory (tramp-compat-temporary-file-directory))
(fuse (concat "fuse." (tramp-file-name-method vec))) (command (format "mount -t fuse.%s" (tramp-file-name-method vec)))
(mount (shell-command-to-string (format "mount -t %s" fuse)))) (mount (shell-command-to-string command)))
(tramp-message vec 6 "%s %s" "mount -t" fuse) (tramp-message vec 6 "%s\n%s" command mount)
(tramp-message vec 6 "\n%s" mount)
(tramp-set-connection-property (tramp-set-connection-property
(tramp-get-connection-process vec) "mounted" (tramp-get-connection-process vec) "mounted"
(when (string-match (when (string-match
@ -176,6 +175,16 @@
mount) mount)
(match-string 1 mount))))))) (match-string 1 mount)))))))
(defun tramp-fuse-unmount (vec)
"Unmount fuse volume determined by VEC."
(let ((default-directory (tramp-compat-temporary-file-directory))
(command (format "fusermount3 -u %s" (tramp-fuse-mount-point vec))))
(tramp-message vec 6 "%s\n%s" command (shell-command-to-string command))
(tramp-flush-connection-property
(tramp-get-connection-process vec) "mounted")
;; Give the caches a chance to expire.
(sleep-for 1)))
(defun tramp-fuse-local-file-name (filename) (defun tramp-fuse-local-file-name (filename)
"Return local mount name of FILENAME." "Return local mount name of FILENAME."
(setq filename (tramp-compat-file-name-unquote (expand-file-name filename))) (setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))

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

@ -774,6 +774,7 @@ It has been changed in GVFS 1.14.")
(file-exists-p . tramp-handle-file-exists-p) (file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p) (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy) (file-local-copy . tramp-handle-file-local-copy)
(file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes) (file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-gvfs-handle-file-name-all-completions) (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory) (file-name-as-directory . tramp-handle-file-name-as-directory)
@ -800,9 +801,11 @@ It has been changed in GVFS 1.14.")
(insert-directory . tramp-handle-insert-directory) (insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents) (insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load) (load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-gvfs-handle-make-directory) (make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore) (make-directory-internal . ignore)
(make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore) (make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link) (make-symbolic-link . tramp-handle-make-symbolic-link)
@ -821,6 +824,7 @@ It has been changed in GVFS 1.14.")
(tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid) (tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid) (tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore) (unhandled-file-name-directory . ignore)
(unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore) (vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-handle-write-region)) (write-region . tramp-handle-write-region))
@ -2144,6 +2148,9 @@ connection if a previous connection has died for some reason."
(process-put p 'vector vec) (process-put p 'vector vec)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
;; Mark process for filelock.
(tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
;; Set connection-local variables. ;; Set connection-local variables.
(tramp-set-connection-local-variables vec))) (tramp-set-connection-local-variables vec)))

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

@ -96,6 +96,7 @@
(file-exists-p . tramp-handle-file-exists-p) (file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p) (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy) (file-local-copy . tramp-handle-file-local-copy)
(file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes) (file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-fuse-handle-file-name-all-completions) (file-name-all-completions . tramp-fuse-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory) (file-name-as-directory . tramp-handle-file-name-as-directory)
@ -122,9 +123,11 @@
(insert-directory . tramp-handle-insert-directory) (insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents) (insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load) (load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-fuse-handle-make-directory) (make-directory . tramp-fuse-handle-make-directory)
(make-directory-internal . ignore) (make-directory-internal . ignore)
(make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore) (make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link) (make-symbolic-link . tramp-handle-make-symbolic-link)
@ -143,6 +146,7 @@
(tramp-get-remote-uid . ignore) (tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore) (tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore) (unhandled-file-name-directory . ignore)
(unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore) (vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-handle-write-region)) (write-region . tramp-handle-write-region))
@ -358,6 +362,10 @@ connection if a previous connection has died for some reason."
(process-put p 'vector vec) (process-put p 'vector vec)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
;; Mark process for filelock.
(tramp-set-connection-property
p "lock-pid" (truncate (time-to-seconds)))
;; Set connection-local variables. ;; Set connection-local variables.
(tramp-set-connection-local-variables vec))) (tramp-set-connection-local-variables vec)))

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

@ -962,6 +962,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
(file-exists-p . tramp-sh-handle-file-exists-p) (file-exists-p . tramp-sh-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p) (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-sh-handle-file-local-copy) (file-local-copy . tramp-sh-handle-file-local-copy)
(file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes) (file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-sh-handle-file-name-all-completions) (file-name-all-completions . tramp-sh-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory) (file-name-as-directory . tramp-handle-file-name-as-directory)
@ -988,9 +989,11 @@ Format specifiers \"%s\" are replaced before the script is used.")
(insert-directory . tramp-sh-handle-insert-directory) (insert-directory . tramp-sh-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents) (insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load) (load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sh-handle-make-directory) (make-directory . tramp-sh-handle-make-directory)
;; `make-directory-internal' performed by default handler. ;; `make-directory-internal' performed by default handler.
(make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-sh-handle-make-process) (make-process . tramp-sh-handle-make-process)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link) (make-symbolic-link . tramp-sh-handle-make-symbolic-link)
@ -1009,6 +1012,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
(tramp-get-remote-uid . tramp-sh-handle-get-remote-uid) (tramp-get-remote-uid . tramp-sh-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid) (tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore) (unhandled-file-name-directory . ignore)
(unlock-file . tramp-handle-unlock-file)
(vc-registered . tramp-sh-handle-vc-registered) (vc-registered . tramp-sh-handle-vc-registered)
(verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime) (verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime)
(write-region . tramp-sh-handle-write-region)) (write-region . tramp-sh-handle-write-region))
@ -3025,7 +3029,7 @@ implementation will be used."
(when (and (numberp destination) (zerop destination)) (when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return")) (error "Implementation does not handle immediate return"))
(with-parsed-tramp-file-name default-directory nil (with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let (command env uenv input tmpinput stderr tmpstderr outbuf ret) (let (command env uenv input tmpinput stderr tmpstderr outbuf ret)
;; Compute command. ;; Compute command.
(setq command (mapconcat #'tramp-shell-quote-argument (setq command (mapconcat #'tramp-shell-quote-argument
@ -3235,7 +3239,8 @@ implementation will be used."
(defun tramp-sh-handle-write-region (defun tramp-sh-handle-write-region
(start end filename &optional append visit lockname mustbenew) (start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files." "Like `write-region' for Tramp files."
(setq filename (expand-file-name filename)) (setq filename (expand-file-name filename)
lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil (with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename) (when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl) (or (eq mustbenew 'excl)
@ -3244,23 +3249,31 @@ implementation will be used."
(format "File %s exists; overwrite anyway? " filename))))) (format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename)) (tramp-error v 'file-already-exists filename))
(let ((uid (or (tramp-compat-file-attribute-user-id (let (file-locked
(uid (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer)) (file-attributes filename 'integer))
(tramp-get-remote-uid v 'integer))) (tramp-get-remote-uid v 'integer)))
(gid (or (tramp-compat-file-attribute-group-id (gid (or (tramp-compat-file-attribute-group-id
(file-attributes filename 'integer)) (file-attributes filename 'integer))
(tramp-get-remote-gid v 'integer)))) (tramp-get-remote-gid v 'integer))))
;; 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)))
(setq file-locked t)
;; `lock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'lock-file lockname))
(if (and (tramp-local-host-p v) (if (and (tramp-local-host-p v)
;; `file-writable-p' calls `file-expand-file-name'. We ;; `file-writable-p' calls `file-expand-file-name'. We
;; cannot use `tramp-run-real-handler' therefore. ;; cannot use `tramp-run-real-handler' therefore.
(let (file-name-handler-alist) (file-writable-p (file-name-directory localname))
(and (or (file-directory-p localname)
(file-writable-p (file-name-directory localname)) (file-writable-p localname)))
(or (file-directory-p localname)
(file-writable-p localname)))))
;; Short track: if we are on the local host, we can run directly. ;; Short track: if we are on the local host, we can run directly.
(write-region start end localname append 'no-message lockname) (let ((create-lockfiles (not file-locked)))
(write-region start end localname append 'no-message lockname))
(let* ((modes (tramp-default-file-modes (let* ((modes (tramp-default-file-modes
filename (and (eq mustbenew 'excl) 'nofollow))) filename (and (eq mustbenew 'excl) 'nofollow)))
@ -3294,9 +3307,10 @@ implementation will be used."
;; on. We must ensure that `file-coding-system-alist' ;; on. We must ensure that `file-coding-system-alist'
;; matches `tmpfile'. ;; matches `tmpfile'.
(let ((file-coding-system-alist (let ((file-coding-system-alist
(tramp-find-file-name-coding-system-alist filename tmpfile))) (tramp-find-file-name-coding-system-alist filename tmpfile))
create-lockfiles)
(condition-case err (condition-case err
(write-region start end tmpfile append 'no-message lockname) (write-region start end tmpfile append 'no-message)
((error quit) ((error quit)
(setq tramp-temp-buffer-file-name nil) (setq tramp-temp-buffer-file-name nil)
(delete-file tmpfile) (delete-file tmpfile)
@ -3465,6 +3479,12 @@ implementation will be used."
;; Set the ownership. ;; Set the ownership.
(when need-chown (when need-chown
(tramp-set-file-uid-gid filename uid gid)) (tramp-set-file-uid-gid filename uid gid))
;; Unlock file.
(when (and file-locked (eq (file-locked-p lockname) t))
;; `unlock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'unlock-file lockname))
(when (and (null noninteractive) (when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit))) (or (eq visit t) (null visit) (stringp visit)))
(tramp-message v 0 "Wrote %s" filename)) (tramp-message v 0 "Wrote %s" filename))

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

@ -247,6 +247,7 @@ See `tramp-actions-before-shell' for more info.")
(file-exists-p . tramp-handle-file-exists-p) (file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p) (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-smb-handle-file-local-copy) (file-local-copy . tramp-smb-handle-file-local-copy)
(file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes) (file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-smb-handle-file-name-all-completions) (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory) (file-name-as-directory . tramp-handle-file-name-as-directory)
@ -273,9 +274,11 @@ See `tramp-actions-before-shell' for more info.")
(insert-directory . tramp-smb-handle-insert-directory) (insert-directory . tramp-smb-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents) (insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load) (load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-smb-handle-make-directory) (make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . tramp-smb-handle-make-directory-internal) (make-directory-internal . tramp-smb-handle-make-directory-internal)
(make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore) (make-process . ignore)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link) (make-symbolic-link . tramp-smb-handle-make-symbolic-link)
@ -294,6 +297,7 @@ See `tramp-actions-before-shell' for more info.")
(tramp-get-remote-uid . ignore) (tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore) (tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore) (unhandled-file-name-directory . ignore)
(unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore) (vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-smb-handle-write-region)) (write-region . tramp-smb-handle-write-region))
@ -532,7 +536,7 @@ arguments to pass to the OPERATION."
(tramp-process-actions p v nil tramp-smb-actions-with-tar) (tramp-process-actions p v nil tramp-smb-actions-with-tar)
(while (process-live-p p) (while (process-live-p p)
(sit-for 0.1)) (sleep-for 0.1))
(tramp-message v 6 "\n%s" (buffer-string)))) (tramp-message v 6 "\n%s" (buffer-string))))
;; Reset the transfer process properties. ;; Reset the transfer process properties.
@ -1255,7 +1259,7 @@ component is used as the target of the symlink."
(when (and (numberp destination) (zerop destination)) (when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return")) (error "Implementation does not handle immediate return"))
(with-parsed-tramp-file-name default-directory nil (with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let* ((name (file-name-nondirectory program)) (let* ((name (file-name-nondirectory program))
(name1 name) (name1 name)
(i 0) (i 0)
@ -1575,7 +1579,8 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(defun tramp-smb-handle-write-region (defun tramp-smb-handle-write-region
(start end filename &optional append visit lockname mustbenew) (start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files." "Like `write-region' for Tramp files."
(setq filename (expand-file-name filename)) (setq filename (expand-file-name filename)
lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil (with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename) (when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl) (or (eq mustbenew 'excl)
@ -1584,15 +1589,25 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(format "File %s exists; overwrite anyway? " filename))))) (format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename)) (tramp-error v 'file-already-exists filename))
(let ((curbuf (current-buffer)) (let (file-locked
(curbuf (current-buffer))
(tmpfile (tramp-compat-make-temp-file filename))) (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)))
(setq file-locked t)
;; `lock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'lock-file lockname))
(when (and append (file-exists-p filename)) (when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok)) (copy-file filename tmpfile 'ok))
;; We say `no-message' here because we don't want the visited file ;; We say `no-message' here because we don't want the visited file
;; modtime data to be clobbered from the temp file. We call ;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on. ;; `set-visited-file-modtime' ourselves later on.
(tramp-run-real-handler (let (create-lockfiles)
#'write-region (list start end tmpfile append 'no-message lockname)) (write-region start end tmpfile append 'no-message))
(with-tramp-progress-reporter (with-tramp-progress-reporter
v 3 (format "Moving tmp file %s to %s" tmpfile filename) v 3 (format "Moving tmp file %s to %s" tmpfile filename)
@ -1619,6 +1634,11 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(file-attributes filename)) (file-attributes filename))
(current-time)))) (current-time))))
;; Unlock file.
(when (and file-locked (eq (file-locked-p lockname) t))
;; `unlock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'unlock-file lockname))
;; The end. ;; The end.
(when (and (null noninteractive) (when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit))) (or (eq visit t) (null visit) (stringp visit)))

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

@ -96,6 +96,7 @@
(file-exists-p . tramp-handle-file-exists-p) (file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p) (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy) (file-local-copy . tramp-handle-file-local-copy)
(file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes) (file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-fuse-handle-file-name-all-completions) (file-name-all-completions . tramp-fuse-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory) (file-name-as-directory . tramp-handle-file-name-as-directory)
@ -122,9 +123,11 @@
(insert-directory . tramp-handle-insert-directory) (insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-sshfs-handle-insert-file-contents) (insert-file-contents . tramp-sshfs-handle-insert-file-contents)
(load . tramp-handle-load) (load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-fuse-handle-make-directory) (make-directory . tramp-fuse-handle-make-directory)
(make-directory-internal . ignore) (make-directory-internal . ignore)
(make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-handle-make-process) (make-process . tramp-handle-make-process)
(make-symbolic-link . tramp-handle-make-symbolic-link) (make-symbolic-link . tramp-handle-make-symbolic-link)
@ -143,6 +146,7 @@
(tramp-get-remote-uid . ignore) (tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore) (tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore) (unhandled-file-name-directory . ignore)
(unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore) (vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-sshfs-handle-write-region)) (write-region . tramp-sshfs-handle-write-region))
@ -231,7 +235,7 @@ arguments to pass to the OPERATION."
(when (and (numberp destination) (zerop destination)) (when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return")) (error "Implementation does not handle immediate return"))
(with-parsed-tramp-file-name default-directory nil (with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((command (let ((command
(format (format
"cd %s && exec %s" "cd %s && exec %s"
@ -281,7 +285,8 @@ arguments to pass to the OPERATION."
(defun tramp-sshfs-handle-write-region (defun tramp-sshfs-handle-write-region
(start end filename &optional append visit lockname mustbenew) (start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files." "Like `write-region' for Tramp files."
(setq filename (expand-file-name filename)) (setq filename (expand-file-name filename)
lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil (with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename) (when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl) (or (eq mustbenew 'excl)
@ -290,15 +295,31 @@ arguments to pass to the OPERATION."
(format "File %s exists; overwrite anyway? " filename))))) (format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename)) (tramp-error v 'file-already-exists filename))
(write-region (let (file-locked)
start end (tramp-fuse-local-file-name filename) append 'nomessage lockname)
(tramp-flush-file-properties v localname)
;; The end. ;; Lock file.
(when (and (null noninteractive) (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
(or (eq visit t) (null visit) (stringp visit))) (file-remote-p lockname)
(tramp-message v 0 "Wrote %s" filename)) (not (eq (file-locked-p lockname) t)))
(run-hooks 'tramp-handle-write-region-hook))) (setq file-locked t)
;; `lock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'lock-file lockname))
(let (create-lockfiles)
(write-region
start end (tramp-fuse-local-file-name filename) append 'nomessage)
(tramp-flush-file-properties v localname))
;; Unlock file.
(when (and file-locked (eq (file-locked-p lockname) t))
;; `unlock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'unlock-file lockname))
;; The end.
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))
;; File name conversions. ;; File name conversions.
@ -321,6 +342,9 @@ connection if a previous connection has died for some reason."
(process-put p 'vector vec) (process-put p 'vector vec)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
;; Mark process for filelock.
(tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
;; Set connection-local variables. ;; Set connection-local variables.
(tramp-set-connection-local-variables vec) (tramp-set-connection-local-variables vec)

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

@ -88,6 +88,7 @@ See `tramp-actions-before-shell' for more info.")
(file-exists-p . tramp-sudoedit-handle-file-exists-p) (file-exists-p . tramp-sudoedit-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p) (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy) (file-local-copy . tramp-handle-file-local-copy)
(file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes) (file-modes . tramp-handle-file-modes)
(file-name-all-completions (file-name-all-completions
. tramp-sudoedit-handle-file-name-all-completions) . tramp-sudoedit-handle-file-name-all-completions)
@ -115,9 +116,11 @@ See `tramp-actions-before-shell' for more info.")
(insert-directory . tramp-handle-insert-directory) (insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents) (insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load) (load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sudoedit-handle-make-directory) (make-directory . tramp-sudoedit-handle-make-directory)
(make-directory-internal . ignore) (make-directory-internal . ignore)
(make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore) (make-process . ignore)
(make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link) (make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link)
@ -136,6 +139,7 @@ See `tramp-actions-before-shell' for more info.")
(tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid) (tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid) (tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore) (unhandled-file-name-directory . ignore)
(unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore) (vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-sudoedit-handle-write-region)) (write-region . tramp-sudoedit-handle-write-region))
@ -713,6 +717,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sudoedit-handle-write-region (defun tramp-sudoedit-handle-write-region
(start end filename &optional append visit lockname mustbenew) (start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files." "Like `write-region' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil (with-parsed-tramp-file-name filename nil
(let* ((uid (or (tramp-compat-file-attribute-user-id (let* ((uid (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer)) (file-attributes filename 'integer))
@ -776,6 +781,9 @@ connection if a previous connection has died for some reason."
(process-put p 'vector vec) (process-put p 'vector vec)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
;; Mark process for filelock.
(tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
;; Set connection-local variables. ;; Set connection-local variables.
(tramp-set-connection-local-variables vec) (tramp-set-connection-local-variables vec)

133
lisp/net/tramp.el
View file

@ -2455,6 +2455,8 @@ Must be handled by the callers."
file-name-case-insensitive-p file-name-case-insensitive-p
;; Emacs 27+ only. ;; Emacs 27+ only.
file-system-info file-system-info
;; Emacs 28+ only.
file-locked-p lock-file make-lock-file-name unlock-file
;; Tramp internal magic file name function. ;; Tramp internal magic file name function.
tramp-set-file-uid-gid)) tramp-set-file-uid-gid))
(if (file-name-absolute-p (nth 0 args)) (if (file-name-absolute-p (nth 0 args))
@ -3628,7 +3630,7 @@ User is always nil."
(file-writable-p (file-name-directory filename))))))) (file-writable-p (file-name-directory filename)))))))
(defcustom tramp-allow-unsafe-temporary-files nil (defcustom tramp-allow-unsafe-temporary-files nil
"Whether root-owned auto-save or backup files can be written to \"/tmp\"." "Whether root-owned auto-save, backup or lock files can be written to \"/tmp\"."
:version "28.1" :version "28.1"
:type 'boolean) :type 'boolean)
@ -3816,6 +3818,100 @@ User is always nil."
;; Result. ;; Result.
(cons (expand-file-name filename) (cdr result))))) (cons (expand-file-name filename) (cdr result)))))
(defun tramp-get-lock-file (file)
"Read lockfile info of FILE.
Return nil when there is no lockfile."
(when-let ((lockname (tramp-compat-make-lock-file-name file)))
(or (file-symlink-p lockname)
(and (file-readable-p lockname)
(with-temp-buffer
(insert-file-contents-literally lockname)
(buffer-string))))))
(defun tramp-get-lock-pid (file)
"Determine pid for lockfile of FILE."
;; Some Tramp methods do not offer a connection process, but just a
;; network process as a place holder. Those processes use the
;; "lock-pid" connection property as fake pid, in fact it is the
;; time stamp the process is created.
(let ((p (tramp-get-process (tramp-dissect-file-name file))))
(number-to-string
(or (process-id p)
(tramp-get-connection-property p "lock-pid" (emacs-pid))))))
(defconst tramp-lock-file-info-regexp
;; USER@HOST.PID[:BOOT_TIME]
"\\`\\(.+\\)@\\(.+\\)\\.\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\'"
"The format of a lock file.")
(defun tramp-handle-file-locked-p (file)
"Like `file-locked-p' for Tramp files."
(when-let ((info (tramp-get-lock-file file))
(match (string-match tramp-lock-file-info-regexp info)))
(or (and (string-equal (match-string 1 info) (user-login-name))
(string-equal (match-string 2 info) (system-name))
(string-equal (match-string 3 info) (tramp-get-lock-pid file)))
(match-string 1 info))))
(defun tramp-handle-lock-file (file)
"Like `lock-file' for Tramp files."
;; See if this file is visited and has changed on disk since it
;; was visited.
(catch 'dont-lock
(unless (eq (file-locked-p file) t) ;; Locked by me.
(when-let ((info (tramp-get-lock-file file))
(match (string-match tramp-lock-file-info-regexp info)))
(unless (ask-user-about-lock
file (format
"%s@%s (pid %s)" (match-string 1 info)
(match-string 2 info) (match-string 3 info)))
(throw 'dont-lock nil)))
(when-let ((lockname (tramp-compat-make-lock-file-name file))
;; USER@HOST.PID[:BOOT_TIME]
(info
(format
"%s@%s.%s" (user-login-name) (system-name)
(tramp-get-lock-pid file))))
;; Protect against security hole.
(with-parsed-tramp-file-name file nil
(when (and (not tramp-allow-unsafe-temporary-files)
(file-in-directory-p lockname temporary-file-directory)
(zerop (or (tramp-compat-file-attribute-user-id
(file-attributes file 'integer))
tramp-unknown-id-integer))
(not (with-tramp-connection-property
(tramp-get-process v) "unsafe-temporary-file"
(yes-or-no-p
(concat
"Lock file on local temporary directory, "
"do you want to continue? ")))))
(tramp-error v 'file-error "Unsafe lock file name")))
;; Do the lock.
(let (create-lockfiles signal-hook-function)
(condition-case nil
(make-symbolic-link info lockname 'ok-if-already-exists)
(error
(with-file-modes #o0644
(write-region info nil lockname)))))))))
(defun tramp-handle-make-lock-file-name (file)
"Like `make-lock-file-name' for Tramp files."
(and create-lockfiles
;; This variable has been introduced with Emacs 28.1.
(not (bound-and-true-p remote-file-name-inhibit-locks))
(tramp-run-real-handler 'make-lock-file-name (list file))))
(defun tramp-handle-unlock-file (file)
"Like `unlock-file' for Tramp files."
(when-let ((lockname (tramp-compat-make-lock-file-name file)))
(condition-case err
(delete-file lockname)
;; `userlock--handle-unlock-error' exists since Emacs 28.1.
(error (tramp-compat-funcall 'userlock--handle-unlock-error err)))))
(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
"Like `load' for Tramp files." "Like `load' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name file) nil (with-parsed-tramp-file-name (expand-file-name file) nil
@ -4357,7 +4453,8 @@ of."
(defun tramp-handle-write-region (defun tramp-handle-write-region
(start end filename &optional append visit lockname mustbenew) (start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files." "Like `write-region' for Tramp files."
(setq filename (expand-file-name filename)) (setq filename (expand-file-name filename)
lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil (with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename) (when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl) (or (eq mustbenew 'excl)
@ -4366,7 +4463,8 @@ of."
(format "File %s exists; overwrite anyway? " filename))))) (format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename)) (tramp-error v 'file-already-exists filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)) (let (file-locked
(tmpfile (tramp-compat-make-temp-file filename))
(modes (tramp-default-file-modes (modes (tramp-default-file-modes
filename (and (eq mustbenew 'excl) 'nofollow))) filename (and (eq mustbenew 'excl) 'nofollow)))
(uid (or (tramp-compat-file-attribute-user-id (uid (or (tramp-compat-file-attribute-user-id
@ -4375,6 +4473,15 @@ of."
(gid (or (tramp-compat-file-attribute-group-id (gid (or (tramp-compat-file-attribute-group-id
(file-attributes filename 'integer)) (file-attributes filename 'integer))
(tramp-get-remote-gid v 'integer)))) (tramp-get-remote-gid v 'integer))))
;; 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)))
(setq file-locked t)
;; `lock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'lock-file lockname))
(when (and append (file-exists-p filename)) (when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok)) (copy-file filename tmpfile 'ok))
;; The permissions of the temporary file should be set. If ;; The permissions of the temporary file should be set. If
@ -4386,7 +4493,8 @@ of."
;; We say `no-message' here because we don't want the visited file ;; We say `no-message' here because we don't want the visited file
;; modtime data to be clobbered from the temp file. We call ;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on. ;; `set-visited-file-modtime' ourselves later on.
(write-region start end tmpfile append 'no-message lockname) (let (create-lockfiles)
(write-region start end tmpfile append 'no-message))
(condition-case nil (condition-case nil
(rename-file tmpfile filename 'ok-if-already-exists) (rename-file tmpfile filename 'ok-if-already-exists)
(error (error
@ -4404,13 +4512,18 @@ of."
(current-time)))) (current-time))))
;; Set the ownership. ;; Set the ownership.
(tramp-set-file-uid-gid filename uid gid)) (tramp-set-file-uid-gid filename uid gid)
;; The end. ;; Unlock file.
(when (and (null noninteractive) (when (and file-locked (eq (file-locked-p lockname) t))
(or (eq visit t) (null visit) (stringp visit))) ;; `unlock-file' exists since Emacs 28.1.
(tramp-message v 0 "Wrote %s" filename)) (tramp-compat-funcall 'unlock-file lockname))
(run-hooks 'tramp-handle-write-region-hook)))
;; The end.
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))
;; This is used in tramp-sh.el and tramp-sudoedit.el. ;; This is used in tramp-sh.el and tramp-sudoedit.el.
(defconst tramp-stat-marker "/////" (defconst tramp-stat-marker "/////"

1
lisp/outline.el
View file

@ -182,7 +182,6 @@ in the file it applies to.")
;; Only takes effect if point is on a heading. ;; Only takes effect if point is on a heading.
:filter ,(lambda (cmd) :filter ,(lambda (cmd)
(when (outline-on-heading-p) cmd))))) (when (outline-on-heading-p) cmd)))))
(define-key map [tab] tab-binding)
(define-key map (kbd "TAB") tab-binding) (define-key map (kbd "TAB") tab-binding)
(define-key map (kbd "<backtab>") #'outline-cycle-buffer)) (define-key map (kbd "<backtab>") #'outline-cycle-buffer))
map) map)

3
lisp/pcmpl-unix.el
View file

@ -82,7 +82,8 @@ being via `pcmpl-ssh-known-hosts-file'."
;;;###autoload ;;;###autoload
(defun pcomplete/xargs () (defun pcomplete/xargs ()
"Completion for `xargs'." "Completion for `xargs'."
;; FIXME: Add completion of xargs-specific arguments. (while (string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (funcall pcomplete-default-completion-function)))
(funcall pcomplete-command-completion-function) (funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1)) (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function))) pcomplete-default-completion-function)))

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

@ -25,10 +25,13 @@
;; This file provides minor modes for putting clickable overlays on ;; This file provides minor modes for putting clickable overlays on
;; references to bugs. A bug reference is text like "PR foo/29292"; ;; references to bugs. A bug reference is text like "PR foo/29292";
;; this is mapped to a URL using a user-supplied format. ;; this is mapped to a URL using a user-supplied format; see
;; `bug-reference-url-format' and `bug-reference-bug-regexp'. More
;; extensive documentation is in (info "(emacs) Bug Reference").
;; Two minor modes are provided. One works on any text in the buffer; ;; Two minor modes are provided. One works on any text in the buffer;
;; the other operates only on comments and strings. ;; the other operates only on comments and strings. By default, the
;; URL link is followed by invoking C-c RET or mouse-2.
;;; Code: ;;; Code:
@ -126,6 +129,9 @@ The second subexpression should match the bug reference (usually a number)."
"Open URL corresponding to the bug reference at POS." "Open URL corresponding to the bug reference at POS."
(interactive (interactive
(list (if (integerp last-command-event) (point) last-command-event))) (list (if (integerp last-command-event) (point) last-command-event)))
(when (null bug-reference-url-format)
(user-error
"You must customize some bug-reference variables; see Emacs info node Bug Reference"))
(if (and (not (integerp pos)) (eventp pos)) (if (and (not (integerp pos)) (eventp pos))
;; POS is a mouse event; switch to the proper window/buffer ;; POS is a mouse event; switch to the proper window/buffer
(let ((posn (event-start pos))) (let ((posn (event-start pos)))
@ -178,6 +184,22 @@ The second subexpression should match the bug reference (usually a number)."
"/issues/" "/issues/"
(match-string 2)))))) (match-string 2))))))
;; ;;
;; Codeberg projects.
;;
;; The systematics is exactly as for Github projects.
("[/@]codeberg.org[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
"\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
,(lambda (groups)
(let ((ns-project (nth 1 groups)))
(lambda ()
(concat "https://codeberg.org/"
(or
;; Explicit user/proj#18 link.
(match-string 1)
ns-project)
"/issues/"
(match-string 2))))))
;;
;; GitLab projects. ;; GitLab projects.
;; ;;
;; Here #18 is an issue and !17 is a merge request. Explicit ;; Here #18 is an issue and !17 is a merge request. Explicit
@ -195,6 +217,30 @@ The second subexpression should match the bug reference (usually a number)."
(if (string= (match-string 3) "#") (if (string= (match-string 3) "#")
"issues/" "issues/"
"merge_requests/") "merge_requests/")
(match-string 2))))))
;;
;; Sourcehut projects.
;;
;; #19 is an issue. Other project's issues can be referenced as
;; #~user/project#19.
;;
;; Caveat: The code assumes that a project on git.sr.ht or
;; hg.sr.ht has a tracker of the same name on todo.sh.ht. That's
;; a very common setup but all sr.ht services are loosely coupled,
;; so you can have a repo without tracker, or a repo with a
;; tracker using a different name, etc. So we can only try to
;; make a good guess.
("[/@]\\(?:git\\|hg\\).sr.ht[/:]\\(~[.A-Za-z0-9_/-]+\\)"
"\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
,(lambda (groups)
(let ((ns-project (nth 1 groups)))
(lambda ()
(concat "https://todo.sr.ht/"
(or
;; Explicit user/proj#18 link.
(match-string 1)
ns-project)
"/"
(match-string 2))))))) (match-string 2)))))))
"An alist for setting up `bug-reference-mode' based on VC URL. "An alist for setting up `bug-reference-mode' based on VC URL.

7
lisp/progmodes/grep.el
View file

@ -1345,6 +1345,13 @@ command before it's run."
(grep-highlight-matches 'always)) (grep-highlight-matches 'always))
(rgrep regexp files dir confirm))) (rgrep regexp files dir confirm)))
(defun grep-file-at-point (point)
"Return the name of the file at POINT a `grep-mode' buffer.
The returned file name is relative."
(when-let ((msg (get-text-property point 'compilation-message))
(loc (compilation--message->loc msg)))
(caar (compilation--loc->file-struct loc))))
;;;###autoload ;;;###autoload
(defalias 'rzgrep 'zrgrep) (defalias 'rzgrep 'zrgrep)

8
lisp/progmodes/inf-lisp.el
View file

@ -62,6 +62,7 @@
(require 'comint) (require 'comint)
(require 'lisp-mode) (require 'lisp-mode)
(require 'shell)
(defgroup inferior-lisp nil (defgroup inferior-lisp nil
@ -289,15 +290,20 @@ to continue it."
"Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'. "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'.
If there is a process already running in `*inferior-lisp*', just switch If there is a process already running in `*inferior-lisp*', just switch
to that buffer. to that buffer.
With argument, allows you to edit the command line (default is value With argument, allows you to edit the command line (default is value
of `inferior-lisp-program'). Runs the hooks from of `inferior-lisp-program'). Runs the hooks from
`inferior-lisp-mode-hook' (after the `comint-mode-hook' is run). `inferior-lisp-mode-hook' (after the `comint-mode-hook' is run).
If any parts of the command name contains spaces, they should be
quoted using shell quote syntax.
\(Type \\[describe-mode] in the process buffer for a list of commands.)" \(Type \\[describe-mode] in the process buffer for a list of commands.)"
(interactive (list (if current-prefix-arg (interactive (list (if current-prefix-arg
(read-string "Run lisp: " inferior-lisp-program) (read-string "Run lisp: " inferior-lisp-program)
inferior-lisp-program))) inferior-lisp-program)))
(if (not (comint-check-proc "*inferior-lisp*")) (if (not (comint-check-proc "*inferior-lisp*"))
(let ((cmdlist (split-string cmd))) (let ((cmdlist (split-string-shell-command cmd)))
(set-buffer (apply (function make-comint) (set-buffer (apply (function make-comint)
"inferior-lisp" (car cmdlist) nil (cdr cmdlist))) "inferior-lisp" (car cmdlist) nil (cdr cmdlist)))
(inferior-lisp-mode))) (inferior-lisp-mode)))

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

@ -272,7 +272,7 @@ not be enclosed in { } or ( )."
"Regex used to find macro assignment lines in a makefile.") "Regex used to find macro assignment lines in a makefile.")
(defconst makefile-var-use-regex (defconst makefile-var-use-regex
"[^$]\\$[({]\\([-a-zA-Z0-9_.]+\\|[@%<?^+*][FD]?\\)" "\\(^\\|[^$]\\)\\$[({]\\([-a-zA-Z0-9_.]+\\|[@%<?^+*][FD]?\\)"
"Regex used to find $(macro) uses in a makefile.") "Regex used to find $(macro) uses in a makefile.")
(defconst makefile-ignored-files-in-pickup-regex (defconst makefile-ignored-files-in-pickup-regex
@ -346,7 +346,7 @@ not be enclosed in { } or ( )."
(3 font-lock-builtin-face prepend t)) (3 font-lock-builtin-face prepend t))
;; Variable references even in targets/strings/comments. ;; Variable references even in targets/strings/comments.
(,var 1 font-lock-variable-name-face prepend) (,var 2 font-lock-variable-name-face prepend)
;; Automatic variable references and single character variable references, ;; Automatic variable references and single character variable references,
;; but not shell variables references. ;; but not shell variables references.

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

@ -2192,6 +2192,8 @@ Point should be before the newline."
When used interactively, insert the proper starting #!-line, When used interactively, insert the proper starting #!-line,
and make the visited file executable via `executable-set-magic', and make the visited file executable via `executable-set-magic',
perhaps querying depending on the value of `executable-query'. perhaps querying depending on the value of `executable-query'.
(If given a prefix (i.e., `C-u') don't insert any starting #!
line.)
When this function is called noninteractively, INSERT-FLAG (the third When this function is called noninteractively, INSERT-FLAG (the third
argument) controls whether to insert a #!-line and think about making argument) controls whether to insert a #!-line and think about making
@ -2215,7 +2217,7 @@ whose value is the shell name (don't quote it)."
'("csh" "rc" "sh")) '("csh" "rc" "sh"))
nil nil nil nil sh-shell-file) nil nil nil nil sh-shell-file)
(eq executable-query 'function) (eq executable-query 'function)
t)) (not current-prefix-arg)))
(if (string-match "\\.exe\\'" shell) (if (string-match "\\.exe\\'" shell)
(setq shell (substring shell 0 (match-beginning 0)))) (setq shell (substring shell 0 (match-beginning 0))))
(setq sh-shell (sh-canonicalize-shell shell)) (setq sh-shell (sh-canonicalize-shell shell))

4
lisp/progmodes/xref.el
View file

@ -959,7 +959,9 @@ GROUP is a string for decoration purposes and XREF is an
(prefix (prefix
(cond (cond
((not line) " ") ((not line) " ")
((equal line prev-line) "") ((and (equal line prev-line)
(equal prev-group group))
"")
(t (propertize (format line-format line) (t (propertize (format line-format line)
'face 'xref-line-number))))) 'face 'xref-line-number)))))
;; Render multiple matches on the same line, together. ;; Render multiple matches on the same line, together.

10
lisp/repeat.el
View file

@ -397,7 +397,7 @@ When Repeat mode is enabled, and the command symbol has the property named
(and (commandp s) (and (commandp s)
(get s 'repeat-map) (get s 'repeat-map)
(push (get s 'repeat-map) keymaps)))))) (push (get s 'repeat-map) keymaps))))))
(message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat'." (message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat-maps'."
(length commands) (length commands)
(length (delete-dups keymaps)))))) (length (delete-dups keymaps))))))
@ -489,10 +489,10 @@ When Repeat mode is enabled, and the command symbol has the property named
repeat-echo-mode-line-string))) repeat-echo-mode-line-string)))
(force-mode-line-update t))) (force-mode-line-update t)))
(defun describe-repeat () (defun describe-repeat-maps ()
"Describe repeatable commands and keymaps." "Describe mappings of commands repeatable by symbol property `repeat-map'."
(interactive) (interactive)
(help-setup-xref (list #'describe-repeat) (help-setup-xref (list #'describe-repeat-maps)
(called-interactively-p 'interactive)) (called-interactively-p 'interactive))
(let ((keymaps nil)) (let ((keymaps nil))
(all-completions (all-completions
@ -502,7 +502,7 @@ When Repeat mode is enabled, and the command symbol has the property named
(push s (alist-get (get s 'repeat-map) keymaps))))) (push s (alist-get (get s 'repeat-map) keymaps)))))
(with-help-window (help-buffer) (with-help-window (help-buffer)
(with-current-buffer standard-output (with-current-buffer standard-output
(princ "This is a list of repeatable keymaps and commands.\n\n") (princ "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n")
(dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car b))))) (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car b)))))
(princ (format-message "`%s' keymap is repeatable by these commands:\n" (princ (format-message "`%s' keymap is repeatable by these commands:\n"

12
lisp/replace.el
View file

@ -1089,17 +1089,17 @@ a previously found match."
rend (point-max))) rend (point-max)))
(goto-char rstart)) (goto-char rstart))
(let ((count 0) (let ((count 0)
opoint
(case-fold-search (case-fold-search
(if (and case-fold-search search-upper-case) (if (and case-fold-search search-upper-case)
(isearch-no-upper-case-p regexp t) (isearch-no-upper-case-p regexp t)
case-fold-search))) case-fold-search)))
(while (and (< (point) rend) (while (and (< (point) rend)
(progn (setq opoint (point)) (re-search-forward regexp rend t))
(re-search-forward regexp rend t))) ;; Ensure forward progress on zero-length matches like "^$".
(if (= opoint (point)) (when (and (= (match-beginning 0) (match-end 0))
(forward-char 1) (not (eobp)))
(setq count (1+ count)))) (forward-char 1))
(setq count (1+ count)))
(when interactive (message (ngettext "%d occurrence" (when interactive (message (ngettext "%d occurrence"
"%d occurrences" "%d occurrences"
count) count)

12
lisp/saveplace.el
View file

@ -87,6 +87,11 @@ this happens automatically before saving `save-place-alist' to
`save-place-file'." `save-place-file'."
:type 'boolean) :type 'boolean)
(defcustom save-place-abbreviate-file-names nil
"If non-nil, abbreviate file names before saving them."
:type 'boolean
:version "28.1")
(defcustom save-place-save-skipped t (defcustom save-place-save-skipped t
"If non-nil, remember files matching `save-place-skip-check-regexp'. "If non-nil, remember files matching `save-place-skip-check-regexp'.
@ -177,7 +182,10 @@ file:
"Add current buffer filename and position to `save-place-alist'. "Add current buffer filename and position to `save-place-alist'.
Put filename and point in a cons box and then cons that onto the Put filename and point in a cons box and then cons that onto the
front of the `save-place-alist', if `save-place-mode' is non-nil. front of the `save-place-alist', if `save-place-mode' is non-nil.
Otherwise, just delete that file from the alist." Otherwise, just delete that file from the alist.
If `save-place-abbreviate-file-names' is non-nil, abbreviate the
file names."
;; First check to make sure alist has been loaded in from the master ;; First check to make sure alist has been loaded in from the master
;; file. If not, do so, then feel free to modify the alist. It ;; file. If not, do so, then feel free to modify the alist. It
;; will be saved again when Emacs is killed. ;; will be saved again when Emacs is killed.
@ -195,6 +203,8 @@ Otherwise, just delete that file from the alist."
(or (not save-place-ignore-files-regexp) (or (not save-place-ignore-files-regexp)
(not (string-match save-place-ignore-files-regexp (not (string-match save-place-ignore-files-regexp
item)))) item))))
(when save-place-abbreviate-file-names
(setq item (abbreviate-file-name item)))
(let ((cell (assoc item save-place-alist)) (let ((cell (assoc item save-place-alist))
(position (cond ((eq major-mode 'hexl-mode) (position (cond ((eq major-mode 'hexl-mode)
(with-no-warnings (with-no-warnings

16
lisp/select.el
View file

@ -187,11 +187,17 @@ decoded. If `gui-get-selection' signals an error, return nil."
(let ((clip-text (let ((clip-text
(when select-enable-clipboard (when select-enable-clipboard
(let ((text (gui--selection-value-internal 'CLIPBOARD))) (let ((text (gui--selection-value-internal 'CLIPBOARD)))
(if (string= text "") (setq text nil)) (when (string= text "")
(setq text nil))
;; Check the CLIPBOARD selection for 'newness', is it different ;; When `select-enable-clipboard' is non-nil,
;; from what we remembered them to be last time we did a ;; killing/copying text (with, say, `C-w') will push the
;; cut/paste operation. ;; text to the clipboard (and store it in
;; `gui--last-selected-text-clipboard'). We check
;; whether the text on the clipboard is identical to this
;; text, and if so, we report that the clipboard is
;; empty. See (bug#27442) for further discussion about
;; this DWIM action, and possible ways to make this check
;; less fragile, if so desired.
(prog1 (prog1
(unless (equal text gui--last-selected-text-clipboard) (unless (equal text gui--last-selected-text-clipboard)
text) text)

10
lisp/shell.el
View file

@ -459,6 +459,16 @@ Useful for shells like zsh that has this feature."
(push (mapconcat #'identity (nreverse arg) "") args))) (push (mapconcat #'identity (nreverse arg) "") args)))
(cons (nreverse args) (nreverse begins))))) (cons (nreverse args) (nreverse begins)))))
;;;###autoload
(defun split-string-shell-command (string)
"Split STRING (a shell command) into a list of strings.
General shell syntax, like single and double quoting, as well as
backslash quoting, is respected."
(with-temp-buffer
(insert string)
(let ((comint-file-name-quote-list shell-file-name-quote-list))
(car (shell--parse-pcomplete-arguments)))))
(defun shell-command-completion-function () (defun shell-command-completion-function ()
"Completion function for shell command names. "Completion function for shell command names.
This is the value of `pcomplete-command-completion-function' for This is the value of `pcomplete-command-completion-function' for

6
lisp/simple.el
View file

@ -5842,7 +5842,13 @@ Can be `untabify' -- turn a tab to many spaces, then delete one space;
(defun backward-delete-char-untabify (arg &optional killp) (defun backward-delete-char-untabify (arg &optional killp)
"Delete characters backward, changing tabs into spaces. "Delete characters backward, changing tabs into spaces.
The exact behavior depends on `backward-delete-char-untabify-method'. The exact behavior depends on `backward-delete-char-untabify-method'.
Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil. Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
If Transient Mark mode is enabled, the mark is active, and ARG is 1,
delete the text in the region and deactivate the mark instead.
To disable this, set option ‘delete-active-region’ to nil.
Interactively, ARG is the prefix arg (default 1) Interactively, ARG is the prefix arg (default 1)
and KILLP is t if a prefix arg was specified." and KILLP is t if a prefix arg was specified."
(interactive "*p\nP") (interactive "*p\nP")

8
lisp/subr.el
View file

@ -3850,6 +3850,14 @@ Before insertion, process text properties according to
(insert-buffer-substring buffer start end) (insert-buffer-substring buffer start end)
(remove-yank-excluded-properties opoint (point)))) (remove-yank-excluded-properties opoint (point))))
(defun insert-into-buffer (buffer &optional start end)
"Insert the contents of the current buffer into BUFFER.
If START/END, only insert that region from the current buffer.
Point in BUFFER will be placed after the inserted text."
(let ((current (current-buffer)))
(with-current-buffer buffer
(insert-buffer-substring current start end))))
(defun yank-handle-font-lock-face-property (face start end) (defun yank-handle-font-lock-face-property (face start end)
"If `font-lock-defaults' is nil, apply FACE as a `face' property. "If `font-lock-defaults' is nil, apply FACE as a `face' property.
START and END denote the start and end of the text to act on. START and END denote the start and end of the text to act on.

5
lisp/tab-line.el
View file

@ -471,7 +471,10 @@ should return the formatted tab name to display in the tab line."
(dolist (fn tab-line-tab-face-functions) (dolist (fn tab-line-tab-face-functions)
(setf face (funcall fn tab tabs face buffer-p selected-p))) (setf face (funcall fn tab tabs face buffer-p selected-p)))
(apply 'propertize (apply 'propertize
(concat (propertize name 'keymap tab-line-tab-map) (concat (propertize name
'keymap tab-line-tab-map
;; Don't turn mouse-1 into mouse-2 (bug#49247)
'follow-link 'ignore)
(or (and (or buffer-p (assq 'buffer tab) (assq 'close tab)) (or (and (or buffer-p (assq 'buffer tab) (assq 'close tab))
tab-line-close-button-show tab-line-close-button-show
(not (eq tab-line-close-button-show (not (eq tab-line-close-button-show

4
lisp/textmodes/enriched.el
View file

@ -38,7 +38,7 @@
;;; Code: ;;; Code:
(provide 'enriched) (require 'facemenu)
;;; ;;;
;;; Variables controlling the display ;;; Variables controlling the display
@ -538,4 +538,6 @@ the range of text to assign text property SYMBOL with value VALUE."
(list start end 'display prop) (list start end 'display prop)
(list start end 'display (list 'disable-eval prop))))) (list start end 'display (list 'disable-eval prop)))))
(provide 'enriched)
;;; enriched.el ends here ;;; enriched.el ends here

7
lisp/textmodes/tex-mode.el
View file

@ -1427,7 +1427,9 @@ on the line for the invalidity you want to see."
(forward-line 1) (forward-line 1)
(setq num-matches (1+ num-matches)) (setq num-matches (1+ num-matches))
(insert-buffer-substring buffer start end) (insert-buffer-substring buffer start end)
(let (text-beg (text-end (point-marker))) (let ((text-end (point-marker))
(inhibit-read-only t)
text-beg)
(forward-char (- start end)) (forward-char (- start end))
(setq text-beg (point-marker)) (setq text-beg (point-marker))
(insert (format "%3d: " linenum)) (insert (format "%3d: " linenum))
@ -1439,7 +1441,8 @@ on the line for the invalidity you want to see."
(put-text-property text-beg (- text-end 1) (put-text-property text-beg (- text-end 1)
'occur-target tem)))))))) 'occur-target tem))))))))
(with-current-buffer standard-output (with-current-buffer standard-output
(let ((no-matches (zerop num-matches))) (let ((no-matches (zerop num-matches))
(inhibit-read-only t))
(if no-matches (if no-matches
(insert "None!\n")) (insert "None!\n"))
(if (called-interactively-p 'interactive) (if (called-interactively-p 'interactive)

16
lisp/thingatpt.el
View file

@ -677,14 +677,14 @@ Signal an error if the entire string was not used."
"Return the number at point, or nil if none is found. "Return the number at point, or nil if none is found.
Decimal numbers like \"14\" or \"-14.5\", as well as hex numbers Decimal numbers like \"14\" or \"-14.5\", as well as hex numbers
like \"0xBEEF09\" or \"#xBEEF09\", are recognized." like \"0xBEEF09\" or \"#xBEEF09\", are recognized."
(when (thing-at-point-looking-at (cond
"\\(-?[0-9]+\\.?[0-9]*\\)\\|\\(0x\\|#x\\)\\([a-zA-Z0-9]+\\)" 500) ((thing-at-point-looking-at "\\(0x\\|#x\\)\\([a-fA-F0-9]+\\)" 500)
(if (match-beginning 1) (string-to-number
(string-to-number (buffer-substring (match-beginning 2) (match-end 2))
(buffer-substring (match-beginning 1) (match-end 1))) 16))
(string-to-number ((thing-at-point-looking-at "-?[0-9]+\\.?[0-9]*" 500)
(buffer-substring (match-beginning 3) (match-end 3)) (string-to-number
16)))) (buffer-substring (match-beginning 0) (match-end 0))))))
(put 'number 'thing-at-point 'number-at-point) (put 'number 'thing-at-point 'number-at-point)
;;;###autoload ;;;###autoload

2
lisp/userlock.el
View file

@ -230,7 +230,7 @@ to get the latest version of the file, then make the change again."
(display-warning (display-warning
'(unlock-file) '(unlock-file)
;; There is no need to explain that this is an unlock error because ;; There is no need to explain that this is an unlock error because
;; ERR is a `file-error' condition, which explains this. ;; ERROR is a `file-error' condition, which explains this.
(message "%s, ignored" (error-message-string error)) (message "%s, ignored" (error-message-string error))
:warning)) :warning))

5
lisp/vc/ediff-util.el
View file

@ -563,8 +563,9 @@ to invocation.")
(set-visited-file-name merge-buffer-file)))) (set-visited-file-name merge-buffer-file))))
(ediff-with-current-buffer ediff-buffer-C (ediff-with-current-buffer ediff-buffer-C
(setq buffer-offer-save t) ; ask before killing buffer (setq buffer-offer-save t) ; ask before killing buffer
;; make sure the contents is auto-saved (when make-backup-files
(auto-save-mode 1)) ;; make sure the contents is auto-saved
(auto-save-mode 1)))
)) ))

12
lisp/window.el
View file

@ -8733,6 +8733,13 @@ documentation for additional customization information."
BUFFER-OR-NAME may be a buffer, a string (a buffer name), or BUFFER-OR-NAME may be a buffer, a string (a buffer name), or
nil. Return the buffer switched to. nil. Return the buffer switched to.
This uses the function `display-buffer' as a subroutine to
display the buffer; see its documentation for additional
customization information. By default, if the buffer is already
displayed (even in the current frame), that window is selected.
If the buffer isn't displayed in any frame, a new frame is popped
up and the buffer is displayed there.
If called interactively, read the buffer name using `read-buffer'. If called interactively, read the buffer name using `read-buffer'.
The variable `confirm-nonexistent-file-or-buffer' determines The variable `confirm-nonexistent-file-or-buffer' determines
whether to request confirmation before creating a new buffer. whether to request confirmation before creating a new buffer.
@ -8744,10 +8751,7 @@ buffer, create a new buffer with that name. If BUFFER-OR-NAME is
nil, switch to the buffer returned by `other-buffer'. nil, switch to the buffer returned by `other-buffer'.
Optional second arg NORECORD non-nil means do not put this Optional second arg NORECORD non-nil means do not put this
buffer at the front of the list of recently selected ones. buffer at the front of the list of recently selected ones."
This uses the function `display-buffer' as a subroutine; see its
documentation for additional customization information."
(interactive (interactive
(list (read-buffer-to-switch "Switch to buffer in other frame: "))) (list (read-buffer-to-switch "Switch to buffer in other frame: ")))
(pop-to-buffer buffer-or-name display-buffer--other-frame-action norecord)) (pop-to-buffer buffer-or-name display-buffer--other-frame-action norecord))

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