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

Merge remote-tracking branch 'savannah/master' into HEAD

Browse source
This commit is contained in:
Andrea Corallo 2020-08-09 15:03:23 +02:00
commit 12a982d978
190 changed files with 6031 additions and 1722 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -153,6 +153,7 @@ test/manual/etags/regexfile
test/manual/etags/ETAGS
test/manual/etags/CTAGS
test/manual/indent/*.new
test/data/mml-sec/random_seed
# ctags, etags.
TAGS

2
ChangeLog.3
View file

@ -58779,7 +58779,7 @@
* lisp/net/soap-client.el (soap-type-of): Optimize for Emacs≥26
2018-07-17 Alex <agrambot@gmail.com>
2018-07-17 Alexander Gramiak <agrambot@gmail.com>
Remove menu name from emacs-lisp-mode-map (Bug#27114)

1
admin/authors.el
View file

@ -212,7 +212,6 @@ files.")
("Carlos Pita" "memeplex")
("Vinicius Jose Latorre" "viniciusjl")
("Gaby Launay" "galaunay")
("Alex Gramiak" "alex")
("Dick R. Chiang" "dickmao")
)
"Alist of author aliases.

82
configure.ac
View file

@ -749,44 +749,21 @@ case "${canonical}" in
opsys=aix4-2
;;
## Suns
*-sun-solaris* \
| i[3456]86-*-solaris2* | i[3456]86-*-sunos5* \
| x86_64-*-solaris2* | x86_64-*-sunos5*)
## Solaris
*-*-solaris* | *-*-sunos*)
case "${canonical}" in
i[3456]86-*-* ) ;;
amd64-*-*|x86_64-*-*) ;;
sparc* ) ;;
* ) unported=yes ;;
esac
case "${canonical}" in
*-sunos5.[1-9][0-9]* | *-solaris2.[1-9][0-9]* )
opsys=sol2-10
emacs_check_sunpro_c=yes
;;
*-sunos5.[1-5]* | *-solaris2.[1-5]* ) unported=yes ;;
## Note that Emacs 23.1's NEWS said the following would be dropped.
*-sunos5.6* | *-solaris2.6* )
opsys=sol2-6
RANLIB="ar -ts"
;;
## 5.7 EOL Aug 2008, 5.8 EOL Mar 2012.
*-sunos5.[7-9]* | *-solaris2.[7-9]* )
opsys=sol2-6
emacs_check_sunpro_c=yes
;;
esac
opsys=solaris
## Watch out for a compiler that we know will not work.
case "${canonical}" in
*-solaris* | *-sunos5* )
if [ "x$CC" = x/usr/ucb/cc ]; then
## /usr/ucb/cc doesn't work;
## we should find some other compiler that does work.
unset CC
fi
;;
*) ;;
esac
if [ "$CC" = /usr/ucb/cc ]; then
## /usr/ucb/cc doesn't work;
## we should find some other compiler that does work.
unset CC
fi
;;
## QNX Neutrino
@ -1477,14 +1454,11 @@ case "$opsys" in
mingw32)
UNEXEC_OBJ=unexw32.o
;;
sol2-10)
solaris)
# Use the Solaris dldump() function, called from unexsol.c, to dump
# emacs, instead of the generic ELF dump code found in unexelf.c.
# The resulting binary has a complete symbol table, and is better
# for debugging and other observability tools (debuggers, pstack, etc).
#
# It is likely that dldump() works with older Solaris too, but this has
# not been tested, so for now this change is for Solaris 10 or newer.
UNEXEC_OBJ=unexsol.o
;;
*)
@ -1587,7 +1561,7 @@ case "$opsys" in
qnxnto) LIBS_SYSTEM="-lsocket" ;;
sol2*) LIBS_SYSTEM="-lsocket -lnsl" ;;
solaris) LIBS_SYSTEM="-lsocket -lnsl" ;;
## Motif needs -lgen.
unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;;
@ -1648,7 +1622,7 @@ case $opsys in
SYSTEM_TYPE=berkeley-unix
;;
sol2* | unixware )
solaris | unixware )
SYSTEM_TYPE=usg-unix-v
;;
@ -2292,7 +2266,7 @@ system_malloc=yes
test $with_unexec = yes &&
case "$opsys" in
## darwin ld insists on the use of malloc routines in the System framework.
darwin | mingw32 | nacl | sol2-10) ;;
darwin | mingw32 | nacl | solaris) ;;
cygwin | qnxnto | freebsd)
hybrid_malloc=yes
system_malloc= ;;
@ -2428,7 +2402,7 @@ if test "$ac_cv_header_pthread_h" && test "$opsys" != "mingw32"; then
# need special flags to disable these optimizations. For example, the
# definition of 'errno' in <errno.h>.
case $opsys in
hpux* | sol*)
hpux* | solaris)
AC_DEFINE([_REENTRANT], 1,
[Define to 1 if your system requires this in multithreaded code.]);;
aix4-2)
@ -2558,7 +2532,7 @@ fail;
## inoue@ainet.or.jp says Solaris has a bug related to X11R6-style
## XIM support.
case "$opsys" in
sol2-*) : ;;
solaris) : ;;
*) AC_DEFINE(HAVE_X11R6_XIM, 1,
[Define if you have usable X11R6-style XIM support.])
;;
@ -4600,11 +4574,13 @@ AC_CHECK_HEADERS(valgrind/valgrind.h)
AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]])
AC_CHECK_FUNCS_ONCE([sbrk])
AC_CHECK_FUNCS_ONCE([__lsan_ignore_object sbrk])
AC_FUNC_FORK
AC_CHECK_FUNCS(snprintf __lsan_ignore_object)
dnl AC_CHECK_FUNCS_ONCE wouldn’t be right for snprintf, which needs
dnl the current CFLAGS etc.
AC_CHECK_FUNCS(snprintf)
dnl Check for glib. This differs from other library checks in that
dnl Emacs need not link to glib unless some other library is already
@ -4778,7 +4754,7 @@ if test "$USE_X_TOOLKIT" != "none"; then
fi
case $opsys in
sol2* | unixware )
solaris | unixware )
dnl Some SVr4s don't define NSIG in sys/signal.h for ANSI environments;
dnl instead, there's a system variable _sys_nsig. Unfortunately, we
dnl need the constant to dimension an array. So wire in the appropriate
@ -4791,7 +4767,7 @@ emacs_broken_SIGIO=no
case $opsys in
dnl SIGIO exists, but the feature doesn't work in the way Emacs needs.
hpux* | nacl | openbsd | sol2* | unixware )
hpux* | nacl | openbsd | solaris | unixware )
emacs_broken_SIGIO=yes
;;
@ -4840,7 +4816,7 @@ case $opsys in
esac
case $opsys in
gnu-* | sol2-10 )
gnu-* | solaris )
dnl FIXME Can't we test if this exists (eg /proc/$$)?
AC_DEFINE(HAVE_PROCFS, 1, [Define if you have the /proc filesystem.])
;;
@ -4969,7 +4945,7 @@ case $opsys in
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/pty/tty%c%x", c, i);])
;;
sol2* )
solaris )
dnl On SysVr4, grantpt(3) forks a subprocess, so do not use
dnl O_CLOEXEC when opening the pty, and keep the SIGCHLD handler
dnl from intercepting that death. If any child but grantpt's should die
@ -4979,7 +4955,7 @@ case $opsys in
;;
unixware )
dnl Comments are as per sol2*.
dnl Comments are as per solaris.
AC_DEFINE(PTY_OPEN, [fd = open (pty_name, O_RDWR | O_NONBLOCK)])
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }])
;;
@ -4987,7 +4963,7 @@ esac
case $opsys in
sol2* | unixware )
solaris | unixware )
dnl This change means that we don't loop through allocate_pty too
dnl many times in the (rare) event of a failure.
AC_DEFINE(FIRST_PTY_LETTER, ['z'])
@ -5082,7 +5058,7 @@ if test x$GCC = xyes; then
AC_DEFINE(GC_SETJMP_WORKS, 1)
else
case $opsys in
aix* | dragonfly | freebsd | netbsd | openbsd | sol2* )
aix* | dragonfly | freebsd | netbsd | openbsd | solaris )
AC_DEFINE(GC_SETJMP_WORKS, 1)
;;
esac
@ -5129,7 +5105,7 @@ case $emacs_cv_func_sigsetjmp,$emacs_cv_alternate_stack,$opsys in
esac
case $opsys in
sol2* | unixware )
solaris | unixware )
dnl TIOCGPGRP is broken in SysVr4, so we can't send signals to PTY
dnl subprocesses the usual way. But TIOCSIGNAL does work for PTYs,
dnl and this is all we need.
@ -5139,7 +5115,7 @@ esac
case $opsys in
hpux* | sol2* )
hpux* | solaris )
dnl Used in xfaces.c.
AC_DEFINE(XOS_NEEDS_TIME_H, 1, [Compensate for a bug in Xos.h on
some systems, where it requires time.h.])
@ -5194,7 +5170,7 @@ case $opsys in
fi
;;
sol2*)
solaris)
AC_DEFINE(USG, [])
AC_DEFINE(USG5_4, [])
AC_DEFINE(SOLARIS2, [], [Define if the system is Solaris.])
@ -5259,7 +5235,7 @@ case $opsys in
reopen it in the child.])
;;
sol2-10)
solaris)
AC_DEFINE(_STRUCTURED_PROC, 1, [Needed for system_process_attributes
on Solaris.])
;;

5
doc/emacs/calendar.texi
View file

@ -625,6 +625,11 @@ your time zone. Emacs displays the times of sunrise and sunset
@emph{corrected for daylight saving time}. @xref{Daylight Saving},
for how daylight saving time is determined.
@vindex calendar-use-numeric-time-zones
If you want to display numerical time zones (like @samp{"+0100"})
instead of symbolic time zones (like @samp{"CET"}), set the
@code{calendar-use-numeric-time-zones} variable to non-@code{nil}.
As a user, you might find it convenient to set the calendar location
variables for your usual physical location in your @file{.emacs} file.
If you are a system administrator, you may want to set these variables

4
doc/emacs/display.texi
View file

@ -1334,6 +1334,10 @@ customize the variable @code{whitespace-line-column}.
@item newline
Highlight newlines.
@item missing-newline-at-eof
Highlight the final character if the buffer doesn't end with a newline
character.
@item empty
Highlight empty lines at the beginning and/or end of the buffer.

7
doc/emacs/files.texi
View file

@ -2149,7 +2149,12 @@ To reset all transformations to the initial state, use
@findex image-previous-file
You can press @kbd{n} (@code{image-next-file}) and @kbd{p}
(@code{image-previous-file}) to visit the next image file and the
previous image file in the same directory, respectively.
previous image file in the same directory, respectively. These
commands will consult the ``parent'' dired buffer to determine what
the next/previous image file is. These commands also work when
opening a file from archive files (like zip or tar files), and will
then instead consult the archive mode buffer. If neither an archive
nor a dired ``parent'' buffer can be found, a dired buffer is opened.
@findex image-mode-mark-file
@findex image-mode-unmark-file

10
doc/emacs/help.texi
View file

@ -220,6 +220,16 @@ documentation string of the command it runs.
command is not on any key, that means you must use @kbd{M-x} to run
it. @kbd{C-h w} runs the command @code{where-is}.
@findex button-describe
@findex widget-describe
Some modes in Emacs use various buttons (@pxref{Buttons,,,elisp, The
Emacs Lisp Reference Manual}) and widgets
(@pxref{Introduction,,,widget, Emacs Widgets}) that can be clicked to
perform some action. To find out what function is ultimately invoked
by these buttons, Emacs provides the @code{button-describe} and
@code{widget-describe} commands, that should be run with point over
the button.
@node Name Help
@section Help by Command or Variable Name

4
doc/emacs/killing.texi
View file

@ -577,7 +577,9 @@ regions to the primary selection entirely.
To insert the primary selection into an Emacs buffer, click
@kbd{mouse-2} (@code{mouse-yank-primary}) where you want to insert it.
@xref{Mouse Commands}.
@xref{Mouse Commands}. You can also use the normal Emacs yank command
(@kbd{C-y}) to insert this text if @code{select-enable-primary} is set
(@pxref{Clipboard}).
@cindex MS-Windows, and primary selection
MS-Windows provides no primary selection, but Emacs emulates it

19
doc/emacs/misc.texi
View file

@ -724,13 +724,15 @@ See the Eshell Info manual, which is distributed with Emacs.
@kindex M-!
@findex shell-command
@vindex shell-command-buffer-name
@kbd{M-!} (@code{shell-command}) reads a line of text using the
minibuffer and executes it as a shell command, in a subshell made just
for that command. Standard input for the command comes from the null
device. If the shell command produces any output, the output appears
either in the echo area (if it is short), or in an Emacs buffer named
@file{*Shell Command Output*}, displayed in another window (if the
output is long). The variables @code{resize-mini-windows} and
either in the echo area (if it is short), or in an Emacs buffer,
displayed in another window (if the output is long). The name of
this buffer is taken from the constant @code{shell-command-buffer-name}.
The variables @code{resize-mini-windows} and
@code{max-mini-window-height} (@pxref{Minibuffer Edit}) control when
Emacs should consider the output to be too long for the echo area.
@ -758,15 +760,16 @@ which is impossible to ignore.
@kindex M-&
@findex async-shell-command
@vindex shell-command-buffer-name-async
A shell command that ends in @samp{&} is executed
@dfn{asynchronously}, and you can continue to use Emacs as it runs.
You can also type @kbd{M-&} (@code{async-shell-command}) to execute a
shell command asynchronously; this is exactly like calling @kbd{M-!}
with a trailing @samp{&}, except that you do not need the @samp{&}.
The default output buffer for asynchronous shell commands is named
@samp{*Async Shell Command*}. Emacs inserts the output into this
buffer as it comes in, whether or not the buffer is visible in a
window.
The constant @code{shell-command-buffer-name-async} stores the name
of the default output buffer for asynchronous shell commands.
Emacs inserts the output into this buffer as it comes in,
whether or not the buffer is visible in a window.
@vindex async-shell-command-buffer
If you want to run more than one asynchronous shell command at the
@ -804,7 +807,7 @@ old region and replaces it with the output from the shell command.
see what keys are in the buffer. If the buffer contains a GnuPG key,
type @kbd{C-x h M-| gpg @key{RET}} to feed the entire buffer contents
to @command{gpg}. This will output the list of keys to the
@file{*Shell Command Output*} buffer.
buffer named @code{shell-command-buffer-name}.
@vindex shell-file-name
The above commands use the shell specified by the variable

9
doc/lispref/display.texi
View file

@ -5572,6 +5572,15 @@ The value, @var{width}, specifies the width of the image, in pixels.
@item :height @var{height}
The value, @var{height}, specifies the height of the image, in pixels.
Note that @code{:width} and @code{:height} can only be used if passing
in data that doesn't specify the width and height (e.g., a string or a
vector containing the bits of the image). @acronym{XBM} files usually
specify this themselves, and it's an error to use these two properties
on these files. Also note that @code{:width} and @code{:height} are
used by most other image formats to specify what the displayed image
is supposed to be, which usually means performing some sort of
scaling. This isn't supported for @acronym{XBM} images.
@item :stride @var{stride}
The number of bool vector entries stored for each row; the smallest
multiple of 8 greater than or equal to @var{width}.

10
doc/lispref/edebug.texi
View file

@ -1438,6 +1438,16 @@ name component for the definition. You can use this to add a unique,
static component to the name of the definition. It may be used more
than once.
@item :unique
This construct is like @code{:name}, but generates unique names. It
does not match an argument. The element following @code{:unique}
should be a string; it is used as the prefix for an additional name
component for the definition. You can use this to add a unique,
dynamic component to the name of the definition. This is useful for
macros that can define the same symbol multiple times in different
scopes, such as @code{cl-flet}; @ref{Function Bindings,,,cl}. It may
be used more than once.
@item arg
The argument, a symbol, is the name of an argument of the defining form.
However, lambda-list keywords (symbols starting with @samp{&})

6
doc/lispref/os.texi
View file

@ -2687,9 +2687,9 @@ Emacs is restarted by the session manager.
@group
(defun save-yourself-test ()
(insert "(save-current-buffer
(switch-to-buffer \"*scratch*\")
(insert \"I am restored\"))")
(insert
(format "%S" '(with-current-buffer "*scratch*"
(insert "I am restored"))))
nil)
@end group
@end example

20
doc/misc/emacs-mime.texi
View file

@ -472,6 +472,13 @@ the case if you save it to disk and launch it in a different way
to launch any external programs, set this variable to @code{nil} or
@code{ask}.
@item mm-inline-font-lock
@vindex mm-inline-font-lock
If non-@code{nil}, inlined parts that support font locking (for
instance, patches or code snippets) will be font-locked. This may be
overriden by callers that have their own ways of enabling/inhibiting
font locking.
@end table
@node Files and Directories
@ -686,8 +693,17 @@ Valid values are @samp{inline} and @samp{attachment}
@item encoding
Valid values are @samp{7bit}, @samp{8bit}, @samp{quoted-printable} and
@samp{base64} (@code{Content-Transfer-Encoding}). @xref{Charset
Translation}.
@samp{base64}. @xref{Charset
Translation}. This parameter says what
@code{Content-Transfer-Encoding} to use when sending the part, and is
normally computed automatically.
@item data-encoding
This parameter says what encoding has been used on the data, and the
data will be decoded before use. Valid values are
@samp{quoted-printable} and @samp{base64}. This is useful when you
have a part with binary data (for instance an image) inserted directly
into the Message buffer inside the @samp{"<#part>...<#/part>"} tags.
@item description
A description of the part (@code{Content-Description}).

16
doc/misc/eww.texi
View file

@ -52,6 +52,7 @@ modify this GNU manual.''
* Overview::
* Basics::
* Advanced::
* Command Line::
Appendices
* History and Acknowledgments::
@ -337,6 +338,21 @@ thus allowing for the use of the usual substitutions, such as
@code{\[eww-reload]} for the current key binding of the
@code{eww-reload} command.
@node Command Line
@chapter Command Line Usage
It can be convenient to start eww directly from the command line. The
@code{eww-browse} function can be used for that:
@example
emacs -f eww-browse https://gnu.org
@end example
This also allows registering Emacs as a @acronym{MIME} handler for the
@samp{"text/x-uri"} media type. How to do that varies between
systems, but typically you'd register the handler to call @samp{"emacs
-f eww-browse %u"}.
@node History and Acknowledgments
@appendix History and Acknowledgments

60
doc/misc/message.texi
View file

@ -99,6 +99,7 @@ sending it.
* Resending:: Resending a mail message.
* Bouncing:: Bouncing a mail message.
* Mailing Lists:: Send mail to mailing lists.
* System Mailer Setup:: Using Message as the system mailer.
@end menu
You can customize the Message Mode tool bar, see @kbd{M-x
@ -529,6 +530,29 @@ It is considered good netiquette to honor MFT, as it is assumed the
fellow who posted a message knows where the followups need to go
better than you do.
@node System Mailer Setup
@section System Mailer Setup
@cindex mailto:
Emacs can be set up as the system mailer, so that Emacs is opened when
you click on @samp{mailto:} links in other programs.
How this is done varies from system to system, but commonly there's a
way to set the default application for a @acronym{MIME} type, and the
relevant type here is @samp{x-scheme-handler/mailto;}.
The application to start should be @samp{"emacs -f message-mailto %u"}.
This will start Emacs, and then run the @code{message-mailto}
command. It will parse the given @acronym{URL}, and set up a Message
buffer with the given parameters.
For instance, @samp{mailto:larsi@@gnus.org?subject=This+is+a+test}
will open a Message buffer with the @samp{To:} header filled in with
@samp{"larsi@@gnus.org"} and the @samp{Subject:} header with
@samp{"This is a test"}.
@node Commands
@chapter Commands
@ -883,6 +907,18 @@ is a list, valid members are @code{type}, @code{description} and
@code{nil}, don't ask for options. If it is @code{t}, ask the user
whether or not to specify options.
@vindex message-screenshot-command
@findex message-insert-screenshot
@cindex screenshots
@kindex C-c C-p
If your system supports it, you can also insert screenshots directly
into the Message buffer. The @kbd{C-c C-p}
(@code{message-insert-screenshot}) command inserts the image into the
buffer as an @acronym{MML} part, and puts an image text property on
top. The @code{message-screenshot-command} variable says what
external command to use to take the screenshot. It defaults to
@code{"import png:-"}, which is an ImageMagick command.
You can also create arbitrarily complex multiparts using the @acronym{MML}
language (@pxref{Composing, , Composing, emacs-mime, The Emacs MIME
Manual}).
@ -1006,6 +1042,7 @@ and/or encrypted messages as explained in the following.
* Signing and encryption:: Signing and encrypting commands.
* Using S/MIME:: Using S/MIME
* Using OpenPGP:: Using OpenPGP
* OpenPGP Header:: Adding OpenPGP headers to messages.
* Passphrase caching:: How to cache passphrases
* PGP Compatibility:: Compatibility with older implementations
* Encrypt-to-self:: Reading your own encrypted messages
@ -1215,6 +1252,29 @@ according to two different standards, namely @acronym{PGP} or
@code{mml-default-sign-method} determine which variant to prefer,
@acronym{PGP/MIME} by default.
@node OpenPGP Header
@subsection OpenPGP Header
The @samp{OpenPGP} header can be used to provide information about the
sender's OpenPGP key. This is a formalization and modernization of
the non-standard @samp{X-PGP-Key} (etc.) headers that have been in use
for a long time. For more details, see
@uref{https://tools.ietf.org/html/draft-josefsson-openpgp-mailnews-header}.
@vindex message-openpgp-header
To use this in Message, say:
@lisp
(add-hook 'message-send-hook 'message-add-openpgp-header)
@end lisp
@noindent
then customize the @code{message-openpgp-header} variable according to
your PGP setup. The variable is a list of the key ID, the key URL or
ASCII armored key, and the protection preference, one of
@samp{"unprotected"}, @samp{"sign"}, @samp{"encrypt"} or
@samp{"signencrypt"}.
@node Passphrase caching
@subsection Passphrase caching

87
doc/misc/tramp.texi
View file

@ -2053,6 +2053,13 @@ The temporary directory on the remote host. If not specified, the
default value is @t{"/data/local/tmp"} for the @option{adb} method,
@t{"/C$/Temp"} for the @option{smb} method, and @t{"/tmp"} otherwise.
@item @t{"direct-async-process"}
When this property is non-@code{nil}, an alternative, more performant
implementation of @code{make-process} and
@code{start-file-process} is applied. @ref{Improving performance of
asynchronous remote processes} for a discussion of constraints.
@item @t{"posix"}
Connections using the @option{smb} method check, whether the remote
@ -2098,7 +2105,7 @@ To improve performance and accuracy of remote file access,
@file{/usr/bin}, which are reasonable for most hosts. To accommodate
differences in hosts and paths, for example, @file{/bin:/usr/bin} on
Debian GNU/Linux or
@file{/usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin} on
@file{/usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/developerstudio12.6/bin} on
Solaris, @value{tramp} queries the remote host with @command{getconf
PATH} and updates the symbol @code{tramp-default-remote-path}.
@ -2458,10 +2465,9 @@ overwrite as follows:
@lisp
@group
(add-to-list
'tramp-connection-properties
`(,(regexp-quote "192.168.0.1")
"remote-copy-args" (("-l") ("%r"))))
(add-to-list 'tramp-connection-properties
`(,(regexp-quote "192.168.0.1")
"remote-copy-args" (("-l") ("%r"))))
@end group
@end lisp
@ -3373,7 +3379,7 @@ host. Example:
@end example
@command{tail} command outputs continuously to the local buffer,
@file{*Async Shell Command*}
named @code{shell-command-buffer-name-async}
@kbd{M-x auto-revert-tail-mode @key{RET}} runs similarly showing
continuous output.
@ -3527,6 +3533,70 @@ To open @command{powershell} as a remote shell, use this:
@end lisp
@anchor{Improving performance of asynchronous remote processes}
@subsection Improving performance of asynchronous remote processes
@cindex Asynchronous remote processes
@findex make-process
@findex start-file-process
@value{tramp}'s implementation of @code{make-process} and
@code{start-file-process} requires a serious overhead for
initialization, every process invocation. This is needed for handling
interactive dialogues when connecting the remote host (like providing
a password), and initial environment setup.
Sometimes, this is not needed. Instead of starting a remote shell and
running the command afterwards, it is sufficient to run the command
directly. @value{tramp} supports this by an alternative
implementation of @code{make-process} and @code{start-file-process}.
This is triggered by the connection property
@t{"direct-async-process"}, @xref{Predefined connection information},
which must be set to a non-@code{nil} value. Example:
@lisp
@group
(add-to-list 'tramp-connection-properties
(list (regexp-quote "@trampfn{ssh,user@@host,}")
"direct-async-process" t))
@end group
@end lisp
However, this approach has different limitations:
@itemize
@item
It works only for connection methods defined in @file{tramp-sh.el} and
@file{tramp-adb.el}.
@item
It does not support multi-hop methods.
@item
It does not support interactive user authentication, like password
handling.
@item
It does not support a separated error stream.
@item
It cannot be killed via @code{interrupt-process}.
@item
It does not report the remote terminal name via @code{process-tty-name}.
@item
It does not use @code{tramp-remote-path} and
@code{tramp-remote-process-environment}.
@item
It does not set environment variable @env{INSIDE_EMACS}.
@end itemize
In order to gain even more performance, it is recommended to bind
@code{tramp-verbose} to 0 when running @code{make-process} or
@code{start-file-process}.
@node Cleanup remote connections
@section Cleanup remote connections
@cindex cleanup
@ -4555,9 +4625,8 @@ Abbreviation list expansion can be used to reduce typing long file names:
@lisp
@group
(add-to-list
'directory-abbrev-alist
'("^/xy" . "@trampfn{ssh,news@@news.my.domain,/opt/news/etc/}"))
(add-to-list 'directory-abbrev-alist
'("^/xy" . "@trampfn{ssh,news@@news.my.domain,/opt/news/etc/}"))
@end group
@end lisp

25
etc/MACHINES
View file

@ -81,25 +81,26 @@ the list at the end of this file.
** Solaris
On Solaris it is also possible to use either GCC or Solaris Studio
to build Emacs, by pointing ./configure to the right compiler:
On Solaris it is also possible to use either GCC or Oracle Developer
Studio to build Emacs, by pointing ./configure to the right compiler:
./configure CC='/usr/sfw/bin/gcc' # GCC
./configure CC='cc' # Solaris Studio
./configure # Defaults to 'gcc' if available.
./configure CC='cc' # Oracle Developer Studio
On Solaris, do not use /usr/ucb/cc. Use /opt/SUNWspro/bin/cc. Make
sure that /usr/ccs/bin and /opt/SUNWspro/bin are in your PATH before
/usr/ucb. (Most free software packages have the same requirement on
Solaris.) With this compiler, use '/opt/SUNWspro/bin/cc -E' as the
On Solaris, do not use /usr/ucb/cc. Use Oracle Developer Studio.
Make sure that /usr/ccs/bin and the Oracle Developer Studio bin
directory (e.g., /opt/developerstudio12.6/bin) are in your PATH
before /usr/ucb. (Most free software packages have the same
requirement on Solaris.) With this compiler, use 'cc -E' as the
preprocessor. If this inserts extra whitespace into its output (see
the PROBLEMS file) then add the option '-Xs'.
the PROBLEMS file), add the option '-Xs'.
To build a 64-bit Emacs (with larger maximum buffer size) on a
Solaris system which supports 64-bit executables, specify the -m64
Solaris system that defaults to 32-bit executables, specify the -m64
compiler option. For example:
./configure CC='/usr/sfw/bin/gcc -m64' # GCC
./configure CC='cc -m64' # Solaris Studio
./configure CC='gcc -m64' # GCC
./configure CC='cc -m64' # Oracle Developer Studio
* Obsolete platforms

160
etc/NEWS
View file

@ -58,6 +58,11 @@ shaping, so 'configure' now recommends that combination.
** The ftx font backend driver has been removed.
It was declared obsolete in Emacs 27.1.
---
** Support for building with '-fcheck-pointer-bounds' has been removed.
GCC has withdrawn the '-fcheck-pointer-bounds' option and support for
its implementation has been removed from the Linux kernel.
---
** Emacs no longer supports old OpenBSD systems.
OpenBSD 5.3 and older releases are no longer supported, as they lack
@ -75,6 +80,11 @@ useful on systems such as FreeBSD which ships only with "etc/termcap".
* Changes in Emacs 28.1
+++
** The new constants 'shell-command-buffer-name' and
'shell-command-buffer-name-async' store the default buffer names
for the output of shell commands.
** Support for '(box . SIZE)' 'cursor-type'.
By default, 'box' cursor always has a filled box shape. But if you
specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow
@ -117,6 +127,11 @@ horizontal movements now stop at the edge of the board.
** Autosaving via 'auto-save-visited-mode' can now be inhibited by
setting the variable 'auto-save-visited-mode' buffer-locally to nil.
** New commands to describe buttons and widgets have been added.
'widget-describe' (on a widget) will pop up a help buffer and give a
description of the properties. Likewise 'button-describe' does the
same for a button.
* Changes in Specialized Modes and Packages in Emacs 28.1
@ -170,6 +185,11 @@ and variables.
'archive-hideshow-column'. These let you control which columns are
displayed and which are kept hidden.
---
*** New command bound to 'C': 'archive-copy-file'
This command extracts the file under point and writes the data to a
file.
** Emacs Lisp mode
*** The mode-line now indicates whether we're using lexical or dynamic scoping.
@ -179,6 +199,13 @@ The presence of a space between an open paren and a symbol now is
taken as a statement by the programmer that this should be indented
as a data list rather than as a piece of code.
** Calendar
*** New variable 'calendar-use-numeric-time-zones' to use numeric time zones.
If non-nil, functions that display time zones (like the 'S' command in
calendar mode that displays the sunrise time) will display time zones
like "+0100" instead of "CET".
** Dired
*** New user option 'dired-mark-region' affects all Dired commands
@ -205,6 +232,15 @@ their 'default-directory' under VC.
*** Support for bookmark.el.
Bookmark locations can refer to VC directory buffers.
---
*** New user option 'vc-hg-create-bookmark' controls whether a bookmark
or branch will be created when you invoke 'C-u C-x v s' ('vc-create-tag').
---
*** 'vc-hg' now uses 'hg summary' command to populate extra 'vc-dir'
headers.
** Gnus
---
@ -223,6 +259,40 @@ The names of the commands 'gnus-slave', 'gnus-slave-no-server' and
*** The 'W Q' summary mode command now takes a numerical prefix to
allow adjusting the fill width.
+++
*** New variable 'mm-inline-font-lock'.
This variable is supposed to be bound by callers to determine whether
inline MIME parts (that support it) are supposed to be font-locked or
not.
** Message
+++
*** Message now supports the OpenPGP header.
To generate these headers, add the new function
'message-add-openpgp-header' to 'message-send-hook'. The header will
be generated according to the new 'message-openpgp-header' variable.
---
*** A change to how Mail-Copies-To: never is handled.
If a user has specified Mail-Copies-To: never, and Message was asked
to do a "wide reply", some other arbitrary recipient would end up in
the resulting To header, while the remaining recipients would be put
in the Cc header. This is somewhat misleading, as it looks like
you're responding to a specific person in particular. This has been
changed so that all the recipients are put in the To header in these
instances.
+++
*** New function to start Emacs in Message mode to send an email.
Emacs can be defined as a handler for the "x-scheme-handler/mailto"
MIME type with the following command: "emacs -f message-mailto %u".
An emacs-mail.desktop file has been included, suitable for installing
in desktop directories like /usr/share/applications. Clicking on a
mailto: link in other applications will then open Emacs with headers
filled out according to the link, e.g.
"mailto:larsi@gnus.org?subject=This+is+a+test".
---
*** Change to default value of 'message-draft-headers' user option.
The 'Date' symbol has been removed from the default value, meaning that
@ -231,6 +301,12 @@ was sent. To restore the original behavior of dating a message
from when it is first saved or delayed, add the symbol 'Date' back to
this user option.
+++
*** New command to take screenshots.
In Message mode buffers, the 'C-c C-p' ('message-insert-screenshot')
command has been added. It depends on using an external program to
take the actual screenshot, and defaults to ImageMagick "import".
** Help
+++
@ -260,6 +336,10 @@ To revert to the previous behaviour,
unconditionally aborts the current edebug instrumentation with the
supplied error message.
*** Edebug specification lists can use the new keyword ':unique',
which appends a unique suffix to the Edebug name of the current
definition.
+++
** ElDoc
@ -314,6 +394,16 @@ This command marks a remote directory to contain only encrypted files.
See the "(tramp) Keeping files encrypted" node of the Tramp manual for
details. This feature is experimental.
+++
*** Support of direct asynchronous process invocation.
When Tramp connection property "direct-async-process" is set to
non-nil for a given connection, 'make-process' and 'start-file-process'
calls are performed directly as in "ssh ... <command>". This avoids
initialization performance penalties. See the "(tramp) Improving
performance of asynchronous remote processes" node of the Tramp manual
for details, and also for a discussion or restrictions. This feature
is experimental.
** Tempo
---
@ -398,6 +488,14 @@ to substitute spaces in regexp search.
*** The default value of 'hi-lock-highlight-range' was enlarged.
The new default value is 2000000 (2 megabytes).
** Whitespace mode
+++
*** New style 'missing-newline-at-eof'.
If present in 'whitespace-style' (as it is by default), the final
character in the buffer will be highlighted if the buffer doesn't end
with a newline.
** Texinfo
---
@ -476,6 +574,9 @@ either an internal or external browser.
*** Support for the conkeror browser is now obsolete.
*** Support for the Mosaic browser has been removed.
This support has been obsolete since 25.1.
** SHR
---
@ -505,8 +606,23 @@ took more than two seconds to display. The new algorithm maintains a
decaying average of delays, and if this number gets too high, the
animation is stopped.
+++
*** The 'n' and 'p' commands (next/previous image) now respects dired order.
These commands would previously display the next/previous image in
alphabetical order, but will now find the "parent" dired buffer and
select the next/previous image file according to how the files are
sorted there. The commands have also been extended to work when the
"parent" buffer is an archive mode (i.e., zip file or the like) or tar
mode buffer.
** EWW
+++
*** New Emacs command line convenience function.
The 'eww-browse' command has been added, which allows you to register
Emacs as a MIME handler for "text/x-uri", and will call eww on the
supplied URL. Usage example: emacs -f eww-browse https://gnu.org
+++
*** 'eww-download-directory' will now use the XDG location, if defined.
However, if "~/Downloads/" already exists, that will continue to be
@ -565,6 +681,12 @@ Previously 'xml-print' would produce invalid XML when given a string
with characters that are not valid in XML (see
https://www.w3.org/TR/xml/#charsets). Now it rejects such strings.
** erc
---
*** The /ignore command will now ask for a timeout to stop ignoring the user.
Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m".
** Battery
---
@ -601,6 +723,34 @@ custom rules, see the variables 'bug-reference-setup-from-vc-alist',
'bug-reference-setup-from-mail-alist', and
'bug-reference-setup-from-irc-alist'.
** HTML Mode
---
*** A new skeleton for adding relative URLs has been added.
It's bound to the 'C-c C-c f' keystroke, and prompts for a local file
name.
---
** Recentf
The recentf files are no longer backed up.
** Miscellaneous
*** The new library hierarchy.el has been added.
It's a library to create, query, navigate and display hierarchy
structures.
---
*** The width of the buffer-name column in 'list-buffers' is now dynamic.
The width now depends of the width of the window, but will never be
wider than the length of the longest buffer name, except that it will
never be narrower than 19 characters.
*** Bookmarks can now be targets for new tabs.
When the 'bookmark.el' library is loaded, a customize choice is added
to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list.
* New Modes and Packages in Emacs 28.1
@ -678,6 +828,11 @@ have now been removed.
* Lisp Changes in Emacs 28.1
---
** New function 'custom-add-choice'.
This function can be used by modes to add elements to the
'choice' customization type of a variable.
+++
** New function 'file-modes-number-to-symbolic' to convert a numeric
file mode specification into symbolic form.
@ -706,6 +861,11 @@ optional argument specifying whether to follow symbolic links.
** 'parse-time-string' can now parse ISO 8601 format strings,
such as "2020-01-15T16:12:21-08:00".
---
** The new function 'decoded-time-period' has been added.
It interprets a decoded time structure as a period and returns the
equivalent period in seconds.
+++
** The new function 'dom-remove-attribute' has been added.

135
etc/PROBLEMS
View file

@ -2222,6 +2222,7 @@ We list bugs in current versions here. See also the section on legacy
systems.
*** On Solaris 10, Emacs crashes during the build process.
(This applies only with './configure --with-unexec=yes', which is rare.)
This was reported for Emacs 25.2 on i386-pc-solaris2.10 with Sun
Studio 12 (Sun C 5.9) and with Oracle Developer Studio 12.6 (Sun C
5.15), and intermittently for sparc-sun-solaris2.10 with Oracle
@ -2239,66 +2240,6 @@ Solaris. See Bug#26638.
This is a Solaris feature (at least on Intel x86 cpus). Type C-r
C-r C-t, to toggle whether C-x gets through to Emacs.
*** Problem with remote X server on Suns.
On a Sun, running Emacs on one machine with the X server on another
may not work if you have used the unshared system libraries. This
is because the unshared libraries fail to use YP for host name lookup.
As a result, the host name you specify may not be recognized.
*** Solaris 2.6: Emacs crashes with SIGBUS or SIGSEGV on Solaris after you delete a frame.
We suspect that this is a bug in the X libraries provided by
Sun. There is a report that one of these patches fixes the bug and
makes the problem stop:
105216-01 105393-01 105518-01 105621-01 105665-01 105615-02 105216-02
105667-01 105401-08 105615-03 105621-02 105686-02 105736-01 105755-03
106033-01 105379-01 105786-01 105181-04 105379-03 105786-04 105845-01
105284-05 105669-02 105837-01 105837-02 105558-01 106125-02 105407-01
Another person using a newer system (kernel patch level Generic_105181-06)
suspects that the bug was fixed by one of these more recent patches:
106040-07 SunOS 5.6: X Input & Output Method patch
106222-01 OpenWindows 3.6: filemgr (ff.core) fixes
105284-12 Motif 1.2.7: sparc Runtime library patch
*** Solaris 7 or 8: Emacs reports a BadAtom error (from X)
This happens when Emacs was built on some other version of Solaris.
Rebuild it on Solaris 8.
*** When using M-x dbx with the SparcWorks debugger, the 'up' and 'down'
commands do not move the arrow in Emacs.
You can fix this by adding the following line to '~/.dbxinit':
dbxenv output_short_file_name off
*** On Solaris, CTRL-t is ignored by Emacs when you use
the fr.ISO-8859-15 locale (and maybe other related locales).
You can fix this by editing the file:
/usr/openwin/lib/locale/iso8859-15/Compose
Near the bottom there is a line that reads:
Ctrl<t> <quotedbl> <Y> : "\276" threequarters
while it should read:
Ctrl<T> <quotedbl> <Y> : "\276" threequarters
Note the lower case <t>. Changing this line should make C-t work.
*** On Solaris, Emacs fails to set menu-bar-update-hook on startup, with error
"Error in menu-bar-update-hook: (error Point before start of properties)".
This seems to be a GCC optimization bug that occurs for GCC 4.1.2 (-g
and -g -O2) and GCC 4.2.3 (-g -O and -g -O2). You can fix this by
compiling with GCC 4.2.3 or CC 5.7, with no optimizations.
* Runtime problems specific to MS-Windows
** Emacs on Windows 9X requires UNICOWS.DLL
@ -2733,13 +2674,13 @@ Libxpm is available for macOS as part of the XQuartz project.
This indicates a mismatch between the C compiler and preprocessor that
configure is using. For example, on Solaris 10 trying to use
CC=/opt/SUNWspro/bin/cc (the Sun Studio compiler) together with
CPP=/usr/ccs/lib/cpp can result in errors of this form (you may also
see the error '"/usr/include/sys/isa_defs.h", line 500: undefined control').
CC=/opt/developerstudio12.6/bin/cc (the Oracle Developer Studio
compiler) together with CPP=/usr/lib/cpp can result in errors of
this form.
The solution is to tell configure to use the correct C preprocessor
for your C compiler (CPP="/opt/SUNWspro/bin/cc -E" in the above
example).
for your C compiler (CPP="/opt/developerstudio12.6/bin/cc -E" in the
above example).
** Compilation
@ -3110,7 +3051,69 @@ This section covers bugs reported on very old hardware or software.
If you are using hardware and an operating system shipped after 2000,
it is unlikely you will see any of these.
*** Solaris 2.x
** Solaris
*** Problem with remote X server on Suns.
On a Sun, running Emacs on one machine with the X server on another
may not work if you have used the unshared system libraries. This
is because the unshared libraries fail to use YP for host name lookup.
As a result, the host name you specify may not be recognized.
*** Solaris 2.6: Emacs crashes with SIGBUS or SIGSEGV on Solaris after you delete a frame.
We suspect that this is a bug in the X libraries provided by
Sun. There is a report that one of these patches fixes the bug and
makes the problem stop:
105216-01 105393-01 105518-01 105621-01 105665-01 105615-02 105216-02
105667-01 105401-08 105615-03 105621-02 105686-02 105736-01 105755-03
106033-01 105379-01 105786-01 105181-04 105379-03 105786-04 105845-01
105284-05 105669-02 105837-01 105837-02 105558-01 106125-02 105407-01
Another person using a newer system (kernel patch level Generic_105181-06)
suspects that the bug was fixed by one of these more recent patches:
106040-07 SunOS 5.6: X Input & Output Method patch
106222-01 OpenWindows 3.6: filemgr (ff.core) fixes
105284-12 Motif 1.2.7: sparc Runtime library patch
*** Solaris 7 or 8: Emacs reports a BadAtom error (from X)
This happens when Emacs was built on some other version of Solaris.
Rebuild it on Solaris 8.
*** When using M-x dbx with the SparcWorks debugger, the 'up' and 'down'
commands do not move the arrow in Emacs.
You can fix this by adding the following line to '~/.dbxinit':
dbxenv output_short_file_name off
*** On Solaris, CTRL-t is ignored by Emacs when you use
the fr.ISO-8859-15 locale (and maybe other related locales).
You can fix this by editing the file:
/usr/openwin/lib/locale/iso8859-15/Compose
Near the bottom there is a line that reads:
Ctrl<t> <quotedbl> <Y> : "\276" threequarters
while it should read:
Ctrl<T> <quotedbl> <Y> : "\276" threequarters
Note the lower case <t>. Changing this line should make C-t work.
*** On Solaris, Emacs fails to set menu-bar-update-hook on startup, with error
"Error in menu-bar-update-hook: (error Point before start of properties)".
This seems to be a GCC optimization bug that occurs for GCC 4.1.2 (-g
and -g -O2) and GCC 4.2.3 (-g -O and -g -O2). You can fix this by
compiling with GCC 4.2.3 or CC 5.7, with no optimizations.
*** Other legacy Solaris problems
**** Strange results from format %d in a few cases, on a Sun.

10
etc/emacs-mail.desktop Normal file
View file

@ -0,0 +1,10 @@
[Desktop Entry]
Categories=Network;Email;
Comment=GNU Emacs is an extensible, customizable text editor - and more
Exec=emacs -f message-mailto %u
Icon=emacs
Name=Emacs (Mail)
MimeType=x-scheme-handler/mailto;
NoDisplay=false
Terminal=false
Type=Application

682
etc/themes/leuven-theme.el
View file

File diff suppressed because it is too large Load diff

14
etc/tutorials/TUTORIAL
View file

@ -612,11 +612,11 @@ but it also means that you need a convenient way to save the first
file's buffer. Having to switch back to that buffer, in order to save
it with C-x C-s, would be a nuisance. So we have
C-x s Save some buffers
C-x s Save some buffers to their files
C-x s asks you about each buffer which contains changes that you have
not saved. It asks you, for each such buffer, whether to save the
buffer.
C-x s asks you about each file-visiting buffer which contains changes
that you have not saved. It asks you, for each such buffer, whether
to save the buffer to its file.
>> Insert a line of text, then type C-x s.
It should ask you whether to save the buffer named TUTORIAL.
@ -660,8 +660,8 @@ as by a mail handling utility.
There are many C-x commands. Here is a list of the ones you have learned:
C-x C-f Find file
C-x C-s Save file
C-x s Save some buffers
C-x C-s Save buffer to file
C-x s Save some buffers to their files
C-x C-b List buffers
C-x b Switch buffer
C-x C-c Quit Emacs
@ -1081,7 +1081,7 @@ corresponding command names (such as C-x C-f beside find-file).
You can learn more about Emacs by reading its manual, either as a
printed book, or inside Emacs (use the Help menu or type C-h r).
Two features that you may like especially are completion, which saves
typing, and dired, which simplifies file handling.
typing, and Dired, which simplifies file handling.
Completion is a way to avoid unnecessary typing. For instance, if you
want to switch to the *Messages* buffer, you can type C-x b *M<Tab>

4
lib/c++defs.h
View file

@ -268,7 +268,7 @@
_GL_CXXALIASWARN_2 (func, namespace)
/* To work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>,
we enable the warning only when not optimizing. */
# if !__OPTIMIZE__
# if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__)
# define _GL_CXXALIASWARN_2(func,namespace) \
_GL_WARN_ON_USE (func, \
"The symbol ::" #func " refers to the system function. " \
@ -296,7 +296,7 @@
_GL_CXXALIASWARN1_2 (func, rettype, parameters_and_attributes, namespace)
/* To work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>,
we enable the warning only when not optimizing. */
# if !__OPTIMIZE__
# if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__)
# define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \
_GL_WARN_ON_USE_CXX (func, rettype, parameters_and_attributes, \
"The symbol ::" #func " refers to the system function. " \

2
lib/cdefs.h
View file

@ -401,7 +401,7 @@
# endif
#endif
#if __GNUC__ >= 3
#if (__GNUC__ >= 3) || (__clang_major__ >= 4)
# define __glibc_unlikely(cond) __builtin_expect ((cond), 0)
# define __glibc_likely(cond) __builtin_expect ((cond), 1)
#else

3
lib/count-leading-zeros.h
View file

@ -38,7 +38,8 @@ extern "C" {
expand to code that computes the number of leading zeros of the local
variable 'x' of type TYPE (an unsigned integer type) and return it
from the current function. */
#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) \
|| (__clang_major__ >= 4)
# define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
return x ? BUILTIN (x) : CHAR_BIT * sizeof x;
#elif _MSC_VER

3
lib/count-trailing-zeros.h
View file

@ -38,7 +38,8 @@ extern "C" {
expand to code that computes the number of trailing zeros of the local
variable 'x' of type TYPE (an unsigned integer type) and return it
from the current function. */
#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) \
|| (__clang_major__ >= 4)
# define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \
return x ? BUILTIN (x) : CHAR_BIT * sizeof x;
#elif _MSC_VER

13
lib/gnulib.mk.in
View file

@ -246,9 +246,10 @@ GL_GENERATE_ALLOCA_H = @GL_GENERATE_ALLOCA_H@
GL_GENERATE_BYTESWAP_H = @GL_GENERATE_BYTESWAP_H@
GL_GENERATE_ERRNO_H = @GL_GENERATE_ERRNO_H@
GL_GENERATE_EXECINFO_H = @GL_GENERATE_EXECINFO_H@
GL_GENERATE_GMP_H = @GL_GENERATE_GMP_H@
GL_GENERATE_GMP_GMP_H = @GL_GENERATE_GMP_GMP_H@
GL_GENERATE_IEEE754_H = @GL_GENERATE_IEEE754_H@
GL_GENERATE_LIMITS_H = @GL_GENERATE_LIMITS_H@
GL_GENERATE_MINI_GMP_H = @GL_GENERATE_MINI_GMP_H@
GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@
GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@
GL_GENERATE_STDINT_H = @GL_GENERATE_STDINT_H@
@ -1085,7 +1086,6 @@ gamedir = @gamedir@
gamegroup = @gamegroup@
gameuser = @gameuser@
gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 = @gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7@
gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9 = @gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9@
gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b = @gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b@
gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31@
gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c@
@ -2021,15 +2021,22 @@ ifeq (,$(OMIT_GNULIB_MODULE_libgmp))
BUILT_SOURCES += $(GMP_H)
ifneq (,$(GL_GENERATE_MINI_GMP_H))
# Build gmp.h as a wrapper for mini-gmp.h when using mini-gmp.
ifneq (,$(GL_GENERATE_GMP_H))
gmp.h: $(top_builddir)/config.status
echo '#include "mini-gmp.h"' >$@-t
mv $@-t $@
else
ifneq (,$(GL_GENERATE_GMP_GMP_H))
# Build gmp.h as a wrapper for gmp/gmp.h.
gmp.h: $(top_builddir)/config.status
echo '#include <gmp/gmp.h>' >$@-t
mv $@-t $@
else
gmp.h: $(top_builddir)/config.status
rm -f $@
endif
endif
MOSTLYCLEANFILES += gmp.h gmp.h-t
EXTRA_DIST += mini-gmp-gnulib.c mini-gmp.c mini-gmp.h

1
lisp/Makefile.in
View file

@ -205,7 +205,6 @@ $(lisp)/finder-inf.el:
autoloads .PHONY: $(lisp)/loaddefs.el
$(lisp)/loaddefs.el: gen-lisp $(LOADDEFS)
@echo Directories for loaddefs: ${SUBDIRS_ALMOST}
$(AM_V_GEN)$(emacs) -l autoload \
--eval '(setq autoload-ensure-writable t)' \
--eval '(setq autoload-builtin-package-versions t)' \

115
lisp/arc-mode.el
View file

@ -391,6 +391,7 @@ file. Archive and member name will be added."
(define-key map "e" 'archive-extract)
(define-key map "f" 'archive-extract)
(define-key map "\C-m" 'archive-extract)
(define-key map "C" 'archive-copy-file)
(define-key map "m" 'archive-mark)
(define-key map "n" 'archive-next-line)
(define-key map "\C-n" 'archive-next-line)
@ -430,6 +431,9 @@ file. Archive and member name will be added."
(define-key map [menu-bar immediate view]
'(menu-item "View This File" archive-view
:help "Display file at cursor in View Mode"))
(define-key map [menu-bar immediate view]
'(menu-item "Copy This File" archive-copy-file
:help "Copy file at cursor to another location"))
(define-key map [menu-bar immediate display]
'(menu-item "Display in Other Window" archive-display-other-window
:help "Display file at cursor in another window"))
@ -989,6 +993,75 @@ using `make-temp-file', and the generated name is returned."
(kill-local-variable 'buffer-file-coding-system)
(after-insert-file-set-coding (- (point-max) (point-min))))))
(defun archive-goto-file (file)
"Go to FILE in the current buffer.
FILE should be a relative file name. If FILE can't be found,
return nil. Otherwise point is returned."
(let ((start (point))
found)
(goto-char (point-min))
(while (and (not found)
(not (eobp)))
(forward-line 1)
(when-let ((descr (archive-get-descr t)))
(when (equal (archive--file-desc-ext-file-name descr) file)
(setq found t))))
(if (not found)
(progn
(goto-char start)
nil)
(point))))
(defun archive-next-file-displayer (file regexp n)
"Return a closure to display the next file after FILE that matches REGEXP."
(let ((short (replace-regexp-in-string "\\`.*:" "" file))
next)
(archive-goto-file short)
(while (and (not next)
;; Stop if we reach the end/start of the buffer.
(if (> n 0)
(not (eobp))
(not (save-excursion
(beginning-of-line)
(bobp)))))
(archive-next-line n)
(when-let ((descr (archive-get-descr t)))
(let ((candidate (archive--file-desc-ext-file-name descr))
(buffer (current-buffer)))
(when (and candidate
(string-match-p regexp candidate))
(setq next (lambda ()
(kill-buffer (current-buffer))
(switch-to-buffer buffer)
(archive-extract)))))))
(unless next
;; If we didn't find a next/prev file, then restore
;; point.
(archive-goto-file short))
next))
(defun archive-copy-file (file new-name)
"Copy FILE to a location specified by NEW-NAME.
Interactively, FILE is the file at point, and the function prompts
for NEW-NAME."
(interactive
(let ((name (archive--file-desc-ext-file-name (archive-get-descr))))
(list name
(read-file-name (format "Copy %s to: " name)))))
(when (file-directory-p new-name)
(setq new-name (expand-file-name file new-name)))
(when (and (file-exists-p new-name)
(not (yes-or-no-p (format "%s already exists; overwrite? "
new-name))))
(user-error "Not overwriting %s" new-name))
(let* ((descr (archive-get-descr))
(archive (buffer-file-name))
(extractor (archive-name "extract"))
(ename (archive--file-desc-ext-file-name descr)))
(with-temp-buffer
(archive--extract-file extractor archive ename)
(write-region (point-min) (point-max) new-name))))
(defun archive-extract (&optional other-window-p event)
"In archive mode, extract this entry of the archive into its own buffer."
(interactive (list nil last-input-event))
@ -1030,26 +1103,7 @@ using `make-temp-file', and the generated name is returned."
(setq archive-subfile-mode descr)
(setq archive-file-name-coding-system file-name-coding)
(if (and
(null
(let (;; We may have to encode the file name argument for
;; external programs.
(coding-system-for-write
(and enable-multibyte-characters
archive-file-name-coding-system))
;; We read an archive member by no-conversion at
;; first, then decode appropriately by calling
;; archive-set-buffer-as-visiting-file later.
(coding-system-for-read 'no-conversion)
;; Avoid changing dir mtime by lock_file
(create-lockfiles nil))
(condition-case err
(if (fboundp extractor)
(funcall extractor archive ename)
(archive-*-extract archive ename
(symbol-value extractor)))
(error
(ding (message "%s" (error-message-string err)))
nil))))
(null (archive--extract-file extractor archive ename))
just-created)
(progn
(set-buffer-modified-p nil)
@ -1082,6 +1136,27 @@ using `make-temp-file', and the generated name is returned."
(other-window-p (switch-to-buffer-other-window buffer))
(t (switch-to-buffer buffer))))))
(defun archive--extract-file (extractor archive ename)
(let (;; We may have to encode the file name argument for
;; external programs.
(coding-system-for-write
(and enable-multibyte-characters
archive-file-name-coding-system))
;; We read an archive member by no-conversion at
;; first, then decode appropriately by calling
;; archive-set-buffer-as-visiting-file later.
(coding-system-for-read 'no-conversion)
;; Avoid changing dir mtime by lock_file
(create-lockfiles nil))
(condition-case err
(if (fboundp extractor)
(funcall extractor archive ename)
(archive-*-extract archive ename
(symbol-value extractor)))
(error
(ding (message "%s" (error-message-string err)))
nil))))
(defun archive-*-extract (archive name command)
(let* ((default-directory (file-name-as-directory archive-tmpdir))
(tmpfile (expand-file-name (file-name-nondirectory name)

13
lisp/bookmark.el
View file

@ -1666,6 +1666,19 @@ Don't affect the buffer ring order."
(bookmark-bmenu-list)))))
;;;###autoload
(defun bookmark-bmenu-get-buffer ()
"Return the Bookmark List, building it if it doesn't exists.
Don't affect the buffer ring order."
(or (get-buffer bookmark-bmenu-buffer)
(save-excursion
(save-window-excursion
(bookmark-bmenu-list)
(get-buffer bookmark-bmenu-buffer)))))
(custom-add-choice 'tab-bar-new-tab-choice
'(const :tag "Bookmark List" bookmark-bmenu-get-buffer))
;;;###autoload
(defun bookmark-bmenu-list ()
"Display a list of existing bookmarks.

60
lisp/buff-menu.el
View file

@ -69,11 +69,26 @@ minus `Buffer-menu-size-width'. This use is deprecated."
"use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead."
"24.3")
(defcustom Buffer-menu-name-width 19
"Width of buffer name column in the Buffer Menu."
:type 'number
(defun Buffer-menu--dynamic-name-width (buffers)
"Return a name column width based on the current window width.
The width will never exceed the actual width of the buffer names,
but will never be narrower than 19 characters."
(max 19
;; This gives 19 on an 80 column window, and take up
;; proportionally more space as the window widens.
(min (truncate (/ (window-width) 4.2))
(apply #'max 0 (mapcar (lambda (b)
(length (buffer-name b)))
buffers)))))
(defcustom Buffer-menu-name-width #'Buffer-menu--dynamic-name-width
"Width of buffer name column in the Buffer Menu.
This can either be a number (used directly) or a function that
will be called with the list of buffers and should return a
number."
:type '(choice function number)
:group 'Buffer-menu
:version "24.3")
:version "28.1")
(defcustom Buffer-menu-size-width 7
"Width of buffer size column in the Buffer Menu."
@ -488,8 +503,9 @@ Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are deleted
(defun Buffer-menu-select ()
"Select this line's buffer; also, display buffers marked with `>'.
You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' command.
This command deletes and replaces all the previously existing windows
in the selected frame."
in the selected frame, and will remove any marks."
(interactive)
(let* ((this-buffer (Buffer-menu-buffer t))
(menu-buffer (current-buffer))
@ -645,25 +661,11 @@ means list those buffers and no others."
(defun list-buffers--refresh (&optional buffer-list old-buffer)
;; Set up `tabulated-list-format'.
(let ((name-width Buffer-menu-name-width)
(size-width Buffer-menu-size-width)
(let ((size-width Buffer-menu-size-width)
(marked-buffers (Buffer-menu-marked-buffers))
(buffer-menu-buffer (current-buffer))
(show-non-file (not Buffer-menu-files-only))
entries)
;; Handle obsolete variable:
(if Buffer-menu-buffer+size-width
(setq name-width (- Buffer-menu-buffer+size-width size-width)))
(setq tabulated-list-format
(vector '("C" 1 t :pad-right 0)
'("R" 1 t :pad-right 0)
'("M" 1 t)
`("Buffer" ,name-width t)
`("Size" ,size-width tabulated-list-entry-size->
:right-align t)
`("Mode" ,Buffer-menu-mode-width t)
'("File" 1 t)))
(setq tabulated-list-use-header-line Buffer-menu-use-header-line)
entries name-width)
;; Collect info for each buffer we're interested in.
(dolist (buffer (or buffer-list
(buffer-list (if Buffer-menu-use-frame-buffer-list
@ -693,6 +695,22 @@ means list those buffers and no others."
nil nil buffer)))
(Buffer-menu--pretty-file-name file)))
entries)))))
(setq name-width (if (functionp Buffer-menu-name-width)
(funcall Buffer-menu-name-width (mapcar #'car entries))
Buffer-menu-name-width))
;; Handle obsolete variable:
(if Buffer-menu-buffer+size-width
(setq name-width (- Buffer-menu-buffer+size-width size-width)))
(setq tabulated-list-format
(vector '("C" 1 t :pad-right 0)
'("R" 1 t :pad-right 0)
'("M" 1 t)
`("Buffer" ,name-width t)
`("Size" ,size-width tabulated-list-entry-size->
:right-align t)
`("Mode" ,Buffer-menu-mode-width t)
'("File" 1 t)))
(setq tabulated-list-use-header-line Buffer-menu-use-header-line)
(setq tabulated-list-entries (nreverse entries)))
(tabulated-list-init-header))

51
lisp/button.el
View file

@ -464,8 +464,12 @@ see).
POS defaults to point, except when `push-button' is invoked
interactively as the result of a mouse-event, in which case, the
mouse event is used.
If there's no button at POS, do nothing and return nil, otherwise
return t."
return t.
To get a description of what function will called when pushing a
butting, use the `button-describe' command."
(interactive
(list (if (integerp last-command-event) (point) last-command-event)))
(if (and (not (integerp pos)) (eventp pos))
@ -555,6 +559,51 @@ Returns the button found."
(interactive "p\nd\nd")
(forward-button (- n) wrap display-message no-error))
(defun button--describe (properties)
"Describe a button's PROPERTIES (an alist) in a *Help* buffer.
This is a helper function for `button-describe', in order to be possible to
use `help-setup-xref'.
Each element of PROPERTIES should be of the form (PROPERTY . VALUE)."
(help-setup-xref (list #'button--describe properties)
(called-interactively-p 'interactive))
(with-help-window (help-buffer)
(with-current-buffer (help-buffer)
(insert (format-message "This button's type is `%s'."
(alist-get 'type properties)))
(dolist (prop '(action mouse-action))
(let ((name (symbol-name prop))
(val (alist-get prop properties)))
(when (functionp val)
(insert "\n\n"
(propertize (capitalize name) 'face 'bold)
"\nThe " name " of this button is")
(if (symbolp val)
(progn
(insert (format-message " `%s',\nwhich is " val))
(describe-function-1 val))
(insert "\n")
(princ val))))))))
(defun button-describe (&optional button-or-pos)
"Display a buffer with information about the button at point.
When called from Lisp, pass BUTTON-OR-POS as the button to describe, or a
buffer position where a button is present. If BUTTON-OR-POS is nil, the
button at point is the button to describe."
(interactive "d")
(let* ((button (cond ((integer-or-marker-p button-or-pos)
(button-at button-or-pos))
((null button-or-pos) (button-at (point)))
((overlayp button-or-pos) button-or-pos)))
(props (and button
(mapcar (lambda (prop)
(cons prop (button-get button prop)))
'(type action mouse-action)))))
(when props
(button--describe props)
t)))
(provide 'button)
;;; button.el ends here

16
lisp/calendar/cal-dst.el
View file

@ -350,17 +350,29 @@ If the locale never uses daylight saving time, set this to 0."
:group 'calendar-dst)
(defcustom calendar-standard-time-zone-name
(or (nth 2 calendar-current-time-zone-cache) "EST")
(if calendar-use-numeric-time-zones
(if calendar-current-time-zone-cache
(format-time-string
"%z" 0 (* 60 (car calendar-current-time-zone-cache)))
"+0000")
(or (nth 2 calendar-current-time-zone-cache) "EST"))
"Abbreviated name of standard time zone at `calendar-location-name'.
For example, \"EST\" in New York City, \"PST\" for Los Angeles."
:type 'string
:version "28.1"
:group 'calendar-dst)
(defcustom calendar-daylight-time-zone-name
(or (nth 3 calendar-current-time-zone-cache) "EDT")
(if calendar-use-numeric-time-zones
(if calendar-current-time-zone-cache
(format-time-string
"%z" 0 (* 60 (cadr calendar-current-time-zone-cache)))
"+0000")
(or (nth 3 calendar-current-time-zone-cache) "EDT"))
"Abbreviated name of daylight saving time zone at `calendar-location-name'.
For example, \"EDT\" in New York City, \"PDT\" for Los Angeles."
:type 'string
:version "28.1"
:group 'calendar-dst)
(defcustom calendar-daylight-savings-starts-time

7
lisp/calendar/calendar.el
View file

@ -1061,6 +1061,13 @@ calendar."
:type 'boolean
:group 'holidays)
(defcustom calendar-use-numeric-time-zones nil
"If nil, use symbolic time zones like \"CET\" when displaying dates.
If non-nil, use numeric time zones like \"+0100\"."
:type 'boolean
:version "28.1"
:group 'calendar)
;;; End of user options.
(calendar-recompute-layout-variables)

10
lisp/calendar/solar.el
View file

@ -209,7 +209,6 @@ Returns nil if nothing was entered."
(defun solar-setup ()
"Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'."
(beep)
(or calendar-longitude
(setq calendar-longitude
(solar-get-number
@ -840,7 +839,9 @@ This function is suitable for execution in an init file."
"E" "W"))))))
(calendar-standard-time-zone-name
(if (< arg 16) calendar-standard-time-zone-name
(cond ((zerop calendar-time-zone) "UTC")
(cond ((zerop calendar-time-zone)
(if calendar-use-numeric-time-zones
"+0100" "UTC"))
((< calendar-time-zone 0)
(format "UTC%dmin" calendar-time-zone))
(t (format "UTC+%dmin" calendar-time-zone)))))
@ -1013,7 +1014,10 @@ Requires floating point."
(let* ((m displayed-month)
(y displayed-year)
(calendar-standard-time-zone-name
(if calendar-time-zone calendar-standard-time-zone-name "UTC"))
(cond
(calendar-time-zone calendar-standard-time-zone-name)
(calendar-use-numeric-time-zones "+0100")
(t "UTC")))
(calendar-daylight-savings-starts
(if calendar-time-zone calendar-daylight-savings-starts))
(calendar-daylight-savings-ends

15
lisp/calendar/time-date.el
View file

@ -527,6 +527,21 @@ TIME is modified and returned."
time)
(defun decoded-time-period (time)
"Interpret DECODED as a period and return its length in seconds.
For computational purposes, years are 365 days long and months
are 30 days long."
(+ (if (consp (decoded-time-second time))
;; Fractional second.
(/ (float (car (decoded-time-second time)))
(cdr (decoded-time-second time)))
(or (decoded-time-second time) 0))
(* (or (decoded-time-minute time) 0) 60)
(* (or (decoded-time-hour time) 0) 60 60)
(* (or (decoded-time-day time) 0) 60 60 24)
(* (or (decoded-time-month time) 0) 60 60 24 30)
(* (or (decoded-time-year time) 0) 60 60 24 365)))
(provide 'time-date)
;;; time-date.el ends here

10
lisp/cus-dep.el
View file

@ -70,7 +70,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(directory-files subdir nil
"\\`[^=.].*\\.el\\'"))))
(progress (make-progress-reporter
(byte-compile-info-string "Scanning files for custom")
(byte-compile-info "Scanning files for custom")
0 (length files) nil 10)))
(with-temp-buffer
(dolist (elem files)
@ -128,8 +128,8 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
type)))))))))))
(error nil)))))))
(progress-reporter-done progress))
(byte-compile-info-message "Generating %s..."
generated-custom-dependencies-file)
(byte-compile-info
(format "Generating %s..." generated-custom-dependencies-file) t)
(set-buffer (find-file-noselect generated-custom-dependencies-file))
(setq buffer-undo-list t)
(erase-buffer)
@ -218,8 +218,8 @@ elements the files that have variables or faces that contain that
version. These files should be loaded before showing the customization
buffer that `customize-changed-options' generates.\")\n\n"))
(save-buffer)
(byte-compile-info-message "Generating %s...done"
generated-custom-dependencies-file))
(byte-compile-info
(format "Generating %s...done" generated-custom-dependencies-file) t))
(provide 'cus-dep)

5
lisp/cus-edit.el
View file

@ -4841,7 +4841,10 @@ The format is suitable for use with `easy-menu-define'."
(error "You can't edit this part of the Custom buffer"))
(defun Custom-newline (pos &optional event)
"Invoke button at POS, or refuse to allow editing of Custom buffer."
"Invoke button at POS, or refuse to allow editing of Custom buffer.
To see what function the widget will call, use the
`widget-describe' command."
(interactive "@d")
(let ((button (get-char-property pos 'button)))
;; If there is no button at point, then use the one at the start

14
lisp/custom.el
View file

@ -1541,6 +1541,20 @@ Each of the arguments ARGS has this form:
This means reset VARIABLE. (The argument IGNORED is ignored)."
(apply #'custom-theme-reset-variables 'user args))
(defun custom-add-choice (variable choice)
"Add CHOICE to the custom type of VARIABLE.
If a choice with the same tag already exists, no action is taken."
(let ((choices (get variable 'custom-type)))
(unless (eq (car choices) 'choice)
(error "Not a choice type: %s" choices))
(unless (seq-find (lambda (elem)
(equal (caddr (member :tag elem))
(caddr (member :tag choice))))
(cdr choices))
;; Put the new choice at the end.
(put variable 'custom-type
(append choices (list choice))))))
;;; The End.
(provide 'custom)

20
lisp/dired-aux.el
View file

@ -688,7 +688,7 @@ are executed in the background on each file sequentially waiting
for each command to terminate before running the next command.
In shell syntax this means separating the individual commands with `;'.
The output appears in the buffer `*Async Shell Command*'."
The output appears in the buffer `shell-command-buffer-name-async'."
(interactive
(let ((files (dired-get-marked-files t current-prefix-arg nil nil t)))
(list
@ -727,7 +727,7 @@ it, write `*\"\"' in place of just `*'. This is equivalent to just
If COMMAND ends in `&', `;', or `;&', it is executed in the
background asynchronously, and the output appears in the buffer
`*Async Shell Command*'. When operating on multiple files and COMMAND
`shell-command-buffer-name-async'. When operating on multiple files and COMMAND
ends in `&', the shell command is executed on each file in parallel.
However, when COMMAND ends in `;' or `;&' then commands are executed
in the background on each file sequentially waiting for each command
@ -735,7 +735,7 @@ to terminate before running the next command. You can also use
`dired-do-async-shell-command' that automatically adds `&'.
Otherwise, COMMAND is executed synchronously, and the output
appears in the buffer `*Shell Command Output*'.
appears in the buffer `shell-command-buffer-name'.
This feature does not try to redisplay Dired buffers afterward, as
there's no telling what files COMMAND may have changed.
@ -952,13 +952,17 @@ With a prefix argument, kill that many lines starting with the current line.
"Kill all marked lines (not the files).
With a prefix argument, kill that many lines starting with the current line.
\(A negative argument kills backward.)
If you use this command with a prefix argument to kill the line
for a file that is a directory, which you have inserted in the
Dired buffer as a subdirectory, then it deletes that subdirectory
from the buffer as well.
To kill an entire subdirectory \(without killing its line in the
parent directory), go to its directory header line and use this
command with a prefix argument (the value does not matter)."
command with a prefix argument (the value does not matter).
To undo the killing, the undo command can be used as normally."
;; Returns count of killed lines. FMT="" suppresses message.
(interactive "P")
(if arg
@ -1010,8 +1014,8 @@ command with a prefix argument (the value does not matter)."
(defvar dired-compress-file-suffixes
'(
;; "tar -zxf" isn't used because it's not available on the
;; Solaris10 version of tar. Solaris10 becomes obsolete in 2021.
;; Same thing on AIX 7.1.
;; Solaris 10 version of tar (obsolete in 2024?).
;; Same thing on AIX 7.1 (obsolete 2023?) and 7.2 (obsolete 2022?).
("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -")
("\\.tgz\\'" "" "gzip -dc %i | tar -xf -")
("\\.gz\\'" "" "gunzip")
@ -1974,6 +1978,10 @@ Optional arg HOW-TO determines how to treat the target.
(apply (car into-dir) operation rfn-list fn-list target (cdr into-dir))
(if (not (or dired-one-file into-dir))
(error "Marked %s: target must be a directory: %s" operation target))
(if (and (not (file-directory-p (car fn-list)))
(not (file-directory-p target))
(directory-name-p target))
(error "%s: Target directory does not exist: %s" operation target))
;; rename-file bombs when moving directories unless we do this:
(or into-dir (setq target (directory-file-name target)))
(dired-create-files

2
lisp/dired.el
View file

@ -125,7 +125,7 @@ For more details, see Info node `(emacs)ls in Lisp'."
"Informs Dired about how `ls -lF' marks symbolic links.
Set this to t if `ls' (or whatever program is specified by
`insert-directory-program') with `-lF' marks the symbolic link
itself with a trailing @ (usually the case under Ultrix).
itself with a trailing @ (usually the case under Ultrix and macOS).
Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
nil (the default), if it gives `bar@ -> foo', set it to t.

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

@ -1126,7 +1126,7 @@ write its autoloads into the specified file instead."
;; Elements remaining in FILES have no existing autoload sections yet.
(let ((no-autoloads-time (or last-time '(0 0 0 0)))
(progress (make-progress-reporter
(byte-compile-info-string
(byte-compile-info
(concat "Scraping files for "
(file-relative-name
generated-autoload-file)))
@ -1169,6 +1169,19 @@ write its autoloads into the specified file instead."
;; file-local autoload-generated-file settings.
(autoload-save-buffers))))
(defun batch-update-autoloads--summary (strings)
(let ((message ""))
(while strings
(when (> (length (concat message " " (car strings))) 64)
(byte-compile-info (concat message " ...") t "SCRAPE")
(setq message ""))
(setq message (if (zerop (length message))
(car strings)
(concat message " " (car strings))))
(setq strings (cdr strings)))
(when (> (length message) 0)
(byte-compile-info message t "SCRAPE"))))
;;;###autoload
(defun batch-update-autoloads ()
"Update loaddefs.el autoloads in batch mode.
@ -1192,6 +1205,7 @@ should be non-nil)."
(or (string-match "\\`site-" file)
(push (expand-file-name file) autoload-excludes)))))))
(let ((args command-line-args-left))
(batch-update-autoloads--summary args)
(setq command-line-args-left nil)
(apply #'update-directory-autoloads args)))

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

@ -648,14 +648,23 @@
(setq args (cons (car rest) args)))
(setq rest (cdr rest)))
(if (cdr constants)
(if args
(list (car form)
(apply (car form) constants)
(if (cdr args)
(cons (car form) (nreverse args))
(car args)))
(apply (car form) constants))
form)))
(let ((const (apply (car form) (nreverse constants))))
(if args
(append (list (car form) const)
(nreverse args))
const))
form)))
(defun byte-optimize-min-max (form)
"Optimize `min' and `max'."
(let ((opt (byte-optimize-associative-math form)))
(if (and (consp opt) (memq (car opt) '(min max))
(= (length opt) 4))
;; (OP x y z) -> (OP (OP x y) z), in order to use binary byte ops.
(list (car opt)
(list (car opt) (nth 1 opt) (nth 2 opt))
(nth 3 opt))
opt)))
;; Use OP to reduce any leading prefix of constant numbers in the list
;; (cons ACCUM ARGS) down to a single number, and return the
@ -878,8 +887,8 @@
(put '* 'byte-optimizer #'byte-optimize-multiply)
(put '- 'byte-optimizer #'byte-optimize-minus)
(put '/ 'byte-optimizer #'byte-optimize-divide)
(put 'max 'byte-optimizer #'byte-optimize-associative-math)
(put 'min 'byte-optimizer #'byte-optimize-associative-math)
(put 'max 'byte-optimizer #'byte-optimize-min-max)
(put 'min 'byte-optimizer #'byte-optimize-min-max)
(put '= 'byte-optimizer #'byte-optimize-binary-predicate)
(put 'eq 'byte-optimizer #'byte-optimize-binary-predicate)

17
lisp/emacs-lisp/byte-run.el
View file

@ -587,13 +587,26 @@ Otherwise, return nil. For internal use only."
(mapconcat (lambda (char) (format "`?\\%c'" char))
sorted ", ")))))
(defun byte-compile-info (string &optional message type)
"Format STRING in a way that looks pleasing in the compilation output.
If MESSAGE, output the message, too.
If TYPE, it should be a string that says what the information
type is. This defaults to \"INFO\"."
(let ((string (format " %-9s%s" (or type "INFO") string)))
(when message
(message "%s" string))
string))
(defun byte-compile-info-string (&rest args)
"Format ARGS in a way that looks pleasing in the compilation output."
(format " %-9s%s" "INFO" (apply #'format args)))
(declare (obsolete byte-compile-info "28.1"))
(byte-compile-info (apply #'format args)))
(defun byte-compile-info-message (&rest args)
"Message format ARGS in a way that looks pleasing in the compilation output."
(message "%s" (apply #'byte-compile-info-string args)))
(declare (obsolete byte-compile-info "28.1"))
(byte-compile-info (apply #'format args) t))
;; I nuked this because it's not a good idea for users to think of using it.

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

@ -3659,10 +3659,10 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(byte-defop-compiler (% byte-rem) 2)
(byte-defop-compiler aset 3)
(byte-defop-compiler max byte-compile-associative)
(byte-defop-compiler min byte-compile-associative)
(byte-defop-compiler (+ byte-plus) byte-compile-associative)
(byte-defop-compiler (* byte-mult) byte-compile-associative)
(byte-defop-compiler max byte-compile-min-max)
(byte-defop-compiler min byte-compile-min-max)
(byte-defop-compiler (+ byte-plus) byte-compile-variadic-numeric)
(byte-defop-compiler (* byte-mult) byte-compile-variadic-numeric)
;;####(byte-defop-compiler move-to-column 1)
(byte-defop-compiler-1 interactive byte-compile-noop)
@ -3809,30 +3809,36 @@ discarding."
(if byte-compile--for-effect (setq byte-compile--for-effect nil)
(byte-compile-out 'byte-constant (nth 1 form))))
;; Compile a function that accepts one or more args and is right-associative.
;; We do it by left-associativity so that the operations
;; are done in the same order as in interpreted code.
;; We treat the one-arg case, as in (+ x), like (+ x 0).
;; in order to convert markers to numbers, and trigger expected errors.
(defun byte-compile-associative (form)
;; Compile a pure function that accepts zero or more numeric arguments
;; and has an opcode for the binary case.
;; Single-argument calls are assumed to be numeric identity and are
;; compiled as (* x 1) in order to convert markers to numbers and
;; trigger type errors.
(defun byte-compile-variadic-numeric (form)
(pcase (length form)
(1
;; No args: use the identity value for the operation.
(byte-compile-constant (eval form)))
(2
;; One arg: compile (OP x) as (* x 1). This is identity for
;; all numerical values including -0.0, infinities and NaNs.
(byte-compile-form (nth 1 form))
(byte-compile-constant 1)
(byte-compile-out (get '* 'byte-opcode) 0))
(3
(byte-compile-form (nth 1 form))
(byte-compile-form (nth 2 form))
(byte-compile-out (get (car form) 'byte-opcode) 0))
(_
;; >2 args: compile as a single function call.
(byte-compile-normal-call form))))
(defun byte-compile-min-max (form)
"Byte-compile calls to `min' or `max'."
(if (cdr form)
(let ((opcode (get (car form) 'byte-opcode))
args)
(if (and (< 3 (length form))
(memq opcode (list (get '+ 'byte-opcode)
(get '* 'byte-opcode))))
;; Don't use binary operations for > 2 operands, as that
;; may cause overflow/truncation in float operations.
(byte-compile-normal-call form)
(setq args (copy-sequence (cdr form)))
(byte-compile-form (car args))
(setq args (cdr args))
(or args (setq args '(0)
opcode (get '+ 'byte-opcode)))
(dolist (arg args)
(byte-compile-form arg)
(byte-compile-out opcode 0))))
(byte-compile-constant (eval form))))
(byte-compile-variadic-numeric form)
;; No args: warn and emit code that raises an error when executed.
(byte-compile-normal-call form)))
;; more complicated compiler macros
@ -3847,7 +3853,7 @@ discarding."
(byte-defop-compiler indent-to)
(byte-defop-compiler insert)
(byte-defop-compiler-1 function byte-compile-function-form)
(byte-defop-compiler-1 - byte-compile-minus)
(byte-defop-compiler (- byte-diff) byte-compile-minus)
(byte-defop-compiler (/ byte-quo) byte-compile-quo)
(byte-defop-compiler nconc)
@ -3914,30 +3920,17 @@ discarding."
((byte-compile-normal-call form)))))
(defun byte-compile-minus (form)
(let ((len (length form)))
(cond
((= 1 len) (byte-compile-constant 0))
((= 2 len)
(byte-compile-form (cadr form))
(byte-compile-out 'byte-negate 0))
((= 3 len)
(byte-compile-form (nth 1 form))
(byte-compile-form (nth 2 form))
(byte-compile-out 'byte-diff 0))
;; Don't use binary operations for > 2 operands, as that may
;; cause overflow/truncation in float operations.
(t (byte-compile-normal-call form)))))
(if (/= (length form) 2)
(byte-compile-variadic-numeric form)
(byte-compile-form (cadr form))
(byte-compile-out 'byte-negate 0)))
(defun byte-compile-quo (form)
(let ((len (length form)))
(cond ((< len 2)
(byte-compile-subr-wrong-args form "1 or more"))
((= len 3)
(byte-compile-two-args form))
(t
;; Don't use binary operations for > 2 operands, as that
;; may cause overflow/truncation in float operations.
(byte-compile-normal-call form)))))
(if (= (length form) 3)
(byte-compile-two-args form)
;; N-ary `/' is not the left-reduction of binary `/' because if any
;; argument is a float, then everything is done in floating-point.
(byte-compile-normal-call form)))
(defun byte-compile-nconc (form)
(let ((len (length form)))

16
lisp/emacs-lisp/cl-generic.el
View file

@ -211,7 +211,16 @@ DEFAULT-BODY, if present, is used as the body of a default method.
[&rest [&or
("declare" &rest sexp)
(":argument-precedence-order" &rest sexp)
(&define ":method" [&rest atom]
(&define ":method"
;; FIXME: The `:unique'
;; construct works around
;; Bug#42672. We'd rather want
;; names like those generated by
;; `cl-defmethod', but that
;; requires larger changes to
;; Edebug.
:unique "cl-generic-:method@"
[&rest cl-generic-method-qualifier]
cl-generic-method-args lambda-doc
def-body)]]
def-body)))
@ -432,9 +441,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
(&define ; this means we are defining something
[&or name ("setf" name :name setf)]
;; ^^ This is the methods symbol
[ &rest atom ] ; Multiple qualifiers are allowed.
; Like in CLOS spec, we support
; any non-list values.
[ &rest cl-generic-method-qualifier ]
;; Multiple qualifiers are allowed.
cl-generic-method-args ; arguments
lambda-doc ; documentation string
def-body))) ; part to be debugged

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

@ -2016,7 +2016,12 @@ info node `(cl) Function Bindings' for details.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1)
(debug ((&rest [&or (&define name function-form) (cl-defun)])
(debug ((&rest [&or (&define name :unique "cl-flet@" function-form)
(&define name :unique "cl-flet@"
cl-lambda-list
cl-declarations-or-string
[&optional ("interactive" interactive)]
def-body)])
cl-declarations body)))
(let ((binds ()) (newenv macroexpand-all-environment))
(dolist (binding bindings)

31
lisp/emacs-lisp/edebug.el
View file

@ -1240,6 +1240,13 @@ purpose by adding an entry to this alist, and setting
;; since it wraps the list of forms with a call to `edebug-enter'.
;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
;; Do this after parsing since that may find a name.
(when (string-match-p (rx bos "edebug-anon" (+ digit) eos)
(symbol-name edebug-old-def-name))
;; FIXME: Due to Bug#42701, we reset an anonymous name so that
;; backtracking doesn't generate duplicate definitions. It would
;; be better to not define wrappers in the case of a non-matching
;; specification branch to begin with.
(setq edebug-old-def-name nil))
(setq edebug-def-name
(or edebug-def-name edebug-old-def-name (gensym "edebug-anon")))
`(edebug-enter
@ -1725,12 +1732,15 @@ contains a circular object."
(&define . edebug-match-&define)
(name . edebug-match-name)
(:name . edebug-match-colon-name)
(:unique . edebug-match-:unique)
(arg . edebug-match-arg)
(def-body . edebug-match-def-body)
(def-form . edebug-match-def-form)
;; Less frequently used:
;; (function . edebug-match-function)
(lambda-expr . edebug-match-lambda-expr)
(cl-generic-method-qualifier
. edebug-match-cl-generic-method-qualifier)
(cl-generic-method-args . edebug-match-cl-generic-method-args)
(cl-macrolet-expr . edebug-match-cl-macrolet-expr)
(cl-macrolet-name . edebug-match-cl-macrolet-name)
@ -2035,6 +2045,27 @@ contains a circular object."
spec))
nil)
(defun edebug-match-:unique (_cursor spec)
"Match a `:unique PREFIX' specifier.
SPEC is the symbol name prefix for `gensym'."
(let ((suffix (gensym spec)))
(setq edebug-def-name
(if edebug-def-name
;; Construct a new name by appending to previous name.
(intern (format "%s@%s" edebug-def-name suffix))
suffix)))
nil)
(defun edebug-match-cl-generic-method-qualifier (cursor)
"Match a QUALIFIER for `cl-defmethod' at CURSOR."
(let ((args (edebug-top-element-required cursor "Expected qualifier")))
;; Like in CLOS spec, we support any non-list values.
(unless (atom args) (edebug-no-match cursor "Atom expected"))
;; Append the arguments to `edebug-def-name' (Bug#42671).
(setq edebug-def-name (intern (format "%s %s" edebug-def-name args)))
(edebug-move-cursor cursor)
(list args)))
(defun edebug-match-cl-generic-method-args (cursor)
(let ((args (edebug-top-element-required cursor "Expected arguments")))
(if (not (consp args))

579
lisp/emacs-lisp/hierarchy.el Normal file
View file

@ -0,0 +1,579 @@
;;; hierarchy.el --- Library to create and display hierarchy structures -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Free Software Foundation, Inc.
;; Author: Damien Cassou <damien@cassou.me>
;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Library to create, query, navigate and display hierarchy structures.
;; Creation: After having created a hierarchy with `hierarchy-new',
;; populate it by calling `hierarchy-add-tree' or
;; `hierarchy-add-trees'. You can then optionally sort its element
;; with `hierarchy-sort'.
;; Querying: You can learn more about your hierarchy by using
;; functions such as `hierarchy-roots', `hierarchy-has-item',
;; `hierarchy-length', `hierarchy-parent', `hierarchy-descendant-p'.
;; Navigation: When your hierarchy is ready, you can use
;; `hierarchy-map-item', `hierarchy-map', and `map-tree' to apply
;; functions to elements of the hierarchy.
;; Display: You can display a hierarchy as a tabulated list using
;; `hierarchy-tabulated-display' and as an expandable/foldable tree
;; using `hierarchy-convert-to-tree-widget'. The
;; `hierarchy-labelfn-*' functions will help you display each item of
;; the hierarchy the way you want it.
;;; Limitation:
;; - Current implementation uses #'equal to find and distinguish
;; elements. Support for user-provided equality definition is
;; desired but not yet implemented;
;;
;; - nil can't be added to a hierarchy;
;;
;; - the hierarchy is computed eagerly.
;;; Code:
(require 'seq)
(require 'map)
(require 'subr-x)
(require 'cl-lib)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(cl-defstruct (hierarchy
(:constructor hierarchy--make)
(:conc-name hierarchy--))
(roots (list)) ; list of the hierarchy roots (no parent)
(parents (make-hash-table :test 'equal)) ; map an item to its parent
(children (make-hash-table :test 'equal)) ; map an item to its childre
;; cache containing the set of all items in the hierarchy
(seen-items (make-hash-table :test 'equal))) ; map an item to t
(defun hierarchy--seen-items-add (hierarchy item)
"In HIERARCHY, add ITEM to seen items."
(map-put! (hierarchy--seen-items hierarchy) item t))
(defun hierarchy--compute-roots (hierarchy)
"Search roots of HIERARCHY and return them."
(cl-set-difference
(map-keys (hierarchy--seen-items hierarchy))
(map-keys (hierarchy--parents hierarchy))
:test #'equal))
(defun hierarchy--sort-roots (hierarchy sortfn)
"Compute, sort and store the roots of HIERARCHY.
SORTFN is a function taking two items of the hierarchy as parameter and
returning non-nil if the first parameter is lower than the second."
(setf (hierarchy--roots hierarchy)
(sort (hierarchy--compute-roots hierarchy)
sortfn)))
(defun hierarchy--add-relation (hierarchy item parent acceptfn)
"In HIERARCHY, add ITEM as child of PARENT.
ACCEPTFN is a function returning non-nil if its parameter (any object)
should be an item of the hierarchy."
(let* ((existing-parent (hierarchy-parent hierarchy item))
(has-parent-p (funcall acceptfn existing-parent)))
(cond
((and has-parent-p (not (equal existing-parent parent)))
(error "An item (%s) can only have one parent: '%s' vs '%s'"
item existing-parent parent))
((not has-parent-p)
(let ((existing-children (map-elt (hierarchy--children hierarchy)
parent (list))))
(map-put! (hierarchy--children hierarchy)
parent (append existing-children (list item))))
(map-put! (hierarchy--parents hierarchy) item parent)))))
(defun hierarchy--set-equal (list1 list2 &rest cl-keys)
"Return non-nil if LIST1 and LIST2 have same elements.
I.e., if every element of LIST1 also appears in LIST2 and if
every element of LIST2 also appears in LIST1.
CL-KEYS are key-value pairs just like in `cl-subsetp'. Supported
keys are :key and :test."
(and (apply 'cl-subsetp list1 list2 cl-keys)
(apply 'cl-subsetp list2 list1 cl-keys)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Creation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun hierarchy-new ()
"Create a hierarchy and return it."
(hierarchy--make))
(defun hierarchy-add-tree (hierarchy item parentfn &optional childrenfn acceptfn)
"In HIERARCHY, add ITEM.
PARENTFN is either nil or a function defining the child-to-parent
relationship: this function takes an item as parameter and should return
the parent of this item in the hierarchy. If the item has no parent in the
hierarchy (i.e., it should be a root), the function should return an object
not accepted by acceptfn (i.e., nil for the default value of acceptfn).
CHILDRENFN is either nil or a function defining the parent-to-children
relationship: this function takes an item as parameter and should return a
list of children of this item in the hierarchy.
If both PARENTFN and CHILDRENFN are non-nil, the results of PARENTFN and
CHILDRENFN are expected to be coherent with each other.
ACCEPTFN is a function returning non-nil if its parameter (any object)
should be an item of the hierarchy. By default, ACCEPTFN returns non-nil
if its parameter is non-nil."
(unless (hierarchy-has-item hierarchy item)
(let ((acceptfn (or acceptfn #'identity)))
(hierarchy--seen-items-add hierarchy item)
(let ((parent (and parentfn (funcall parentfn item))))
(when (funcall acceptfn parent)
(hierarchy--add-relation hierarchy item parent acceptfn)
(hierarchy-add-tree hierarchy parent parentfn childrenfn)))
(let ((children (and childrenfn (funcall childrenfn item))))
(mapc (lambda (child)
(when (funcall acceptfn child)
(hierarchy--add-relation hierarchy child item acceptfn)
(hierarchy-add-tree hierarchy child parentfn childrenfn)))
children)))))
(defun hierarchy-add-trees (hierarchy items parentfn &optional childrenfn acceptfn)
"Call `hierarchy-add-tree' on HIERARCHY and each element of ITEMS.
PARENTFN, CHILDRENFN and ACCEPTFN have the same meaning as in `hierarchy-add'."
(seq-map (lambda (item)
(hierarchy-add-tree hierarchy item parentfn childrenfn acceptfn))
items))
(defun hierarchy-add-list (hierarchy list &optional wrap childrenfn)
"Add to HIERARCHY the sub-lists in LIST.
If WRAP is non-nil, allow duplicate items in LIST by wraping each
item in a cons (id . item). The root's id is 1.
CHILDRENFN is a function (defaults to `cdr') taking LIST as a
parameter which should return LIST's children (a list). Each
child is (recursively) passed as a parameter to CHILDRENFN to get
its own children. Because of this parameter, LIST can be
anything, not necessarily a list."
(let* ((childrenfn (or childrenfn #'cdr))
(id 0)
(wrapfn (lambda (item)
(if wrap
(cons (setq id (1+ id)) item)
item)))
(unwrapfn (if wrap #'cdr #'identity)))
(hierarchy-add-tree
hierarchy (funcall wrapfn list) nil
(lambda (item)
(mapcar wrapfn (funcall childrenfn
(funcall unwrapfn item)))))
hierarchy))
(defun hierarchy-from-list (list &optional wrap childrenfn)
"Create and return a hierarchy built from LIST.
This function passes LIST, WRAP and CHILDRENFN unchanged to
`hierarchy-add-list'."
(hierarchy-add-list (hierarchy-new) list wrap childrenfn))
(defun hierarchy-sort (hierarchy &optional sortfn)
"Modify HIERARCHY so that its roots and item's children are sorted.
SORTFN is a function taking two items of the hierarchy as parameter and
returning non-nil if the first parameter is lower than the second. By
default, SORTFN is `string-lessp'."
(let ((sortfn (or sortfn #'string-lessp)))
(hierarchy--sort-roots hierarchy sortfn)
(mapc (lambda (parent)
(setf
(map-elt (hierarchy--children hierarchy) parent)
(sort (map-elt (hierarchy--children hierarchy) parent) sortfn)))
(map-keys (hierarchy--children hierarchy)))))
(defun hierarchy-extract-tree (hierarchy item)
"Return a copy of HIERARCHY with ITEM's descendants and parents."
(if (not (hierarchy-has-item hierarchy item))
nil
(let ((tree (hierarchy-new)))
(hierarchy-add-tree tree item
(lambda (each) (hierarchy-parent hierarchy each))
(lambda (each)
(when (or (equal each item)
(hierarchy-descendant-p hierarchy each item))
(hierarchy-children hierarchy each))))
tree)))
(defun hierarchy-copy (hierarchy)
"Return a copy of HIERARCHY.
Items in HIERARCHY are shared, but structure is not."
(hierarchy-map-hierarchy (lambda (item _) (identity item)) hierarchy))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Querying
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun hierarchy-items (hierarchy)
"Return a list of all items of HIERARCHY."
(map-keys (hierarchy--seen-items hierarchy)))
(defun hierarchy-has-item (hierarchy item)
"Return t if HIERARCHY includes ITEM."
(map-contains-key (hierarchy--seen-items hierarchy) item))
(defun hierarchy-empty-p (hierarchy)
"Return t if HIERARCHY is empty."
(= 0 (hierarchy-length hierarchy)))
(defun hierarchy-length (hierarchy)
"Return the number of items in HIERARCHY."
(hash-table-count (hierarchy--seen-items hierarchy)))
(defun hierarchy-has-root (hierarchy item)
"Return t if one of HIERARCHY's roots is ITEM.
A root is an item with no parent."
(seq-contains-p (hierarchy-roots hierarchy) item))
(defun hierarchy-roots (hierarchy)
"Return all roots of HIERARCHY.
A root is an item with no parent."
(let ((roots (hierarchy--roots hierarchy)))
(or roots
(hierarchy--compute-roots hierarchy))))
(defun hierarchy-leafs (hierarchy &optional node)
"Return all leafs of HIERARCHY.
A leaf is an item with no child.
If NODE is an item of HIERARCHY, only return leafs under NODE."
(let ((leafs (cl-set-difference
(map-keys (hierarchy--seen-items hierarchy))
(map-keys (hierarchy--children hierarchy)))))
(if (hierarchy-has-item hierarchy node)
(seq-filter (lambda (item)
(hierarchy-descendant-p hierarchy item node))
leafs)
leafs)))
(defun hierarchy-parent (hierarchy item)
"In HIERARCHY, return parent of ITEM."
(map-elt (hierarchy--parents hierarchy) item))
(defun hierarchy-children (hierarchy parent)
"In HIERARCHY, return children of PARENT."
(map-elt (hierarchy--children hierarchy) parent (list)))
(defun hierarchy-child-p (hierarchy item1 item2)
"In HIERARCHY, return non-nil if and only if ITEM1 is a child of ITEM2."
(equal (hierarchy-parent hierarchy item1) item2))
(defun hierarchy-descendant-p (hierarchy item1 item2)
"In HIERARCHY, return non-nil if and only if ITEM1 is a descendant of ITEM2.
ITEM1 is a descendant of ITEM2 if and only if both are items of HIERARCHY
and either:
- ITEM1 is child of ITEM2, or
- ITEM1's parent is a descendant of ITEM2."
(and
(hierarchy-has-item hierarchy item1)
(hierarchy-has-item hierarchy item2)
(or
(hierarchy-child-p hierarchy item1 item2)
(hierarchy-descendant-p
hierarchy (hierarchy-parent hierarchy item1) item2))))
(defun hierarchy-equal (hierarchy1 hierarchy2)
"Return t if HIERARCHY1 and HIERARCHY2 are equal.
Two equal hierarchies share the same items and the same
relationships among them."
(and (hierarchy-p hierarchy1)
(hierarchy-p hierarchy2)
(= (hierarchy-length hierarchy1) (hierarchy-length hierarchy2))
;; parents are the same
(seq-every-p (lambda (child)
(equal (hierarchy-parent hierarchy1 child)
(hierarchy-parent hierarchy2 child)))
(map-keys (hierarchy--parents hierarchy1)))
;; children are the same
(seq-every-p (lambda (parent)
(hierarchy--set-equal
(hierarchy-children hierarchy1 parent)
(hierarchy-children hierarchy2 parent)
:test #'equal))
(map-keys (hierarchy--children hierarchy1)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Navigation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun hierarchy-map-item (func item hierarchy &optional indent)
"Return the result of applying FUNC to ITEM and its descendants in HIERARCHY.
This function navigates the tree top-down: FUNCTION is first called on item
and then on each of its children. Results are concatenated in a list.
INDENT is a number (default 0) representing the indentation of ITEM in
HIERARCHY. FUNC should take 2 argument: the item and its indentation
level."
(let ((indent (or indent 0)))
(cons
(funcall func item indent)
(seq-mapcat (lambda (child) (hierarchy-map-item func child
hierarchy (1+ indent)))
(hierarchy-children hierarchy item)))))
(defun hierarchy-map (func hierarchy &optional indent)
"Return the result of applying FUNC to each element of HIERARCHY.
This function navigates the tree top-down: FUNCTION is first called on each
root. To do so, it calls `hierarchy-map-item' on each root
sequentially. Results are concatenated in a list.
FUNC should take 2 arguments: the item and its indentation level.
INDENT is a number (default 0) representing the indentation of HIERARCHY's
roots."
(let ((indent (or indent 0)))
(seq-mapcat (lambda (root) (hierarchy-map-item func root hierarchy indent))
(hierarchy-roots hierarchy))))
(defun hierarchy-map-tree (function hierarchy &optional item indent)
"Apply FUNCTION on each item of HIERARCHY under ITEM.
This function navigates the tree bottom-up: FUNCTION is first called on
leafs and the result is passed as parameter when calling FUNCTION on
parents.
FUNCTION should take 3 parameters: the current item, its indentation
level (a number), and a list representing the result of applying
`hierarchy-map-tree' to each child of the item.
INDENT is 0 by default and is passed as second parameter to FUNCTION.
INDENT is incremented by 1 at each level of the tree.
This function returns the result of applying FUNCTION to ITEM (the first
root if nil)."
(let ((item (or item (car (hierarchy-roots hierarchy))))
(indent (or indent 0)))
(funcall function item indent
(mapcar (lambda (child)
(hierarchy-map-tree function hierarchy
child (1+ indent)))
(hierarchy-children hierarchy item)))))
(defun hierarchy-map-hierarchy (function hierarchy)
"Apply FUNCTION to each item of HIERARCHY in a new hierarchy.
FUNCTION should take 2 parameters, the current item and its
indentation level (a number), and should return an item to be
added to the new hierarchy."
(let* ((items (make-hash-table :test #'equal))
(transform (lambda (item) (map-elt items item))))
;; Make 'items', a table mapping original items to their
;; transformation
(hierarchy-map (lambda (item indent)
(map-put! items item (funcall function item indent)))
hierarchy)
(hierarchy--make
:roots (mapcar transform (hierarchy-roots hierarchy))
:parents (let ((result (make-hash-table :test #'equal)))
(map-apply (lambda (child parent)
(map-put! result
(funcall transform child)
(funcall transform parent)))
(hierarchy--parents hierarchy))
result)
:children (let ((result (make-hash-table :test #'equal)))
(map-apply (lambda (parent children)
(map-put! result
(funcall transform parent)
(seq-map transform children)))
(hierarchy--children hierarchy))
result)
:seen-items (let ((result (make-hash-table :test #'equal)))
(map-apply (lambda (item v)
(map-put! result
(funcall transform item)
v))
(hierarchy--seen-items hierarchy))
result))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Display
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun hierarchy-labelfn-indent (labelfn &optional indent-string)
"Return a function rendering LABELFN indented with INDENT-STRING.
INDENT-STRING defaults to a 2-space string. Indentation is
multiplied by the depth of the displayed item."
(let ((indent-string (or indent-string " ")))
(lambda (item indent)
(dotimes (_ indent) (insert indent-string))
(funcall labelfn item indent))))
(defun hierarchy-labelfn-button (labelfn actionfn)
"Return a function rendering LABELFN in a button.
Clicking the button triggers ACTIONFN. ACTIONFN is a function
taking an item of HIERARCHY and an indentation value (a number)
as input. This function is called when an item is clicked. The
return value of ACTIONFN is ignored."
(lambda (item indent)
(let ((start (point)))
(funcall labelfn item indent)
(make-text-button start (point)
'action (lambda (_) (funcall actionfn item indent))))))
(defun hierarchy-labelfn-button-if (labelfn buttonp actionfn)
"Return a function rendering LABELFN as a button if BUTTONP.
Pass LABELFN and ACTIONFN to `hierarchy-labelfn-button' if
BUTTONP is non-nil. Otherwise, render LABELFN without making it
a button.
BUTTONP is a function taking an item of HIERARCHY and an
indentation value (a number) as input."
(lambda (item indent)
(if (funcall buttonp item indent)
(funcall (hierarchy-labelfn-button labelfn actionfn) item indent)
(funcall labelfn item indent))))
(defun hierarchy-labelfn-to-string (labelfn item indent)
"Execute LABELFN on ITEM and INDENT. Return result as a string."
(with-temp-buffer
(funcall labelfn item indent)
(buffer-substring (point-min) (point-max))))
(defun hierarchy-print (hierarchy &optional to-string)
"Insert HIERARCHY in current buffer as plain text.
Use TO-STRING to convert each element to a string. TO-STRING is
a function taking an item of HIERARCHY as input and returning a
string. If nil, TO-STRING defaults to a call to `format' with \"%s\"."
(let ((to-string (or to-string (lambda (item) (format "%s" item)))))
(hierarchy-map
(hierarchy-labelfn-indent (lambda (item _)
(insert (funcall to-string item) "\n")))
hierarchy)))
(defun hierarchy-to-string (hierarchy &optional to-string)
"Return a string representing HIERARCHY.
TO-STRING is passed unchanged to `hierarchy-print'."
(with-temp-buffer
(hierarchy-print hierarchy to-string)
(buffer-substring (point-min) (point-max))))
(defun hierarchy-tabulated-imenu-action (_item-name position)
"Move to ITEM-NAME at POSITION in current buffer."
(goto-char position)
(back-to-indentation))
(define-derived-mode hierarchy-tabulated-mode tabulated-list-mode "Hierarchy tabulated"
"Major mode to display a hierarchy as a tabulated list."
(setq-local imenu-generic-expression
;; debbugs: 26457 - Cannot pass a function to
;; imenu-generic-expression. Add
;; `hierarchy-tabulated-imenu-action' to the end of the
;; list when bug is fixed
'(("Item" "^[[:space:]]+\\(?1:.+\\)$" 1))))
(defun hierarchy-tabulated-display (hierarchy labelfn &optional buffer)
"Display HIERARCHY as a tabulated list in `hierarchy-tabulated-mode'.
LABELFN is a function taking an item of HIERARCHY and an indentation
level (a number) as input and inserting a string to be displayed in the
table.
The tabulated list is displayed in BUFFER, or a newly created buffer if
nil. The buffer is returned."
(let ((buffer (or buffer (generate-new-buffer "hierarchy-tabulated"))))
(with-current-buffer buffer
(hierarchy-tabulated-mode)
(setq tabulated-list-format
(vector '("Item name" 0 nil)))
(setq tabulated-list-entries
(hierarchy-map (lambda (item indent)
(list item (vector (hierarchy-labelfn-to-string
labelfn item indent))))
hierarchy))
(tabulated-list-init-header)
(tabulated-list-print))
buffer))
(declare-function widget-convert "wid-edit")
(defun hierarchy-convert-to-tree-widget (hierarchy labelfn)
"Return a tree-widget for HIERARCHY.
LABELFN is a function taking an item of HIERARCHY and an indentation
value (a number) as parameter and inserting a string to be displayed as a
node label."
(require 'wid-edit)
(require 'tree-widget)
(hierarchy-map-tree (lambda (item indent children)
(widget-convert
'tree-widget
:tag (hierarchy-labelfn-to-string labelfn item indent)
:args children))
hierarchy))
(defun hierarchy-tree-display (hierarchy labelfn &optional buffer)
"Display HIERARCHY as a tree widget in a new buffer.
HIERARCHY and LABELFN are passed unchanged to
`hierarchy-convert-to-tree-widget'.
The tree widget is displayed in BUFFER, or a newly created buffer if
nil. The buffer is returned."
(let ((buffer (or buffer (generate-new-buffer "*hierarchy-tree*")))
(tree-widget (hierarchy-convert-to-tree-widget hierarchy labelfn)))
(with-current-buffer buffer
(setq-local buffer-read-only t)
(let ((inhibit-read-only t))
(erase-buffer)
(widget-create tree-widget)
(goto-char (point-min))
(special-mode)))
buffer))
(provide 'hierarchy)
;;; hierarchy.el ends here

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

@ -492,6 +492,7 @@ keys. Keys are compared using `equal'."
SEQUENCE must be a sequence of numbers or markers."
(apply #'min (seq-into sequence 'list)))
;;;###autoload
(cl-defgeneric seq-max (sequence)
"Return the largest element of SEQUENCE.
SEQUENCE must be a sequence of numbers or markers."

30
lisp/epa-file.el
View file

@ -151,17 +151,25 @@ encryption is used."
(nth 3 error)))
(let ((exists (file-exists-p local-file)))
(when exists
;; Hack to prevent find-file from opening empty buffer
;; when decryption failed (bug#6568). See the place
;; where `find-file-not-found-functions' are called in
;; `find-file-noselect-1'.
(setq-local epa-file-error error)
(add-hook 'find-file-not-found-functions
'epa-file--find-file-not-found-function
nil t)
(epa-display-error context))
(signal (if exists 'file-error 'file-missing)
(cons "Opening input file" (cdr error))))))
(epa-display-error context)
;; When the .gpg file isn't an encrypted file (e.g.,
;; it's a keyring.gpg file instead), then gpg will
;; say "Unexpected exit" as the error message. In
;; that case, just display the bytes.
(if (equal (caddr error) "Unexpected; Exit")
(setq string (with-temp-buffer
(insert-file-contents-literally local-file)
(buffer-string)))
;; Hack to prevent find-file from opening empty buffer
;; when decryption failed (bug#6568). See the place
;; where `find-file-not-found-functions' are called in
;; `find-file-noselect-1'.
(setq-local epa-file-error error)
(add-hook 'find-file-not-found-functions
'epa-file--find-file-not-found-function
nil t)
(signal (if exists 'file-error 'file-missing)
(cons "Opening input file" (cdr error))))))))
(set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)!
(setq-local epa-file-encrypt-to
(mapcar #'car (epg-context-result-for

16
lisp/erc/erc-capab.el
View file

@ -170,11 +170,11 @@ PARSED is an `erc-parsed' response struct."
(string-match "^\\([-\\+]\\)\\(.+\\)$" msg))
(setf (erc-response.contents parsed)
(if erc-capab-identify-mode
(erc-propertize (match-string 2 msg)
'erc-identified
(if (string= (match-string 1 msg) "+")
1
0))
(propertize (match-string 2 msg)
'erc-identified
(if (string= (match-string 1 msg) "+")
1
0))
(match-string 2 msg)))
nil)))
@ -190,9 +190,9 @@ PARSED is an `erc-parsed' response struct."
;; assuming the first use of `nickname' is the sender's nick
(re-search-forward (regexp-quote nickname) nil t))
(goto-char (match-beginning 0))
(insert (erc-propertize erc-capab-identify-prefix
'font-lock-face
'erc-capab-identify-unidentified))))))
(insert (propertize erc-capab-identify-prefix
'font-lock-face
'erc-capab-identify-unidentified))))))
(defun erc-capab-identify-get-unidentified-nickname (parsed)
"Return the nickname of the user if unidentified.

10
lisp/erc/erc-compat.el
View file

@ -43,12 +43,12 @@ Return the same string, if the encoding operation is trivial.
See `erc-encoding-coding-alist'."
(encode-coding-string s coding-system t))
(defalias 'erc-propertize 'propertize)
(defalias 'erc-view-mode-enter 'view-mode-enter)
(define-obsolete-function-alias 'erc-propertize #'propertize "28.1")
(define-obsolete-function-alias 'erc-view-mode-enter #'view-mode-enter "28.1")
(autoload 'help-function-arglist "help-fns")
(defalias 'erc-function-arglist 'help-function-arglist)
(defalias 'erc-delete-dups 'delete-dups)
(defalias 'erc-replace-regexp-in-string 'replace-regexp-in-string)
(define-obsolete-function-alias 'erc-function-arglist #'help-function-arglist "28.1")
(define-obsolete-function-alias 'erc-delete-dups #'delete-dups "28.1")
(define-obsolete-function-alias 'erc-replace-regexp-in-string #'replace-regexp-in-string "28.1")
(defun erc-set-write-file-functions (new-val)
(set (make-local-variable 'write-file-functions) new-val))

10
lisp/erc/erc-dcc.el
View file

@ -423,7 +423,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
#'(lambda (elt)
(eq (plist-get elt :type) 'CHAT))
erc-dcc-list)))
('close (erc-delete-dups
('close (delete-dups
(mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
erc-dcc-list)))
('get (mapcar #'erc-dcc-nick
@ -636,8 +636,8 @@ that subcommand."
(define-inline erc-dcc-unquote-filename (filename)
(inline-quote
(erc-replace-regexp-in-string "\\\\\\\\" "\\"
(erc-replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t)))
(replace-regexp-in-string "\\\\\\\\" "\\"
(replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t)))
(defun erc-dcc-handle-ctcp-send (proc query nick login host to)
"This is called if a CTCP DCC SEND subcommand is sent to the client.
@ -1193,8 +1193,8 @@ other client."
(setq posn (match-end 0))
(erc-display-message
nil nil proc
'dcc-chat-privmsg ?n (erc-propertize erc-dcc-from 'font-lock-face
'erc-nick-default-face) ?m line))
'dcc-chat-privmsg ?n (propertize erc-dcc-from 'font-lock-face
'erc-nick-default-face) ?m line))
(setq erc-dcc-unprocessed-output (substring str posn)))))
(defun erc-dcc-chat-buffer-killed ()

28
lisp/erc/erc-list.el
View file

@ -71,13 +71,13 @@
(defun erc-list-make-string (channel users topic)
(concat
channel
(erc-propertize " "
'display (list 'space :align-to erc-list-nusers-column)
'face 'fixed-pitch)
(propertize " "
'display (list 'space :align-to erc-list-nusers-column)
'face 'fixed-pitch)
users
(erc-propertize " "
'display (list 'space :align-to erc-list-topic-column)
'face 'fixed-pitch)
(propertize " "
'display (list 'space :align-to erc-list-topic-column)
'face 'fixed-pitch)
topic))
;; Insert a record into the list buffer.
@ -143,19 +143,19 @@
;; Helper function that makes a buttonized column header.
(defun erc-list-button (title column)
(erc-propertize title
'column-number column
'help-echo "mouse-1: sort by column"
'mouse-face 'header-line-highlight
'keymap erc-list-menu-sort-button-map))
(propertize title
'column-number column
'help-echo "mouse-1: sort by column"
'mouse-face 'header-line-highlight
'keymap erc-list-menu-sort-button-map))
(define-derived-mode erc-list-menu-mode special-mode "ERC-List"
"Major mode for editing a list of irc channels."
(setq header-line-format
(concat
(erc-propertize " "
'display '(space :align-to 0)
'face 'fixed-pitch)
(propertize " "
'display '(space :align-to 0)
'face 'fixed-pitch)
(erc-list-make-string (erc-list-button "Channel" 1)
(erc-list-button "# Users" 2)
"Topic")))

2
lisp/erc/erc-log.el
View file

@ -334,7 +334,7 @@ This will not work with full paths, only names.
Any unsafe characters in the name are replaced with \"!\". The
filename is downcased."
(downcase (erc-replace-regexp-in-string
(downcase (replace-regexp-in-string
"[/\\]" "!" (convert-standard-filename filename))))
(defun erc-current-logfile (&optional buffer)

6
lisp/erc/erc-match.el
View file

@ -577,9 +577,9 @@ See `erc-log-match-format'."
(with-current-buffer buffer
(unless buffer-already
(insert " == Type \"q\" to dismiss messages ==\n")
(erc-view-mode-enter nil (lambda (buffer)
(when (y-or-n-p "Discard messages? ")
(kill-buffer buffer)))))
(view-mode-enter nil (lambda (buffer)
(when (y-or-n-p "Discard messages? ")
(kill-buffer buffer)))))
buffer)))
(defun erc-log-matches-come-back (proc parsed)

2
lisp/erc/erc-networks.el
View file

@ -812,7 +812,7 @@ As an example:
(let* ((completion-ignore-case t)
(net (intern
(completing-read "Network: "
(erc-delete-dups
(delete-dups
(mapcar (lambda (x)
(list (symbol-name (nth 1 x))))
erc-server-alist)))))

132
lisp/erc/erc.el
View file

@ -63,6 +63,8 @@
(require 'thingatpt)
(require 'auth-source)
(require 'erc-compat)
(require 'time-date)
(require 'iso8601)
(eval-when-compile (require 'subr-x))
(defvar erc-official-location
@ -1628,9 +1630,10 @@ symbol, it may have these values:
(and (erc-server-buffer-p)
(not (erc-server-process-alive)))))
;; Channel buffer; check that it's from the right server.
(with-current-buffer (get-buffer candidate)
(and (string= erc-session-server server)
(erc-port-equal erc-session-port port)))))
(and target
(with-current-buffer (get-buffer candidate)
(and (string= erc-session-server server)
(erc-port-equal erc-session-port port))))))
(setq buffer-name candidate)))
;; if buffer-name is unset, neither candidate worked out for us,
;; fallback to the old <N> uniquification method:
@ -1860,7 +1863,7 @@ buffer rather than a server buffer.")
;; modify `transforms' to specify what needs to be changed
;; each item is in the format '(old . new)
(let ((transforms '((pcomplete . completion))))
(erc-delete-dups
(delete-dups
(mapcar (lambda (m) (or (cdr (assoc m transforms)) m))
mods))))
@ -2313,7 +2316,7 @@ and appears in face `erc-input-face' in the buffer."
(setq result (concat result network-name
" << " line "\n")))
result)
(erc-propertize
(propertize
(concat network-name " >> " string
(if (/= ?\n
(aref string
@ -2336,7 +2339,7 @@ If ARG is non-nil, show the *erc-protocol* buffer."
(interactive "P")
(let* ((buf (get-buffer-create "*erc-protocol*")))
(with-current-buffer buf
(erc-view-mode-enter)
(view-mode-enter)
(when (null (current-local-map))
(let ((inhibit-read-only t))
(insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n"))
@ -2770,7 +2773,7 @@ See also `erc-server-send'."
(defun erc-get-arglist (fun)
"Return the argument list of a function without the parens."
(let ((arglist (format "%S" (erc-function-arglist fun))))
(let ((arglist (format "%S" (help-function-arglist fun))))
(if (string-match "\\`(\\(.*\\))\\'" arglist)
(match-string 1 arglist)
arglist)))
@ -2905,6 +2908,44 @@ therefore has to contain the command itself as well."
(erc-server-send (substring line 1))
t)
(defvar erc--read-time-period-history nil)
(defun erc--read-time-period (prompt)
"Read a time period on the \"2h\" format.
If there's no letter spec, the input is interpreted as a number of seconds.
If input is blank, this function returns nil. Otherwise it
returns the time spec converted to a number of seconds."
(let ((period (string-trim
(read-string prompt nil 'erc--read-time-period-history))))
(cond
;; Blank input.
((zerop (length period))
nil)
;; All-number -- interpret as seconds.
((string-match-p "\\`[0-9]+\\'" period)
(string-to-number period))
;; Parse as a time spec.
(t
(let ((time (condition-case nil
(iso8601-parse-duration
(concat (cond
((string-match-p "\\`P" (upcase period))
;; Somebody typed in a full ISO8601 period.
(upcase period))
((string-match-p "[YD]" (upcase period))
;; If we have a year/day element,
;; we have a full spec.
"P")
(t
;; Otherwise it's just a sub-day spec.
"PT"))
(upcase period)))
(wrong-type-argument nil))))
(unless time
(user-error "%s is not a valid time period" period))
(decoded-time-period time))))))
(defun erc-cmd-IGNORE (&optional user)
"Ignore USER. This should be a regexp matching nick!user@host.
If no USER argument is specified, list the contents of `erc-ignore-list'."
@ -2914,10 +2955,18 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(y-or-n-p (format "Use regexp-quoted form (%s) instead? "
quoted)))
(setq user quoted))
(erc-display-line
(erc-make-notice (format "Now ignoring %s" user))
'active)
(erc-with-server-buffer (add-to-list 'erc-ignore-list user)))
(let ((timeout
(erc--read-time-period
"Add a timeout? (Blank for no, or a time spec like 2h): "))
(buffer (current-buffer)))
(when timeout
(run-at-time timeout nil
(lambda ()
(erc--unignore-user user buffer))))
(erc-display-line
(erc-make-notice (format "Now ignoring %s" user))
'active)
(erc-with-server-buffer (add-to-list 'erc-ignore-list user))))
(if (null (erc-with-server-buffer erc-ignore-list))
(erc-display-line (erc-make-notice "Ignore list is empty") 'active)
(erc-display-line (erc-make-notice "Ignore list:") 'active)
@ -2941,12 +2990,17 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(erc-make-notice (format "%s is not currently ignored!" user))
'active)))
(when ignored-nick
(erc--unignore-user user (current-buffer))))
t)
(defun erc--unignore-user (user buffer)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(erc-display-line
(erc-make-notice (format "No longer ignoring %s" user))
'active)
(erc-with-server-buffer
(setq erc-ignore-list (delete ignored-nick erc-ignore-list)))))
t)
(setq erc-ignore-list (delete user erc-ignore-list))))))
(defun erc-cmd-CLEAR ()
"Clear the window content."
@ -3504,7 +3558,7 @@ If S is non-nil, it will be used as the quit reason."
If S is non-nil, it will be used as the quit reason."
(or s
(if (fboundp 'yow)
(erc-replace-regexp-in-string "\n" "" (yow))
(replace-regexp-in-string "\n" "" (yow))
(erc-quit/part-reason-default))))
(make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4")
@ -3531,7 +3585,7 @@ If S is non-nil, it will be used as the part reason."
If S is non-nil, it will be used as the quit reason."
(or s
(if (fboundp 'yow)
(erc-replace-regexp-in-string "\n" "" (yow))
(replace-regexp-in-string "\n" "" (yow))
(erc-quit/part-reason-default))))
(make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4")
@ -3947,13 +4001,13 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
;; Do not extend the text properties when typing at the end
;; of the prompt, but stuff typed in front of the prompt
;; shall remain part of the prompt.
(setq prompt (erc-propertize prompt
'start-open t ; XEmacs
'rear-nonsticky t ; Emacs
'erc-prompt t
'field t
'front-sticky t
'read-only t))
(setq prompt (propertize prompt
'start-open t ; XEmacs
'rear-nonsticky t ; Emacs
'erc-prompt t
'field t
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
'font-lock-face (or face 'erc-prompt-face)
prompt)
@ -4336,15 +4390,15 @@ See also `erc-format-nick-function'."
(defun erc-get-user-mode-prefix (user)
(when user
(cond ((erc-channel-user-owner-p user)
(erc-propertize "~" 'help-echo "owner"))
(propertize "~" 'help-echo "owner"))
((erc-channel-user-admin-p user)
(erc-propertize "&" 'help-echo "admin"))
(propertize "&" 'help-echo "admin"))
((erc-channel-user-op-p user)
(erc-propertize "@" 'help-echo "operator"))
(propertize "@" 'help-echo "operator"))
((erc-channel-user-halfop-p user)
(erc-propertize "%" 'help-echo "half-op"))
(propertize "%" 'help-echo "half-op"))
((erc-channel-user-voice-p user)
(erc-propertize "+" 'help-echo "voice"))
(propertize "+" 'help-echo "voice"))
(t ""))))
(defun erc-format-@nick (&optional user _channel-data)
@ -4355,7 +4409,7 @@ prefix. Use CHANNEL-DATA to determine op and voice status. See
also `erc-format-nick-function'."
(when user
(let ((nick (erc-server-user-nickname user)))
(concat (erc-propertize
(concat (propertize
(erc-get-user-mode-prefix nick)
'font-lock-face 'erc-nick-prefix-face)
nick))))
@ -4368,12 +4422,12 @@ also `erc-format-nick-function'."
(nick (erc-current-nick))
(mode (erc-get-user-mode-prefix nick)))
(concat
(erc-propertize open 'font-lock-face 'erc-default-face)
(erc-propertize mode 'font-lock-face 'erc-my-nick-prefix-face)
(erc-propertize nick 'font-lock-face 'erc-my-nick-face)
(erc-propertize close 'font-lock-face 'erc-default-face)))
(propertize open 'font-lock-face 'erc-default-face)
(propertize mode 'font-lock-face 'erc-my-nick-prefix-face)
(propertize nick 'font-lock-face 'erc-my-nick-face)
(propertize close 'font-lock-face 'erc-default-face)))
(let ((prefix "> "))
(erc-propertize prefix 'font-lock-face 'erc-default-face))))
(propertize prefix 'font-lock-face 'erc-default-face))))
(defun erc-echo-notice-in-default-buffer (s parsed buffer _sender)
"Echos a private notice in the default buffer, namely the
@ -6435,16 +6489,16 @@ if `erc-away' is non-nil."
(fill-region (point-min) (point-max))
(buffer-string))))
(setq header-line-format
(erc-replace-regexp-in-string
(replace-regexp-in-string
"%"
"%%"
(if face
(erc-propertize header 'help-echo help-echo
'face face)
(erc-propertize header 'help-echo help-echo))))))
(propertize header 'help-echo help-echo
'face face)
(propertize header 'help-echo help-echo))))))
(t (setq header-line-format
(if face
(erc-propertize header 'face face)
(propertize header 'face face)
header)))))))
(force-mode-line-update)))
@ -6711,7 +6765,7 @@ functions."
nick user host channel
(if (not (string= reason ""))
(format ": %s"
(erc-replace-regexp-in-string "%" "%%" reason))
(replace-regexp-in-string "%" "%%" reason))
"")))))

2
lisp/files.el
View file

@ -2683,8 +2683,6 @@ since only a single case-insensitive search through the alist is made."
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode)
("\\.ad[abs]\\'" . ada-mode)
("\\.ad[bs]\\.dg\\'" . ada-mode)
("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
("Imakefile\\'" . makefile-imake-mode)
("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk

2
lisp/finder.el
View file

@ -197,7 +197,7 @@ from; the default is `load-path'."
(cons d f))
(directory-files d nil el-file-regexp))))
(progress (make-progress-reporter
(byte-compile-info-string "Scanning files for finder")
(byte-compile-info "Scanning files for finder")
0 (length files)))
package-override base-name ; processed
summary keywords package version entry desc)

2
lisp/generic-x.el
View file

@ -643,7 +643,7 @@ like an INI file. You can add this hook to `find-file-hook'."
("\\([^ =\n\r]+\\)=\\([^ \n\r]*\\)"
(1 font-lock-variable-name-face)
(2 font-lock-keyword-face)))
'("inventory")
'("inventory\\'")
(list
(function
(lambda ()

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

@ -5849,7 +5849,10 @@ all parts."
(concat "; " gnus-tmp-name))))
(unless (equal gnus-tmp-description "")
(setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
(when (zerop gnus-tmp-length)
(when (and (zerop gnus-tmp-length)
;; Only nnimap supports partial fetches so far.
nnimap-fetch-partial-articles
(string-match "^nnimap\\+" gnus-newsgroup-name))
(setq gnus-tmp-type-long
(concat
gnus-tmp-type-long
@ -6018,6 +6021,7 @@ If nil, don't show those extra buttons."
(defun gnus-mime-display-single (handle)
(let ((type (mm-handle-media-type handle))
(ignored gnus-ignored-mime-types)
(mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight))
(not-attachment t)
display text)
(catch 'ignored
@ -8340,6 +8344,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(and (match-end 6) (list (string-to-number (match-string 6 address))))))))
(defun gnus-url-parse-query-string (query &optional downcase)
(declare (obsolete message-parse-mailto-url "28.1"))
(let (retval pairs cur key val)
(setq pairs (split-string query "&"))
(while pairs
@ -8359,31 +8364,8 @@ url is put as the `gnus-button-url' overlay property on the button."
(defun gnus-url-mailto (url)
;; Send mail to someone
(setq url (replace-regexp-in-string "\n" " " url))
(when (string-match "mailto:/*\\(.*\\)" url)
(setq url (substring url (match-beginning 1) nil)))
(let* ((args (gnus-url-parse-query-string
(if (string-match "^\\?" url)
(substring url 1)
(if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
(concat "to=" (match-string 1 url) "&"
(match-string 2 url))
(concat "to=" url)))))
(subject (cdr-safe (assoc "subject" args)))
func)
(gnus-msg-mail)
(while args
(setq func (intern-soft (concat "message-goto-" (downcase (caar args)))))
(if (fboundp func)
(funcall func)
(message-position-on-field (caar args)))
(insert (replace-regexp-in-string
"\r\n" "\n"
(mapconcat #'identity (reverse (cdar args)) ", ") nil t))
(setq args (cdr args)))
(if subject
(message-goto-body)
(message-goto-subject))))
(gnus-msg-mail)
(message-mailto-1 url))
(defun gnus-button-embedded-url (address)
"Activate ADDRESS with `browse-url'."

3
lisp/gnus/gnus-icalendar.el
View file

@ -312,7 +312,8 @@ status will be retrieved from the first matching attendee record."
(unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x))
reply-event-lines)
(error "Could not find an event attendee matching given identity"))
(lwarn 'gnus-icalendar :warning
"Could not find an event attendee matching given identity"))
(mapconcat #'identity `("BEGIN:VEVENT"
,@(nreverse reply-event-lines)

2
lisp/gnus/gnus-sum.el
View file

@ -12284,7 +12284,7 @@ no matter what the properties `:decode' and `:headers' are."
(interactive (gnus-interactive "P\ny"))
(require 'gnus-art)
(let* ((articles (gnus-summary-work-articles n))
(result-buffer "*Shell Command Output*")
(result-buffer shell-command-buffer-name)
(all-headers (not (memq sym '(nil r))))
(gnus-save-all-headers (or all-headers gnus-save-all-headers))
(raw (eq sym 'r))

1
lisp/gnus/gnus-util.el
View file

@ -1654,6 +1654,7 @@ The first found will be returned if a file has hard or symbolic links."
"To each element of LIST apply PREDICATE.
Return nil if LIST is no list or is empty or some test returns nil;
otherwise, return t."
(declare (obsolete nil "28.1"))
(when (and list (listp list))
(let ((result (mapcar predicate list)))
(not (memq nil result)))))

2
lisp/gnus/gnus-win.el
View file

@ -142,7 +142,7 @@ used to display Gnus windows."
(pipe
(vertical 1.0
(summary 0.25 point)
("*Shell Command Output*" 1.0)))
(shell-command-buffer-name 1.0)))
(bug
(vertical 1.0
(if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))

201
lisp/gnus/message.el
View file

@ -303,6 +303,13 @@ any confusion."
:link '(custom-manual "(message)Message Headers")
:type 'regexp)
(defcustom message-screenshot-command '("import" "png:-")
"Command to take a screenshot.
The command should insert a PNG in the current buffer."
:group 'message-various
:type '(list string)
:version "28.1")
;;; Start of variables adopted from `message-utils.el'.
(defcustom message-subject-trailing-was-query t
@ -2730,6 +2737,64 @@ systematically send encrypted emails when possible."
(when (message-all-epg-keys-available-p)
(mml-secure-message-sign-encrypt)))
(defcustom message-openpgp-header nil
"Specification for the \"OpenPGP\" header of outgoing messages.
The value must be a list of three elements, all strings:
- Key ID, in hexadecimal form;
- Key URL or ASCII armoured key; and
- Protection preference, one of: \"unprotected\", \"sign\",
\"encrypt\" or \"signencrypt\".
Each of the elements may be nil, in which case its part in the
OpenPGP header will be left out. If all the values are nil,
or `message-openpgp-header' is itself nil, the OpenPGP header
will not be inserted."
:type '(choice
(const nil :tag "Don't add OpenPGP header")
(list (choice (string :tag "ID")
(const nil :tag "No ID"))
(choice (string :tag "Key")
(const nil :tag "No Key"))
(choice (other nil :tag "None")
(const "unprotected" :tag "Unprotected")
(const "sign" :tag "Sign")
(const "encrypt" :tag "Encrypt")
(const "signencrypt" :tag "Sign and Encrypt"))))
:version "28.1")
(defun message-add-openpgp-header ()
"Add OpenPGP header to point to public key.
Header will be constructed as specified in `message-openpgp-header'.
Consider adding this function to `message-send-hook'."
;; See https://tools.ietf.org/html/draft-josefsson-openpgp-mailnews-header
(when (and message-openpgp-header
(or (nth 0 message-openpgp-header)
(nth 1 message-openpgp-header)
(nth 2 message-openpgp-header)))
(with-temp-buffer
(insert "OpenPGP: ")
;; add ID
(let (need-sep)
(when (nth 0 message-openpgp-header)
(insert "id=" (nth 0 message-openpgp-header))
(setq need-sep t))
;; add URL
(when (nth 1 message-openpgp-header)
(when need-sep (insert "; "))
(if (string-match-p ";")
(insert "url=\"" (nth 1 message-openpgp-header) "\"")
(insert "url=\"" (nth 1 message-openpgp-header) "\""))
(setq need-sep t))
;; add preference
(when (nth 2 message-openpgp-header)
(when need-sep (insert "; "))
(insert "preference=" (nth 2 message-openpgp-header))))
;; insert header
(message-add-header (buffer-string)))))
;;;
@ -2810,6 +2875,7 @@ systematically send encrypted emails when possible."
(define-key message-mode-map [remap split-line] 'message-split-line)
(define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
(define-key message-mode-map "\C-c\C-p" 'message-insert-screenshot)
(define-key message-mode-map "\C-a" 'message-beginning-of-line)
(define-key message-mode-map "\t" 'message-tab)
@ -2839,6 +2905,8 @@ systematically send encrypted emails when possible."
:active (message-mark-active-p) :help "Mark region with enclosing tags"]
["Insert File Marked..." message-mark-insert-file
:help "Insert file at point marked with enclosing tags"]
["Attach File..." mml-attach-file t]
["Insert Screenshot" message-insert-screenshot t]
"----"
["Send Message" message-send-and-exit :help "Send this message"]
["Postpone Message" message-dont-send
@ -6988,15 +7056,28 @@ want to get rid of this query permanently.")))
;; Build the header alist. Allow the user to be asked whether
;; or not to reply to all recipients in a wide reply.
(setq follow-to (list (cons 'To (cdr (pop recipients)))))
(when (and recipients
(or (not message-wide-reply-confirm-recipients)
(y-or-n-p "Reply to all recipients? ")))
(setq recipients (mapconcat
(lambda (addr) (cdr addr)) recipients ", "))
(if (string-match "^ +" recipients)
(setq recipients (substring recipients (match-end 0))))
(push (cons 'Cc recipients) follow-to)))
(when (or (< (length recipients) 2)
(not message-wide-reply-confirm-recipients)
(y-or-n-p "Reply to all recipients? "))
(if never-mct
;; The author has requested never to get a (wide)
;; response, so put everybody else into the To header.
;; This avoids looking as if we're To-in somebody else in
;; specific, and just Cc-in the rest.
(setq follow-to (list
(cons 'To
(mapconcat
(lambda (addr)
(cdr addr)) recipients ", "))))
;; Put the first recipient in the To header.
(setq follow-to (list (cons 'To (cdr (pop recipients)))))
;; Put the rest of the recipients in Cc.
(when recipients
(setq recipients (mapconcat
(lambda (addr) (cdr addr)) recipients ", "))
(if (string-match "^ +" recipients)
(setq recipients (substring recipients (match-end 0))))
(push (cons 'Cc recipients) follow-to)))))
follow-to))
(defun message-prune-recipients (recipients)
@ -8652,6 +8733,108 @@ Used in `message-simplify-recipients'."
(* 0.5 (- (nth 3 edges) (nth 1 edges)))))
string)))))))
(defun message-insert-screenshot (delay)
"Take a screenshot and insert in the current buffer.
DELAY (the numeric prefix) says how many seconds to wait before
starting the screenshotting process.
The `message-screenshot-command' variable says what command is
used to take the screenshot."
(interactive "p")
(unless (executable-find (car message-screenshot-command))
(error "Can't find %s to take the screenshot"
(car message-screenshot-command)))
(cl-decf delay)
(unless (zerop delay)
(dotimes (i delay)
(message "Sleeping %d second%s..."
(- delay i)
(if (= (- delay i) 1)
""
"s"))
(sleep-for 1)))
(message "Take screenshot")
(let ((image
(with-temp-buffer
(set-buffer-multibyte nil)
(apply #'call-process
(car message-screenshot-command) nil (current-buffer) nil
(cdr message-screenshot-command))
(buffer-string))))
(set-mark (point))
(insert-image
(create-image image 'png t
:max-width (truncate (* (frame-pixel-width) 0.8))
:max-height (truncate (* (frame-pixel-height) 0.8))
:scale 1)
(format "<#part type=\"image/png\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>"
;; Get a base64 version of the image -- this avoids later
;; complications if we're auto-saving the buffer and
;; restoring from a file.
(with-temp-buffer
(set-buffer-multibyte nil)
(insert image)
(base64-encode-region (point-min) (point-max) t)
(buffer-string))))
(insert "\n\n")
(message "")))
(declare-function gnus-url-unhex-string "gnus-util")
(defun message-parse-mailto-url (url)
"Parse a mailto: url."
(setq url (replace-regexp-in-string "\n" " " url))
(when (string-match "mailto:/*\\(.*\\)" url)
(setq url (substring url (match-beginning 1) nil)))
(setq url (if (string-match "^\\?" url)
(substring url 1)
(if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
(concat "to=" (match-string 1 url) "&"
(match-string 2 url))
(concat "to=" url))))
(let (retval pairs cur key val)
(setq pairs (split-string url "&"))
(while pairs
(setq cur (car pairs)
pairs (cdr pairs))
(if (not (string-match "=" cur))
nil ; Grace
(setq key (downcase (gnus-url-unhex-string
(substring cur 0 (match-beginning 0))))
val (gnus-url-unhex-string (substring cur (match-end 0) nil) t))
(setq cur (assoc key retval))
(if cur
(setcdr cur (cons val (cdr cur)))
(setq retval (cons (list key val) retval)))))
retval))
;;;###autoload
(defun message-mailto ()
"Command to parse command line mailto: links.
This is meant to be used for MIME handlers: Setting the handler
for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\"
will then start up Emacs ready to compose mail."
(interactive)
;; <a href="mailto:someone@example.com?subject=This%20is%20the%20subject&cc=someone_else@example.com&body=This%20is%20the%20body">Send email</a>
(message-mail)
(message-mailto-1 (pop command-line-args-left)))
(defun message-mailto-1 (url)
(let ((args (message-parse-mailto-url url)))
(dolist (arg args)
(unless (equal (car arg) "body")
(message-position-on-field (capitalize (car arg)))
(insert (replace-regexp-in-string
"\r\n" "\n"
(mapconcat #'identity (reverse (cdr arg)) ", ") nil t))))
(when (assoc "body" args)
(message-goto-body)
(dolist (body (cdr (assoc "body" args)))
(insert body "\n")))
(if (assoc "subject" args)
(message-goto-body)
(message-goto-subject))))
(provide 'message)
(run-hooks 'message-load-hook)

6
lisp/gnus/mm-decode.el
View file

@ -1680,6 +1680,12 @@ If RECURSIVE, search recursively."
(t (y-or-n-p
(format "Decrypt (S/MIME) part? "))))
(mm-view-pkcs7 parts from))
(goto-char (point-min))
;; The encrypted document is a MIME part, and may use either
;; CRLF (Outlook and the like) or newlines for end-of-line
;; markers. Translate from CRLF.
(while (search-forward "\r\n" nil t)
(replace-match "\n"))
;; Normally there will be a Content-type header here, but
;; some mailers don't add that to the encrypted part, which
;; makes the subsequent re-dissection fail here.

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

@ -59,11 +59,16 @@
"The attributes of renderer types for text/html.")
(defcustom mm-fill-flowed t
"If non-nil a format=flowed article will be displayed flowed."
"If non-nil, format=flowed articles will be displayed flowed."
:type 'boolean
:version "22.1"
:group 'mime-display)
;; Not a defcustom, since it's usually overridden by the callers of
;; the mm functions.
(defvar mm-inline-font-lock t
"If non-nil, do font locking of inline media types that support it.")
(defcustom mm-inline-large-images-proportion 0.9
"Maximum proportion large images can occupy in the buffer.
This is only used if `mm-inline-large-images' is set to
@ -502,7 +507,8 @@ If MODE is not set, try to find mode automatically."
(delay-mode-hooks (set-auto-mode))
(setq mode major-mode)))
;; Do not fontify if the guess mode is fundamental.
(unless (eq major-mode 'fundamental-mode)
(when (and (not (eq major-mode 'fundamental-mode))
mm-inline-font-lock)
(font-lock-ensure))))
(setq text (buffer-string))
(when (eq mode 'diff-mode)

12
lisp/gnus/mml-sec.el
View file

@ -665,8 +665,9 @@ The passphrase is read and cached."
(epg-user-id-string uid))))
(equal (downcase (car (mail-header-parse-address
(epg-user-id-string uid))))
(downcase (car (mail-header-parse-address
recipient))))
(downcase (or (car (mail-header-parse-address
recipient))
recipient)))
(not (memq (epg-user-id-validity uid)
'(revoked expired))))
(throw 'break t))))))
@ -937,6 +938,10 @@ If no one is selected, symmetric encryption will be performed. "
(signal (car error) (cdr error))))
cipher))
;; Should probably be removed and the interface should be different.
(defvar mml-secure-allow-signing-with-unknown-recipient nil
"Variable to bind to allow automatic recipient selection.")
(defun mml-secure-epg-sign (protocol mode)
;; Based on code appearing inside mml2015-epg-sign.
(let* ((context (epg-make-context protocol))
@ -953,7 +958,8 @@ If no one is selected, symmetric encryption will be performed. "
;; then there's no point advising the user to examine it. If
;; there are any other variables worth examining, please
;; improve this error message by having it mention them.
(error "Couldn't find any signer names%s" maybe-msg)))
(unless mml-secure-allow-signing-with-unknown-recipient
(error "Couldn't find any signer names%s" maybe-msg))))
(when (eq 'OpenPGP protocol)
(setf (epg-context-armor context) t)
(setf (epg-context-textmode context) t)

13
lisp/gnus/mml.el
View file

@ -295,6 +295,17 @@ part. This is for the internal use, you should never modify the value.")
(t
(mm-find-mime-charset-region point (point)
mm-hack-charsets))))
;; We have a part that already has a transfer encoding. Undo
;; that so that we don't double-encode later.
(when (and raw
(cdr (assq 'data-encoding tag)))
(with-temp-buffer
(set-buffer-multibyte nil)
(insert contents)
(mm-decode-content-transfer-encoding
(intern (cdr (assq 'data-encoding tag)))
(cdr (assq 'type tag)))
(setq contents (buffer-string))))
(when (and (not raw) (memq nil charsets))
(if (or (memq 'unknown-encoding mml-confirmation-set)
(message-options-get 'unknown-encoding)
@ -313,8 +324,8 @@ Message contains characters with unknown encoding. Really send? ")
(eq 'mml (car tag))
(< (length charsets) 2))
(if (or (not no-markup-p)
;; Don't create blank parts.
(string-match "[^ \t\r\n]" contents))
;; Don't create blank parts.
(push (nconc tag (list (cons 'contents contents)))
struct))
(let ((nstruct (mml-parse-singlepart-with-multiple-charsets

3
lisp/gnus/smime.el
View file

@ -185,6 +185,9 @@ and the files themselves should be in PEM format."
:version "22.1"
:type '(choice (const :tag "Triple DES" "-des3")
(const :tag "DES" "-des")
(const :tag "AES 256 bits" "-aes256")
(const :tag "AES 192 bits" "-aes192")
(const :tag "AES 128 bits" "-aes128")
(const :tag "RC2 40 bits" "-rc2-40")
(const :tag "RC2 64 bits" "-rc2-64")
(const :tag "RC2 128 bits" "-rc2-128"))

44
lisp/help-fns.el
View file

@ -1778,6 +1778,50 @@ documentation for the major and minor modes of that buffer."
;; For the sake of IELM and maybe others
nil)
;; Widgets.
(defvar describe-widget-functions
'(button-describe widget-describe)
"A list of functions for `describe-widget' to call.
Each function should take one argument, a buffer position, and return
non-nil if it described a widget at that position.")
;;;###autoload
(defun describe-widget (&optional pos)
"Display a buffer with information about a widget.
You can use this command to describe buttons (e.g., the links in a *Help*
buffer), editable fields of the customization buffers, etc.
Interactively, click on a widget to describe it, or hit RET to describe the
widget at point.
When called from Lisp, POS may be a buffer position or a mouse position list.
Calls each function of the list `describe-widget-functions' in turn, until
one of them returns non-nil."
(interactive
(list
(let ((key
(read-key
"Click on a widget, or hit RET to describe the widget at point")))
(cond ((eq key ?\C-m) (point))
((and (mouse-event-p key)
(eq (event-basic-type key) 'mouse-1)
(equal (event-modifiers key) '(click)))
(event-end key))
((eq key ?\C-g) (signal 'quit nil))
(t (user-error "You didn't specify a widget"))))))
(let (buf)
;; Allow describing a widget in a different window.
(when (posnp pos)
(setq buf (window-buffer (posn-window pos))
pos (posn-point pos)))
(with-current-buffer (or buf (current-buffer))
(unless (cl-some (lambda (fun) (when (fboundp fun) (funcall fun pos)))
describe-widget-functions)
(message "No widget found at that position")))))
;;; Replacements for old lib-src/ programs. Don't seem especially useful.
;; Replaces lib-src/digest-doc.c.

4
lisp/hi-lock.el
View file

@ -812,7 +812,9 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock search."
(setq hi-lock-interactive-patterns
(cdr hi-lock-interactive-patterns)
hi-lock-interactive-lighters
(cdr hi-lock-interactive-lighters)))))))))
(cdr hi-lock-interactive-lighters))))
(when (or (> search-start (point-min)) (< search-end (point-max)))
(message "Hi-lock added only in range %d-%d" search-start search-end)))))))
(defun hi-lock-set-file-patterns (patterns)
"Replace file patterns list with PATTERNS and refontify."

6
lisp/ibuf-ext.el
View file

@ -504,7 +504,7 @@ format. See `ibuffer-update-saved-filters-format' and
(ibuffer-forward-line 0))
(defun ibuffer--maybe-erase-shell-cmd-output ()
(let ((buf (get-buffer "*Shell Command Output*")))
(let ((buf (get-buffer shell-command-buffer-name)))
(when (and (buffer-live-p buf)
(not shell-command-dont-erase-buffer)
(not (zerop (buffer-size buf))))
@ -517,7 +517,7 @@ format. See `ibuffer-update-saved-filters-format' and
:opstring "Shell command executed on"
:before (ibuffer--maybe-erase-shell-cmd-output)
:modifier-p nil)
(let ((out-buf (get-buffer-create "*Shell Command Output*")))
(let ((out-buf (get-buffer-create shell-command-buffer-name)))
(with-current-buffer out-buf (goto-char (point-max)))
(call-shell-region (point-min) (point-max)
command nil out-buf)))
@ -542,7 +542,7 @@ format. See `ibuffer-update-saved-filters-format' and
:modifier-p nil)
(let ((file (and (not (buffer-modified-p))
buffer-file-name))
(out-buf (get-buffer-create "*Shell Command Output*")))
(out-buf (get-buffer-create shell-command-buffer-name)))
(unless (and file (file-exists-p file))
(setq file
(make-temp-file

12
lisp/image-file.el
View file

@ -32,6 +32,7 @@
;;; Code:
(require 'image)
(require 'image-converter)
;;;###autoload
@ -80,10 +81,13 @@ the variable is set using \\[customize]."
(let ((exts-regexp
(and image-file-name-extensions
(concat "\\."
(regexp-opt (nconc (mapcar #'upcase
image-file-name-extensions)
image-file-name-extensions)
t)
(regexp-opt
(append (mapcar #'upcase image-file-name-extensions)
image-file-name-extensions
(mapcar #'upcase
image-converter-file-name-extensions)
image-converter-file-name-extensions)
t)
"\\'"))))
(mapconcat
'identity

153
lisp/image-mode.el
View file

@ -40,6 +40,7 @@
(require 'image)
(require 'exif)
(require 'dired)
(eval-when-compile (require 'cl-lib))
;;; Image mode window-info management.
@ -614,21 +615,23 @@ Key bindings:
(if (not (image-get-display-property))
(progn
(when (condition-case err
(progn
(image-toggle-display-image)
t)
(unknown-image-type
(image-mode-as-text)
(funcall
(if (called-interactively-p 'any) 'error 'message)
"Unknown image type; consider switching `image-use-external-converter' on")
nil)
(error
(image-mode-as-text)
(funcall
(if (called-interactively-p 'any) 'error 'message)
"Cannot display image: %s" (cdr err))
nil))
(progn
(image-toggle-display-image)
t)
(unknown-image-type
(image-mode-as-text)
(funcall
(if (called-interactively-p 'any) 'error 'message)
(if image-use-external-converter
"Unknown image type"
"Unknown image type; consider switching `image-use-external-converter' on"))
nil)
(error
(image-mode-as-text)
(funcall
(if (called-interactively-p 'any) 'error 'message)
"Cannot display image: %s" (cdr err))
nil))
;; If attempt to display the image fails.
(if (not (image-get-display-property))
(error "Invalid image"))
@ -816,13 +819,21 @@ was inserted."
(- (nth 2 edges) (nth 0 edges))))
(max-height (when edges
(- (nth 3 edges) (nth 1 edges))))
(type (if (image--imagemagick-wanted-p filename)
'imagemagick
(image-type file-or-data nil data-p)))
(inhibit-read-only t)
(buffer-undo-list t)
(modified (buffer-modified-p))
props image)
props image type)
;; If the data in the current buffer isn't from an existing file,
;; but we have a file name (this happens when visiting images from
;; a zip file, for instance), provide a type hint based on the
;; suffix.
(when (and data-p filename)
(setq data-p (intern (format "image/%s"
(file-name-extension filename)))))
(setq type (if (image--imagemagick-wanted-p filename)
'imagemagick
(image-type file-or-data nil data-p)))
;; Get the rotation data from the file, if any.
(when (zerop image-transform-rotation) ; don't reset modified value
@ -839,10 +850,13 @@ was inserted."
;; :scale 1: If we do not set this, create-image will apply
;; default scaling based on font size.
(setq image (if (not edges)
(create-image file-or-data type data-p :scale 1)
(create-image file-or-data type data-p :scale 1
:format (and filename data-p))
(create-image file-or-data type data-p :scale 1
:max-width max-width
:max-height max-height)))
:max-height max-height
;; Type hint.
:format (and filename data-p))))
;; Discard any stale image data before looking it up again.
(image-flush image)
@ -1072,28 +1086,87 @@ replacing the current Image mode buffer."
(error "The buffer is not in Image mode"))
(unless buffer-file-name
(error "The current image is not associated with a file"))
(let* ((file (file-name-nondirectory buffer-file-name))
(images (image-mode--images-in-directory file))
(idx 0))
(catch 'image-visit-next-file
(dolist (f images)
(if (string= f file)
(throw 'image-visit-next-file (1+ idx)))
(setq idx (1+ idx))))
(setq idx (mod (+ idx (or n 1)) (length images)))
(let ((image (nth idx images))
(dir (file-name-directory buffer-file-name)))
(find-alternate-file image)
;; If we have dired buffer(s) open to where this image is, then
;; place point on it.
(let ((next (image-mode--next-file buffer-file-name n)))
(unless next
(user-error "No %s file in this directory"
(if (> n 0)
"next"
"prev")))
(if (stringp next)
(find-alternate-file next)
(funcall next))))
(defun image-mode--directory-buffers (file)
"Return a alist of type/buffer for all \"parent\" buffers to image FILE.
This is normally a list of dired buffers, but can also be archive and
tar mode buffers."
(let ((buffers nil)
(dir (file-name-directory file)))
(cond
((and (boundp 'tar-superior-buffer)
tar-superior-buffer)
(when (buffer-live-p tar-superior-buffer)
(push (cons 'tar tar-superior-buffer) buffers)))
((and (boundp 'archive-superior-buffer)
archive-superior-buffer)
(when (buffer-live-p archive-superior-buffer)
(push (cons 'archive archive-superior-buffer) buffers)))
(t
;; Find a dired buffer.
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (and (derived-mode-p 'dired-mode)
(with-current-buffer buffer
(when (and (derived-mode-p 'dired-mode)
(equal (file-truename dir)
(file-truename default-directory)))
(save-window-excursion
(switch-to-buffer (current-buffer) t t)
(dired-goto-file (expand-file-name image dir)))))))))
(push (cons 'dired (current-buffer)) buffers))))
;; If we can't find any buffers to navigate in, we open a dired
;; buffer.
(unless buffers
(push (cons 'dired (find-file-noselect dir)) buffers)
(message "Opened a dired buffer on %s" dir))))
buffers))
(declare-function archive-next-file-displayer "arc-mode")
(declare-function tar-next-file-displayer "tar-mode")
(defun image-mode--next-file (file n)
"Go to the next image file in the parent buffer of FILE.
This is typically a dired buffer, but may also be a tar/archive buffer.
Return the next image file from that buffer.
If N is negative, go to the previous file."
(let ((regexp (image-file-name-regexp))
(buffers (image-mode--directory-buffers file))
next)
(dolist (buffer buffers)
;; We do this traversal for all the dired buffers open on this
;; directory. There probably is just one, but we want to move
;; point in all of them.
(save-window-excursion
(switch-to-buffer (cdr buffer) t t)
(cl-case (car buffer)
('dired
(dired-goto-file file)
(let (found)
(while (and (not found)
;; Stop if we reach the end/start of the buffer.
(if (> n 0)
(not (eobp))
(not (bobp))))
(dired-next-line n)
(let ((candidate (dired-get-filename nil t)))
(when (and candidate
(string-match-p regexp candidate))
(setq found candidate))))
(if found
(setq next found)
;; If we didn't find a next/prev file, then restore
;; point.
(dired-goto-file file))))
('archive
(setq next (archive-next-file-displayer file regexp n)))
('tar
(setq next (tar-next-file-displayer file regexp n))))))
next))
(defun image-previous-file (&optional n)
"Visit the preceding image in the same directory as the current file.

14
lisp/image/image-converter.el
View file

@ -42,6 +42,9 @@ installed on the system."
(defvar image-converter-regexp nil
"A regexp that matches the file name suffixes that can be converted.")
(defvar image-converter-file-name-extensions nil
"A list of file name suffixes that can be converted.")
(defvar image-converter--converters
'((graphicsmagick :command ("gm" "convert") :probe ("-list" "format"))
(ffmpeg :command "ffmpeg" :probe "-decoders")
@ -58,9 +61,11 @@ is a string, it should be a MIME format string like
(unless image-converter
(image-converter--find-converter))
;; When image-converter was customized
(if (and image-converter (not image-converter-regexp))
(when-let ((formats (image-converter--probe image-converter)))
(setq image-converter-regexp (concat "\\." (regexp-opt formats) "\\'"))))
(when (and image-converter (not image-converter-regexp))
(when-let ((formats (image-converter--probe image-converter)))
(setq image-converter-regexp
(concat "\\." (regexp-opt formats) "\\'"))
(setq image-converter-file-name-extensions formats)))
(and image-converter
(or (and (not data-p)
(string-match image-converter-regexp source))
@ -183,7 +188,8 @@ data is returned as a string."
(dolist (elem image-converter--converters)
(when-let ((formats (image-converter--probe (car elem))))
(setq image-converter (car elem)
image-converter-regexp (concat "\\." (regexp-opt formats) "\\'"))
image-converter-regexp (concat "\\." (regexp-opt formats) "\\'")
image-converter-file-name-extensions formats)
(throw 'done image-converter)))))
(cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source

13
lisp/international/ja-dic-cnv.el
View file

@ -48,7 +48,7 @@
(defvar ja-dic-filename "ja-dic.el")
(defun skkdic-convert-okuri-ari (skkbuf buf)
(byte-compile-info-message "Processing OKURI-ARI entries")
(byte-compile-info "Processing OKURI-ARI entries" t)
(goto-char (point-min))
(with-current-buffer buf
(insert ";; Setting okuri-ari entries.\n"
@ -97,7 +97,7 @@
("ゆき" "行")))
(defun skkdic-convert-postfix (skkbuf buf)
(byte-compile-info-message "Processing POSTFIX entries")
(byte-compile-info "Processing POSTFIX entries" t)
(goto-char (point-min))
(with-current-buffer buf
(insert ";; Setting postfix entries.\n"
@ -151,7 +151,7 @@
(defconst skkdic-prefix-list '(skkdic-prefix-list))
(defun skkdic-convert-prefix (skkbuf buf)
(byte-compile-info-message "Processing PREFIX entries")
(byte-compile-info "Processing PREFIX entries" t)
(goto-char (point-min))
(with-current-buffer buf
(insert ";; Setting prefix entries.\n"
@ -273,7 +273,7 @@
(defun skkdic-collect-okuri-nasi ()
(save-excursion
(let ((progress (make-progress-reporter
(byte-compile-info-message "Collecting OKURI-NASI entries")
(byte-compile-info "Collecting OKURI-NASI entries" t)
(point) (point-max)
nil 10)))
(while (re-search-forward "^\\(\\cH+\\) \\(/\\cj.*\\)/$"
@ -301,7 +301,7 @@
"(skkdic-set-okuri-nasi\n")
(let ((l (nreverse skkdic-okuri-nasi-entries))
(progress (make-progress-reporter
(byte-compile-info-message "Processing OKURI-NASI entries")
(byte-compile-info "Processing OKURI-NASI entries" t)
0 skkdic-okuri-nasi-entries-count
nil 10))
(count 0))
@ -531,8 +531,7 @@ To get complete usage, invoke:
',(let ((l entries)
(map '(skdic-okuri-nasi))
(progress (make-progress-reporter
(byte-compile-info-message
"Extracting OKURI-NASI entries")
(byte-compile-info "Extracting OKURI-NASI entries")
0 (length entries)))
(count 0)
entry)

5
lisp/mouse.el
View file

@ -49,7 +49,10 @@
"If non-nil, copy to kill-ring upon mouse adjustments of the region.
This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in
addition to mouse drags."
addition to mouse drags.
This variable applies only to mouse adjustments in Emacs, not
selecting and adjusting regions in other windows."
:type 'boolean
:version "24.1")

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

@ -1,4 +1,4 @@
;;; browse-url.el --- pass a URL to a WWW browser
;;; browse-url.el --- pass a URL to a WWW browser -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
@ -425,25 +425,6 @@ Passing an interactive argument to \\[browse-url], or specific browser
commands reverses the effect of this variable."
:type 'boolean)
(defcustom browse-url-mosaic-program "xmosaic"
"The name by which to invoke Mosaic (or mMosaic)."
:type 'string
:version "20.3")
(make-obsolete-variable 'browse-url-mosaic-program nil "25.1")
(defcustom browse-url-mosaic-arguments nil
"A list of strings to pass to Mosaic as arguments."
:type '(repeat (string :tag "Argument")))
(make-obsolete-variable 'browse-url-mosaic-arguments nil "25.1")
(defcustom browse-url-mosaic-pidfile "~/.mosaicpid"
"The name of the pidfile created by Mosaic."
:type 'string)
(make-obsolete-variable 'browse-url-mosaic-pidfile nil "25.1")
(defcustom browse-url-conkeror-program "conkeror"
"The name by which to invoke Conkeror."
:type 'string
@ -498,22 +479,6 @@ Used by the `browse-url-of-file' command."
"Hook run after `browse-url-of-file' has asked a browser to load a file."
:type 'hook)
(defcustom browse-url-CCI-port 3003
"Port to access XMosaic via CCI.
This can be any number between 1024 and 65535 but must correspond to
the value set in the browser."
:type 'integer)
(make-obsolete-variable 'browse-url-CCI-port nil "25.1")
(defcustom browse-url-CCI-host "localhost"
"Host to access XMosaic via CCI.
This should be the host name of the machine running XMosaic with CCI
enabled. The port number should be set in `browse-url-CCI-port'."
:type 'string)
(make-obsolete-variable 'browse-url-CCI-host nil "25.1")
(defvar browse-url-temp-file-name nil)
(make-variable-buffer-local 'browse-url-temp-file-name)
@ -622,7 +587,7 @@ process), or nil (we don't know)."
kind)))
(defun browse-url--mailto (url &rest args)
"Calls `browse-url-mailto-function' with URL and ARGS."
"Call `browse-url-mailto-function' with URL and ARGS."
(funcall browse-url-mailto-function url args))
(defun browse-url--browser-kind-mailto (url)
@ -631,7 +596,7 @@ process), or nil (we don't know)."
#'browse-url--browser-kind-mailto)
(defun browse-url--man (url &rest args)
"Calls `browse-url-man-function' with URL and ARGS."
"Call `browse-url-man-function' with URL and ARGS."
(funcall browse-url-man-function url args))
(defun browse-url--browser-kind-man (url)
@ -640,7 +605,7 @@ process), or nil (we don't know)."
#'browse-url--browser-kind-man)
(defun browse-url--browser (url &rest args)
"Calls `browse-url-browser-function' with URL and ARGS."
"Call `browse-url-browser-function' with URL and ARGS."
(funcall browse-url-browser-function url args))
(defun browse-url--browser-kind-browser (url)
@ -854,8 +819,8 @@ narrowed."
(browse-url-of-file file-name))))
(defun browse-url-delete-temp-file (&optional temp-file-name)
;; Delete browse-url-temp-file-name from the file system
;; If optional arg TEMP-FILE-NAME is non-nil, delete it instead
"Delete `browse-url-temp-file-name' from the file system.
If optional arg TEMP-FILE-NAME is non-nil, delete it instead."
(let ((file-name (or temp-file-name browse-url-temp-file-name)))
(if (and file-name (file-exists-p file-name))
(delete-file file-name))))
@ -1075,8 +1040,6 @@ instead of `browse-url-new-window-flag'."
;;; ((executable-find browse-url-galeon-program) 'browse-url-galeon)
((executable-find browse-url-kde-program) 'browse-url-kde)
;;; ((executable-find browse-url-netscape-program) 'browse-url-netscape)
;;; ((executable-find browse-url-mosaic-program) 'browse-url-mosaic)
;;; ((executable-find browse-url-conkeror-program) 'browse-url-conkeror)
((executable-find browse-url-chrome-program) 'browse-url-chrome)
((executable-find browse-url-xterm-program) 'browse-url-text-xterm)
((locate-library "w3") 'browse-url-w3)
@ -1444,93 +1407,6 @@ used instead of `browse-url-new-window-flag'."
(function-put 'browse-url-gnome-moz 'browse-url-browser-kind 'external)
;; --- Mosaic ---
;;;###autoload
(defun browse-url-mosaic (url &optional new-window)
"Ask the XMosaic WWW browser to load URL.
Default to the URL around or before point. The strings in variable
`browse-url-mosaic-arguments' are also passed to Mosaic and the
program is invoked according to the variable
`browse-url-mosaic-program'.
When called interactively, if variable `browse-url-new-window-flag' is
non-nil, load the document in a new Mosaic window, otherwise use a
random existing one. A non-nil interactive prefix argument reverses
the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
(declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "Mosaic URL: "))
(let ((pidfile (expand-file-name browse-url-mosaic-pidfile))
pid)
(if (file-readable-p pidfile)
(with-temp-buffer
(insert-file-contents pidfile)
(setq pid (read (current-buffer)))))
(if (and (integerp pid) (zerop (signal-process pid 0))) ; Mosaic running
(progn
(with-temp-buffer
(insert (if (browse-url-maybe-new-window new-window)
"newwin\n"
"goto\n")
url "\n")
(with-file-modes ?\700
(if (file-exists-p
(setq pidfile (format "/tmp/Mosaic.%d" pid)))
(delete-file pidfile))
;; https://debbugs.gnu.org/17428. Use O_EXCL.
(write-region nil nil pidfile nil 'silent nil 'excl)))
;; Send signal SIGUSR to Mosaic
(message "Signaling Mosaic...")
(signal-process pid 'SIGUSR1)
;; Or you could try:
;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid))
(message "Signaling Mosaic...done"))
;; Mosaic not running - start it
(message "Starting %s..." browse-url-mosaic-program)
(apply 'start-process "xmosaic" nil browse-url-mosaic-program
(append browse-url-mosaic-arguments (list url)))
(message "Starting %s...done" browse-url-mosaic-program))))
(function-put 'browse-url-mosaic 'browse-url-browser-kind 'external)
;; --- Mosaic using CCI ---
;;;###autoload
(defun browse-url-cci (url &optional new-window)
"Ask the XMosaic WWW browser to load URL.
Default to the URL around or before point.
This function only works for XMosaic version 2.5 or later. You must
select `CCI' from XMosaic's File menu, set the CCI Port Address to the
value of variable `browse-url-CCI-port', and enable `Accept requests'.
When called interactively, if variable `browse-url-new-window-flag' is
non-nil, load the document in a new browser window, otherwise use a
random existing one. A non-nil interactive prefix argument reverses
the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
(declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "Mosaic URL: "))
(open-network-stream "browse-url" " *browse-url*"
browse-url-CCI-host browse-url-CCI-port)
;; Todo: start browser if fails
(process-send-string "browse-url"
(concat "get url (" url ") output "
(if (browse-url-maybe-new-window new-window)
"new"
"current")
"\r\n"))
(process-send-string "browse-url" "disconnect\r\n")
(delete-process "browse-url"))
(function-put 'browse-url-cci 'browse-url-browser-kind 'external)
;; --- Conkeror ---
;;;###autoload
(defun browse-url-conkeror (url &optional new-window)

18
lisp/net/eww.el
View file

@ -276,6 +276,24 @@ This list can be customized via `eww-suggest-uris'."
(push uri uris)))))
(nreverse uris)))
;;;###autoload
(defun eww-browse ()
"Function to be run to parse command line URLs.
This is meant to be used for MIME handlers or command line use.
Setting the handler for \"text/x-uri;\" to
\"emacs -f eww-browse %u\" will then start up Emacs and call eww
to browse the url.
This can also be used on the command line directly:
emacs -f eww-browse https://gnu.org
will start Emacs and browse the GNU web site."
(interactive)
(eww (pop command-line-args-left)))
;;;###autoload
(defun eww (url &optional arg buffer)
"Fetch URL and render the page.

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

@ -96,8 +96,10 @@ It is used for TCP/IP devices."
(tramp--with-startup
(add-to-list 'tramp-methods
`(,tramp-adb-method
(tramp-tmpdir "/data/local/tmp")
(tramp-default-port 5555)))
(tramp-login-program ,tramp-adb-program)
(tramp-login-args (("shell")))
(tramp-tmpdir "/data/local/tmp")
(tramp-default-port 5555)))
(add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil ""))
@ -885,158 +887,163 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; The complete STDERR buffer is available only when the process has
;; terminated.
(defun tramp-adb-handle-make-process (&rest args)
"Like `make-process' for Tramp files."
(when args
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((name (plist-get args :name))
(buffer (plist-get args :buffer))
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
(connection-type (plist-get args :connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
(unless (stringp name)
(signal 'wrong-type-argument (list #'stringp name)))
(unless (or (null buffer) (bufferp buffer) (stringp buffer))
(signal 'wrong-type-argument (list #'stringp buffer)))
(unless (consp command)
(signal 'wrong-type-argument (list #'consp command)))
(unless (or (null coding)
(and (symbolp coding) (memq coding coding-system-list))
(and (consp coding)
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
(unless (or (null connection-type) (memq connection-type '(pipe pty)))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
(unless (or (null sentinel) (functionp sentinel))
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
(signal 'wrong-type-argument (list #'stringp stderr)))
(when (and (stringp stderr) (tramp-tramp-file-p stderr)
(not (tramp-equal-remote default-directory stderr)))
(signal 'file-error (list "Wrong stderr" stderr)))
"Like `make-process' for Tramp files.
If connection property \"direct-async-process\" is non-nil, an
alternative implementation will be used."
(if (tramp-get-connection-property
(tramp-dissect-file-name default-directory) "direct-async-process" nil)
(apply #'tramp-handle-make-process args)
(when args
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((name (plist-get args :name))
(buffer (plist-get args :buffer))
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
(connection-type (plist-get args :connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
(unless (stringp name)
(signal 'wrong-type-argument (list #'stringp name)))
(unless (or (null buffer) (bufferp buffer) (stringp buffer))
(signal 'wrong-type-argument (list #'stringp buffer)))
(unless (consp command)
(signal 'wrong-type-argument (list #'consp command)))
(unless (or (null coding)
(and (symbolp coding) (memq coding coding-system-list))
(and (consp coding)
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
(unless (or (null connection-type) (memq connection-type '(pipe pty)))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
(unless (or (null sentinel) (functionp sentinel))
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
(signal 'wrong-type-argument (list #'stringp stderr)))
(when (and (stringp stderr) (tramp-tramp-file-p stderr)
(not (tramp-equal-remote default-directory stderr)))
(signal 'file-error (list "Wrong stderr" stderr)))
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
;; STDERR can also be a file name.
(tmpstderr
(and stderr
(if (and (stringp stderr) (tramp-tramp-file-p stderr))
(tramp-unquote-file-local-name stderr)
(tramp-make-tramp-temp-file v))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
(program (car command))
(args (cdr command))
(command
(format "cd %s && exec %s %s"
(tramp-shell-quote-argument localname)
(if tmpstderr (format "2>'%s'" tmpstderr) "")
(mapconcat #'tramp-shell-quote-argument
(cons program args) " ")))
(tramp-process-connection-type
(or (null program) tramp-process-connection-type))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0))
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
;; STDERR can also be a file name.
(tmpstderr
(and stderr
(if (and (stringp stderr) (tramp-tramp-file-p stderr))
(tramp-unquote-file-local-name stderr)
(tramp-make-tramp-temp-file v))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
(program (car command))
(args (cdr command))
(command
(format "cd %s && exec %s %s"
(tramp-shell-quote-argument localname)
(if tmpstderr (format "2>'%s'" tmpstderr) "")
(mapconcat #'tramp-shell-quote-argument
(cons program args) " ")))
(tramp-process-connection-type
(or (null program) tramp-process-connection-type))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0))
(while (get-process name1)
;; NAME must be unique as process name.
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(setq name name1)
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name)
(tramp-set-connection-property v "process-buffer" buffer)
(while (get-process name1)
;; NAME must be unique as process name.
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(setq name name1)
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name)
(tramp-set-connection-property v "process-buffer" buffer)
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
;; We catch this event. Otherwise, `make-process'
;; could be called on the local host.
(save-excursion
(save-restriction
;; Activate narrowing in order to save BUFFER
;; contents. Clear also the modification time;
;; otherwise we might be interrupted by
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(inhibit-read-only t))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-adb-maybe-open-connection', in
;; order to cleanup the prompt afterwards.
(tramp-adb-maybe-open-connection v)
(delete-region (point-min) (point-max))
;; Send the command.
(let* ((p (tramp-get-connection-process v)))
(tramp-adb-send-command v command nil t) ; nooutput
;; Set sentinel and filter.
(when sentinel
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
;; Set query flag and process marker for this
;; process. We ignore errors, because the
;; process could have finished already.
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point)))
;; We must flush them here already; otherwise
;; `rename-file', `delete-file' or
;; `insert-file-contents' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")
;; Copy tmpstderr file.
(when (and (stringp stderr)
(not (tramp-tramp-file-p stderr)))
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(rename-file remote-tmpstderr stderr))))
;; Read initial output. Remove the first line,
;; which is the command echo.
(while
(progn
(goto-char (point-min))
(not (re-search-forward "[\n]" nil t)))
(tramp-accept-process-output p 0))
(delete-region (point-min) (point))
;; Provide error buffer. This shows only
;; initial error messages; messages arriving
;; later on will be inserted when the process
;; is deleted. The temporary file will exist
;; until the process is deleted.
(when (bufferp stderr)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit))
;; Delete tmpstderr file.
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit nil nil 'replace))
(delete-file remote-tmpstderr))))
;; Return process.
p))))
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
;; We catch this event. Otherwise, `make-process'
;; could be called on the local host.
(save-excursion
(save-restriction
;; Activate narrowing in order to save BUFFER
;; contents. Clear also the modification time;
;; otherwise we might be interrupted by
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(inhibit-read-only t))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-adb-maybe-open-connection',
;; in order to cleanup the prompt afterwards.
(tramp-adb-maybe-open-connection v)
(delete-region (point-min) (point-max))
;; Send the command.
(let* ((p (tramp-get-connection-process v)))
(tramp-adb-send-command v command nil t) ; nooutput
;; Set sentinel and filter.
(when sentinel
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
;; Set query flag and process marker for
;; this process. We ignore errors, because
;; the process could have finished already.
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point)))
;; We must flush them here already;
;; otherwise `rename-file', `delete-file' or
;; `insert-file-contents' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")
;; Copy tmpstderr file.
(when (and (stringp stderr)
(not (tramp-tramp-file-p stderr)))
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(rename-file remote-tmpstderr stderr))))
;; Read initial output. Remove the first
;; line, which is the command echo.
(while
(progn
(goto-char (point-min))
(not (re-search-forward "[\n]" nil t)))
(tramp-accept-process-output p 0))
(delete-region (point-min) (point))
;; Provide error buffer. This shows only
;; initial error messages; messages arriving
;; later on will be inserted when the
;; process is deleted. The temporary file
;; will exist until the process is deleted.
(when (bufferp stderr)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit))
;; Delete tmpstderr file.
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit nil nil 'replace))
(delete-file remote-tmpstderr))))
;; Return process.
p))))
;; Save exit.
(if (string-match-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp))
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer"))))))))
;; Save exit.
(if (string-match-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp))
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")))))))))
(defun tramp-adb-handle-exec-path ()
"Like `exec-path' for Tramp files."
@ -1253,6 +1260,14 @@ connection if a previous connection has died for some reason."
(tramp-adb-send-command
vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
;; Disable line editing.
(tramp-adb-send-command
vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs")
;; Dump option settings in the traces.
(when (>= tramp-verbose 9)
(tramp-adb-send-command vec "set -o"))
;; Check whether the properties have been changed. If
;; yes, this is a strong indication that we must expire all
;; connection properties. We start again.

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

@ -2787,228 +2787,233 @@ the result will be a local, non-Tramp, file name."
;; terminated.
(defun tramp-sh-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
STDERR can also be a file name."
(when args
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((name (plist-get args :name))
(buffer (plist-get args :buffer))
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
(connection-type (plist-get args :connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
(unless (stringp name)
(signal 'wrong-type-argument (list #'stringp name)))
(unless (or (null buffer) (bufferp buffer) (stringp buffer))
(signal 'wrong-type-argument (list #'stringp buffer)))
(unless (consp command)
(signal 'wrong-type-argument (list #'consp command)))
(unless (or (null coding)
(and (symbolp coding) (memq coding coding-system-list))
(and (consp coding)
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
(unless (or (null connection-type) (memq connection-type '(pipe pty)))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
(unless (or (null sentinel) (functionp sentinel))
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
(signal 'wrong-type-argument (list #'stringp stderr)))
(when (and (stringp stderr) (tramp-tramp-file-p stderr)
(not (tramp-equal-remote default-directory stderr)))
(signal 'file-error (list "Wrong stderr" stderr)))
STDERR can also be a file name. If connection property
\"direct-async-process\" is non-nil, an alternative
implementation will be used."
(if (tramp-get-connection-property
(tramp-dissect-file-name default-directory) "direct-async-process" nil)
(apply #'tramp-handle-make-process args)
(when args
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((name (plist-get args :name))
(buffer (plist-get args :buffer))
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
(connection-type (plist-get args :connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
(unless (stringp name)
(signal 'wrong-type-argument (list #'stringp name)))
(unless (or (null buffer) (bufferp buffer) (stringp buffer))
(signal 'wrong-type-argument (list #'stringp buffer)))
(unless (consp command)
(signal 'wrong-type-argument (list #'consp command)))
(unless (or (null coding)
(and (symbolp coding) (memq coding coding-system-list))
(and (consp coding)
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
(unless (or (null connection-type) (memq connection-type '(pipe pty)))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
(unless (or (null sentinel) (functionp sentinel))
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
(signal 'wrong-type-argument (list #'stringp stderr)))
(when (and (stringp stderr) (tramp-tramp-file-p stderr)
(not (tramp-equal-remote default-directory stderr)))
(signal 'file-error (list "Wrong stderr" stderr)))
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
;; STDERR can also be a file name.
(tmpstderr
(and stderr
(if (and (stringp stderr) (tramp-tramp-file-p stderr))
(tramp-unquote-file-local-name stderr)
(tramp-make-tramp-temp-file v))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
(program (car command))
(args (cdr command))
;; When PROGRAM matches "*sh", and the first arg is
;; "-c", it might be that the arguments exceed the
;; command line length. Therefore, we modify the
;; command.
(heredoc (and (stringp program)
(string-match-p "sh$" program)
(string-equal "-c" (car args))
(= (length args) 2)))
;; When PROGRAM is nil, we just provide a tty.
(args (if (not heredoc) args
(let ((i 250))
(while (and (< i (length (cadr args)))
(string-match " " (cadr args) i))
(setcdr
args
(list
(replace-match " \\\\\n" nil nil (cadr args))))
(setq i (+ i 250))))
(cdr args)))
;; Use a human-friendly prompt, for example for
;; `shell'. We discard hops, if existing, that's why
;; we cannot use `file-remote-p'.
(prompt (format "PS1=%s %s"
(tramp-make-tramp-file-name v nil 'nohop)
tramp-initial-end-of-output))
;; We use as environment the difference to toplevel
;; `process-environment'.
env uenv
(env (dolist (elt (cons prompt process-environment) env)
(or (member
elt (default-toplevel-value 'process-environment))
(if (string-match-p "=" elt)
(setq env (append env `(,elt)))
(if (tramp-get-env-with-u-option v)
(setq env (append `("-u" ,elt) env))
(setq uenv (cons elt uenv)))))))
(command
(when (stringp program)
(setenv-internal
env "INSIDE_EMACS"
(concat (or (getenv "INSIDE_EMACS") emacs-version)
",tramp:" tramp-version)
'keep)
(format "cd %s && %s exec %s %s env %s %s"
(tramp-shell-quote-argument localname)
(if uenv
(format
"unset %s &&"
(mapconcat
#'tramp-shell-quote-argument uenv " "))
"")
(if heredoc (format "<<'%s'" tramp-end-of-heredoc) "")
(if tmpstderr (format "2>'%s'" tmpstderr) "")
(mapconcat #'tramp-shell-quote-argument env " ")
(if heredoc
(format "%s\n(\n%s\n) </dev/tty\n%s"
program (car args) tramp-end-of-heredoc)
(mapconcat #'tramp-shell-quote-argument
(cons program args) " ")))))
(tramp-process-connection-type
(or (null program) tramp-process-connection-type))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0)
;; We do not want to raise an error when `make-process'
;; has been started several times in `eshell' and
;; friends.
tramp-current-connection
p)
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
;; STDERR can also be a file name.
(tmpstderr
(and stderr
(if (and (stringp stderr) (tramp-tramp-file-p stderr))
(tramp-unquote-file-local-name stderr)
(tramp-make-tramp-temp-file v))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
(program (car command))
(args (cdr command))
;; When PROGRAM matches "*sh", and the first arg is
;; "-c", it might be that the arguments exceed the
;; command line length. Therefore, we modify the
;; command.
(heredoc (and (stringp program)
(string-match-p "sh$" program)
(string-equal "-c" (car args))
(= (length args) 2)))
;; When PROGRAM is nil, we just provide a tty.
(args (if (not heredoc) args
(let ((i 250))
(while (and (< i (length (cadr args)))
(string-match " " (cadr args) i))
(setcdr
args
(list
(replace-match " \\\\\n" nil nil (cadr args))))
(setq i (+ i 250))))
(cdr args)))
;; Use a human-friendly prompt, for example for
;; `shell'. We discard hops, if existing, that's why
;; we cannot use `file-remote-p'.
(prompt (format "PS1=%s %s"
(tramp-make-tramp-file-name v nil 'nohop)
tramp-initial-end-of-output))
;; We use as environment the difference to toplevel
;; `process-environment'.
env uenv
(env (dolist (elt (cons prompt process-environment) env)
(or (member
elt (default-toplevel-value 'process-environment))
(if (string-match-p "=" elt)
(setq env (append env `(,elt)))
(if (tramp-get-env-with-u-option v)
(setq env (append `("-u" ,elt) env))
(setq uenv (cons elt uenv)))))))
(command
(when (stringp program)
(setenv-internal
env "INSIDE_EMACS"
(concat (or (getenv "INSIDE_EMACS") emacs-version)
",tramp:" tramp-version)
'keep)
(format "cd %s && %s exec %s %s env %s %s"
(tramp-shell-quote-argument localname)
(if uenv
(format
"unset %s &&"
(mapconcat
#'tramp-shell-quote-argument uenv " "))
"")
(if heredoc (format "<<'%s'" tramp-end-of-heredoc) "")
(if tmpstderr (format "2>'%s'" tmpstderr) "")
(mapconcat #'tramp-shell-quote-argument env " ")
(if heredoc
(format "%s\n(\n%s\n) </dev/tty\n%s"
program (car args) tramp-end-of-heredoc)
(mapconcat #'tramp-shell-quote-argument
(cons program args) " ")))))
(tramp-process-connection-type
(or (null program) tramp-process-connection-type))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0)
;; We do not want to raise an error when
;; `make-process' has been started several times in
;; `eshell' and friends.
tramp-current-connection
p)
(while (get-process name1)
;; NAME must be unique as process name.
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(setq name name1)
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name)
(tramp-set-connection-property v "process-buffer" buffer)
(while (get-process name1)
;; NAME must be unique as process name.
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(setq name name1)
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name)
(tramp-set-connection-property v "process-buffer" buffer)
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
;; We catch this event. Otherwise, `make-process' could
;; be called on the local host.
(save-excursion
(save-restriction
;; Activate narrowing in order to save BUFFER
;; contents. Clear also the modification time;
;; otherwise we might be interrupted by
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(inhibit-read-only t)
(mark (point-max)))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-maybe-open-connection', in
;; order to cleanup the prompt afterwards.
(catch 'suppress
(tramp-maybe-open-connection v)
(setq p (tramp-get-connection-process v))
;; Set the pid of the remote shell. This is
;; needed when sending signals remotely.
(let ((pid (tramp-send-command-and-read v "echo $$")))
(process-put p 'remote-pid pid)
(tramp-set-connection-property p "remote-pid" pid))
;; `tramp-maybe-open-connection' and
;; `tramp-send-command-and-read' could have
;; trashed the connection buffer. Remove this.
(widen)
(delete-region mark (point-max))
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
;; We catch this event. Otherwise, `make-process'
;; could be called on the local host.
(save-excursion
(save-restriction
;; Activate narrowing in order to save BUFFER
;; contents. Clear also the modification time;
;; otherwise we might be interrupted by
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(inhibit-read-only t)
(mark (point-max)))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; Now do it.
(if command
;; Send the command.
(tramp-send-command v command nil t) ; nooutput
;; Check, whether a pty is associated.
(unless (process-get p 'remote-tty)
(tramp-error
v 'file-error
"pty association is not supported for `%s'"
name))))
;; Set sentinel and filter.
(when sentinel
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
;; Set query flag and process marker for this
;; process. We ignore errors, because the
;; process could have finished already.
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point)))
;; We must flush them here already; otherwise
;; `rename-file', `delete-file' or
;; `insert-file-contents' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")
;; Copy tmpstderr file.
(when (and (stringp stderr)
(not (tramp-tramp-file-p stderr)))
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(rename-file remote-tmpstderr stderr))))
;; Provide error buffer. This shows only
;; initial error messages; messages arriving
;; later on will be inserted when the process is
;; deleted. The temporary file will exist until
;; the process is deleted.
(when (bufferp stderr)
(with-current-buffer stderr
(insert-file-contents-literally remote-tmpstderr))
;; Delete tmpstderr file.
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(when (file-exists-p remote-tmpstderr)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr nil nil nil 'replace))
(delete-file remote-tmpstderr)))))
;; Return process.
p)))
;; We call `tramp-maybe-open-connection', in
;; order to cleanup the prompt afterwards.
(catch 'suppress
(tramp-maybe-open-connection v)
(setq p (tramp-get-connection-process v))
;; Set the pid of the remote shell. This is
;; needed when sending signals remotely.
(let ((pid (tramp-send-command-and-read v "echo $$")))
(process-put p 'remote-pid pid)
(tramp-set-connection-property p "remote-pid" pid))
;; `tramp-maybe-open-connection' and
;; `tramp-send-command-and-read' could have
;; trashed the connection buffer. Remove this.
(widen)
(delete-region mark (point-max))
(narrow-to-region (point-max) (point-max))
;; Now do it.
(if command
;; Send the command.
(tramp-send-command v command nil t) ; nooutput
;; Check, whether a pty is associated.
(unless (process-get p 'remote-tty)
(tramp-error
v 'file-error
"pty association is not supported for `%s'"
name))))
;; Set sentinel and filter.
(when sentinel
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
;; Set query flag and process marker for this
;; process. We ignore errors, because the
;; process could have finished already.
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point)))
;; We must flush them here already; otherwise
;; `rename-file', `delete-file' or
;; `insert-file-contents' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")
;; Copy tmpstderr file.
(when (and (stringp stderr)
(not (tramp-tramp-file-p stderr)))
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(rename-file remote-tmpstderr stderr))))
;; Provide error buffer. This shows only
;; initial error messages; messages arriving
;; later on will be inserted when the process
;; is deleted. The temporary file will exist
;; until the process is deleted.
(when (bufferp stderr)
(with-current-buffer stderr
(insert-file-contents-literally remote-tmpstderr))
;; Delete tmpstderr file.
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(when (file-exists-p remote-tmpstderr)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr nil nil nil 'replace))
(delete-file remote-tmpstderr)))))
;; Return process.
p)))
;; Save exit.
(if (string-match-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer p nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp))
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer"))))))))
;; Save exit.
(if (string-match-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer p nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp))
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")))))))))
(defun tramp-sh-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
@ -3646,6 +3651,14 @@ Fall back to normal file name handler if no Tramp handler exists."
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args)))
;;;###tramp-autoload
(defun tramp-sh-file-name-handler-p (vec)
"Whether VEC uses a method from `tramp-sh-file-name-handler'."
(and (assoc (tramp-file-name-method vec) tramp-methods)
(eq (tramp-find-foreign-file-name-handler
(tramp-make-tramp-file-name vec nil 'nohop))
'tramp-sh-file-name-handler)))
;; This must be the last entry, because `identity' always matches.
;;;###tramp-autoload
(tramp--with-startup
@ -4769,6 +4782,12 @@ Goes through the list `tramp-inline-compress-commands'."
(tramp-message
vec 2 "Couldn't find an inline transfer compress command")))))
;;;###tramp-autoload
(defun tramp-multi-hop-p (vec)
"Whether the method of VEC is capable of multi-hops."
(and (tramp-sh-file-name-handler-p vec)
(not (tramp-get-method-parameter vec 'tramp-copy-program))))
(defun tramp-compute-multi-hops (vec)
"Expands VEC according to `tramp-default-proxies-alist'."
(let ((saved-tdpa tramp-default-proxies-alist)
@ -4832,8 +4851,7 @@ Goes through the list `tramp-inline-compress-commands'."
(when (cdr target-alist)
(setq choices target-alist)
(while (setq item (pop choices))
(when (or (not (tramp-get-method-parameter item 'tramp-login-program))
(tramp-get-method-parameter item 'tramp-copy-program))
(unless (tramp-multi-hop-p item)
(setq tramp-default-proxies-alist saved-tdpa)
(tramp-user-error
vec "Method `%s' is not supported for multi-hops."

169
lisp/net/tramp.el
View file

@ -1482,10 +1482,7 @@ default values are used."
(tramp-user-error
v "Method `%s' is not known." method))
;; Only some methods from tramp-sh.el do support multi-hops.
(when (and
hop
(or (not (tramp-get-method-parameter v 'tramp-login-program))
(tramp-get-method-parameter v 'tramp-copy-program)))
(unless (or (null hop) nodefault non-essential (tramp-multi-hop-p v))
(tramp-user-error
v "Method `%s' is not supported for multi-hops." method)))))))
@ -1499,8 +1496,7 @@ See `tramp-dissect-file-name' for details."
tramp-postfix-host-format name))
nodefault)))
;; Only some methods from tramp-sh.el do support multi-hops.
(when (or (not (tramp-get-method-parameter v 'tramp-login-program))
(tramp-get-method-parameter v 'tramp-copy-program))
(unless (or nodefault non-essential (tramp-multi-hop-p v))
(tramp-user-error
v "Method `%s' is not supported for multi-hops."
(tramp-file-name-method v)))
@ -3519,13 +3515,10 @@ User is always nil."
;; When we shall insert only a part of the file, we
;; copy this part. This works only for the shell file
;; name handlers.
;; name handlers. It doesn't work for crypted files.
(when (and (or beg end)
;; Direct actions aren't possible for
;; crypted directories.
(null tramp-crypt-enabled)
(tramp-get-method-parameter
v 'tramp-login-program))
(tramp-sh-file-name-handler-p v)
(null tramp-crypt-enabled))
(setq remote-copy (tramp-make-tramp-temp-file v))
;; This is defined in tramp-sh.el. Let's assume
;; this is loaded already.
@ -3640,6 +3633,152 @@ User is always nil."
(load local-copy noerror t nosuffix must-suffix)
(delete-file local-copy)))))
t)))
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
(defun tramp-handle-make-process (&rest args)
"An alternative `make-process' implementation for Tramp files."
(when args
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((name (plist-get args :name))
(buffer (plist-get args :buffer))
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
(connection-type (plist-get args :connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
(unless (stringp name)
(signal 'wrong-type-argument (list #'stringp name)))
(unless (or (null buffer) (bufferp buffer) (stringp buffer))
(signal 'wrong-type-argument (list #'stringp buffer)))
(unless (consp command)
(signal 'wrong-type-argument (list #'consp command)))
(unless (or (null coding)
(and (symbolp coding) (memq coding coding-system-list))
(and (consp coding)
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
(unless (or (null connection-type) (memq connection-type '(pipe pty)))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
(unless (or (null sentinel) (functionp sentinel))
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
(signal 'wrong-type-argument (list #'stringp stderr)))
(when (and (stringp stderr) (tramp-tramp-file-p stderr)
(not (tramp-equal-remote default-directory stderr)))
(signal 'file-error (list "Wrong stderr" stderr)))
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
(command (append `("cd" ,localname "&&")
(mapcar #'tramp-shell-quote-argument command)))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0)
;; We do not want to raise an error when `make-process'
;; has been started several times in `eshell' and
;; friends.
tramp-current-connection
p)
(while (get-process name1)
;; NAME must be unique as process name.
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(setq name name1)
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name)
(tramp-set-connection-property v "process-buffer" buffer)
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
(let* ((login-program
(tramp-get-method-parameter v 'tramp-login-program))
(login-args
(tramp-get-method-parameter v 'tramp-login-args))
(async-args
(tramp-get-method-parameter v 'tramp-async-args))
;; We don't create the temporary file. In
;; fact, it is just a prefix for the
;; ControlPath option of ssh; the real
;; temporary file has another name, and it is
;; created and protected by ssh. It is also
;; removed by ssh when the connection is
;; closed. The temporary file name is cached
;; in the main connection process, therefore
;; we cannot use `tramp-get-connection-process'.
(tmpfile
(when (tramp-sh-file-name-handler-p v)
(with-tramp-connection-property
(tramp-get-process v) "temp-file"
(tramp-compat-make-temp-name))))
(options
(when (tramp-sh-file-name-handler-p v)
(tramp-compat-funcall
'tramp-ssh-controlmaster-options v)))
spec)
;; Replace `login-args' place holders.
(setq
spec (format-spec-make ?t tmpfile)
options (format-spec (or options "") spec)
spec (format-spec-make
?h (or host "") ?u (or user "") ?p (or port "")
?c options ?l "")
;; Add arguments for asynchronous processes.
login-args (append async-args login-args)
;; Expand format spec.
login-args
(tramp-compat-flatten-tree
(mapcar
(lambda (x)
(setq x (mapcar (lambda (y) (format-spec y spec)) x))
(unless (member "" x) x))
login-args))
;; Split ControlMaster options.
login-args
(tramp-compat-flatten-tree
(mapcar (lambda (x) (split-string x " ")) login-args))
p (apply
#'start-process
name buffer login-program (append login-args command)))
(tramp-message v 6 "%s" (string-join (process-command p) " "))
;; Set sentinel and filter.
(when sentinel
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
;; Set query flag and process marker for this
;; process. We ignore errors, because the
;; process could have finished already.
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point)))
;; We must flush them here already; otherwise
;; `rename-file', `delete-file' or
;; `insert-file-contents' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")
;; Return process.
p)
;; Save exit.
(if (string-match-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer p nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp))
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer"))))))))
(defun tramp-handle-make-symbolic-link
(target linkname &optional ok-if-already-exists)
@ -3676,8 +3815,8 @@ support symbolic links."
(current-buffer))
(t (get-buffer-create
(if asynchronous
"*Async Shell Command*"
"*Shell Command Output*")))))
shell-command-buffer-name-async
shell-command-buffer-name)))))
(error-buffer
(cond
((bufferp error-buffer) error-buffer)
@ -4706,7 +4845,7 @@ This handles also chrooted environments, which are not regarded as local."
;; The method shall be applied to one of the shell file name
;; handlers. `tramp-local-host-p' is also called for "smb" and
;; alike, where it must fail.
(tramp-get-method-parameter vec 'tramp-login-program)
(tramp-sh-file-name-handler-p vec)
;; Direct actions aren't possible for crypted directories.
(null tramp-crypt-enabled)
;; The local temp directory must be writable for the other user.

11
lisp/outline.el
View file

@ -289,12 +289,19 @@ Turning on outline mode calls the value of `text-mode-hook' and then of
(list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0)))
(add-hook 'change-major-mode-hook 'outline-show-all nil t))
(defvar outline-minor-mode-map)
(defcustom outline-minor-mode-prefix "\C-c@"
"Prefix key to use for Outline commands in Outline minor mode.
The value of this variable is checked as part of loading Outline mode.
After that, changing the prefix key requires manipulating keymaps."
:type 'string
:group 'outlines)
:type 'key-sequence
:group 'outlines
:initialize 'custom-initialize-default
:set (lambda (sym val)
(define-key outline-minor-mode-map outline-minor-mode-prefix nil)
(define-key outline-minor-mode-map val outline-mode-prefix-map)
(set-default sym val)))
;;;###autoload
(define-minor-mode outline-minor-mode

1
lisp/play/snake.el
View file

@ -192,6 +192,7 @@ and then start moving it leftwards.")
(defvar snake-null-map
(let ((map (make-sparse-keymap 'snake-null-map)))
(define-key map "n" 'snake-start-game)
(define-key map "q" 'quit-window)
map)
"Keymap for finished Snake games.")

45
lisp/progmodes/cperl-mode.el
View file

@ -3560,19 +3560,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
"\\(\\`\n?\\|^\n\\)=" ; POD
"\\|"
;; One extra () before this:
"<<~?" ; HERE-DOC
"\\(" ; 1 + 1
"<<\\(~?\\)" ; HERE-DOC, indented-p = capture 2
"\\(" ; 2 + 1
;; First variant "BLAH" or just ``.
"[ \t]*" ; Yes, whitespace is allowed!
"\\([\"'`]\\)" ; 2 + 1 = 3
"\\([^\"'`\n]*\\)" ; 3 + 1
"\\3"
"\\([\"'`]\\)" ; 3 + 1 = 4
"\\([^\"'`\n]*\\)" ; 4 + 1
"\\4"
"\\|"
;; Second variant: Identifier or \ID (same as 'ID') or empty
"\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
"\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 5 + 1, 6 + 1
;; Do not have <<= or << 30 or <<30 or << $blah.
;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
"\\(\\)" ; To preserve count of pars :-( 6 + 1
"\\)"
"\\|"
;; 1+6 extra () before this:
@ -3762,11 +3761,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
;; ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
;; "\\(\\)" ; To preserve count of pars :-( 6 + 1
;; "\\)"
((match-beginning 2) ; 1 + 1
((match-beginning 3) ; 2 + 1
(setq b (point)
tb (match-beginning 0)
c (and ; not HERE-DOC
(match-beginning 5)
(match-beginning 6)
(save-match-data
(or (looking-at "[ \t]*(") ; << function_call()
(save-excursion ; 1 << func_name, or $foo << 10
@ -3793,17 +3792,17 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(looking-at "\\(printf?\\|say\\|system\\|exec\\|sort\\)\\>")))
(error t)))))))
(error nil))) ; func(<<EOF)
(and (not (match-beginning 6)) ; Empty
(and (not (match-beginning 7)) ; Empty
(looking-at
"[ \t]*[=0-9$@%&(]"))))))
(if c ; Not here-doc
nil ; Skip it.
(setq c (match-end 2)) ; 1 + 1
(if (match-beginning 5) ;4 + 1
(setq b1 (match-beginning 5) ; 4 + 1
e1 (match-end 5)) ; 4 + 1
(setq b1 (match-beginning 4) ; 3 + 1
e1 (match-end 4))) ; 3 + 1
(setq c (match-end 3)) ; 2 + 1
(if (match-beginning 6) ;6 + 1
(setq b1 (match-beginning 6) ; 5 + 1
e1 (match-end 6)) ; 5 + 1
(setq b1 (match-beginning 5) ; 4 + 1
e1 (match-end 5))) ; 4 + 1
(setq tag (buffer-substring b1 e1)
qtag (regexp-quote tag))
(cond (cperl-pod-here-fontify
@ -3818,8 +3817,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(setq b (point))
;; We do not search to max, since we may be called from
;; some hook of fontification, and max is random
(or (and (re-search-forward (concat "^[ \t]*" qtag "$")
stop-point 'toend)
(or (and (re-search-forward
(concat "^" (when (equal (match-string 2) "~") "[ \t]*")
qtag "$")
stop-point 'toend)
;;;(eq (following-char) ?\n) ; XXXX WHY???
)
(progn ; Pretend we matched at the end
@ -5752,7 +5753,7 @@ indentation and initial hashes. Behaves usually outside of comment."
(if (eq (char-after (match-beginning 2)) ?%)
'cperl-hash-face
'cperl-array-face)
t) ; arrays and hashes
nil) ; arrays and hashes
("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
1
(if (= (- (match-end 2) (match-beginning 2)) 1)
@ -6499,9 +6500,10 @@ If optional argument ALL is `recursive', will process Perl files
in subdirectories too."
(interactive)
(let ((cmd "etags")
(args '("-l" "none" "-r"
(args `("-l" "none" "-r"
;; 1=fullname 2=package? 3=name 4=proto? 5=attrs? (VERY APPROX!)
"/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/"
,(concat
"/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/")
"-r"
"/\\<package[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\([#;]\\|$\\)/\\1/"
"-r"
@ -6786,6 +6788,7 @@ Use as
(or topdir
(setq topdir default-directory))
(let ((tags-file-name "TAGS")
(inhibit-read-only t)
(case-fold-search nil)
xs rel)
(save-excursion

8
lisp/progmodes/project.el
View file

@ -1166,7 +1166,9 @@ Save the result in `project-list-file' if the list of projects has changed."
(project--ensure-read-project-list)
(let ((dir (project-root pr)))
(unless (equal (caar project--list) dir)
(setq project--list (assoc-delete-all dir project--list))
(dolist (ent project--list)
(when (equal dir (car ent))
(setq project--list (delq ent project--list))))
(push (list dir) project--list)
(project--write-project-list))))
@ -1176,8 +1178,8 @@ If the directory was in the list before the removal, save the
result in `project-list-file'. Announce the project's removal
from the list."
(project--ensure-read-project-list)
(when (assoc pr-dir project--list)
(setq project--list (assoc-delete-all pr-dir project--list))
(when-let ((ent (assoc pr-dir project--list)))
(setq project--list (delq ent project--list))
(message "Project `%s' not found; removed from list" pr-dir)
(project--write-project-list)))

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

@ -838,7 +838,7 @@ See `sh-feature'.")
font-lock-variable-name-face))
(rc sh-append es)
(bash sh-append sh ("\\$(\\(\\sw+\\)" (1 'sh-quoted-exec t) ))
(bash sh-append sh ("\\$(\\([^)\n]+\\)" (1 'sh-quoted-exec t) ))
(sh sh-append shell
;; Variable names.
("\\$\\({#?\\)?\\([[:alpha:]_][[:alnum:]_]*\\|[-#?@!]\\)" 2

20
lisp/progmodes/sql.el
View file

@ -1508,6 +1508,22 @@ Based on `comint-mode-map'.")
table)
"Syntax table used in `sql-mode' and `sql-interactive-mode'.")
;;; Syntax Properties
;; `sql--syntax-propertize-escaped-apostrophe', as follows, was
;; (analysed and) adapted from `pascal--syntax-propertize' in
;; pascal.el because basic syntax parsing cannot handle the SQL ''
;; construct within strings.
(defconst sql--syntax-propertize-escaped-apostrophe
(syntax-propertize-rules
("''"
(0
(if (save-excursion (nth 3 (syntax-ppss (match-beginning 0))))
(string-to-syntax ".")
(forward-char -1)
nil)))))
;; Font lock support
(defvar sql-mode-font-lock-object-name
@ -4210,6 +4226,10 @@ must tell Emacs. Here's how to do that in your init file:
(setq-local abbrev-all-caps 1)
;; Contains the name of database objects
(set (make-local-variable 'sql-contains-names) t)
;; Activate punctuation syntax table property for
;; escaped apostrophes within strings:
(setq-local syntax-propertize-function
sql--syntax-propertize-escaped-apostrophe)
;; Set syntax and font-face highlighting
;; Catch changes to sql-product and highlight accordingly
(sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591

3
lisp/recentf.el
View file

@ -1289,7 +1289,8 @@ Write data into the file specified by `recentf-save-file'."
(insert "\n \n;; Local Variables:\n"
(format ";; coding: %s\n" recentf-save-file-coding-system)
";; End:\n")
(write-file (expand-file-name recentf-save-file))
(write-region (point-min) (point-max)
(expand-file-name recentf-save-file))
(when recentf-save-file-modes
(set-file-modes recentf-save-file recentf-save-file-modes))
nil)

12
lisp/saveplace.el
View file

@ -1,4 +1,4 @@
;;; saveplace.el --- automatically save place in files
;;; saveplace.el --- automatically save place in files -*- lexical-binding:t -*-
;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
@ -42,7 +42,6 @@
"Automatically save place in files."
:group 'data)
(defvar save-place-alist nil
"Alist of saved places to go back to when revisiting files.
Each element looks like (FILENAME . POSITION);
@ -175,10 +174,11 @@ file:
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(defun save-place-to-alist ()
;; 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.
;; Otherwise, just delete that file from the alist.
;; first check to make sure alist has been loaded in from the master
"Add current buffer filename and position to `save-place-alist'.
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.
Otherwise, just delete that file from the alist."
;; 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
;; will be saved again when Emacs is killed.
(or save-place-loaded (load-save-place-alist-from-file))

2
lisp/scroll-lock.el
View file

@ -1,4 +1,4 @@
;;; scroll-lock.el --- Scroll lock scrolling.
;;; scroll-lock.el --- Scroll lock scrolling. -*- lexical-binding:t -*-
;; Copyright (C) 2005-2020 Free Software Foundation, Inc.

37
lisp/simple.el
View file

@ -3369,6 +3369,14 @@ which is defined in the `warnings' library.\n")
(setq buffer-undo-list nil)
t))
;;;; Shell commands
(defconst shell-command-buffer-name "*Shell Command Output*"
"Name of the output buffer for shell commands.")
(defconst shell-command-buffer-name-async "*Async Shell Command*"
"Name of the output buffer for asynchronous shell commands.")
(defvar shell-command-history nil
"History list for some commands that read shell commands.
@ -3433,7 +3441,7 @@ to `shell-command-history'."
(defcustom async-shell-command-buffer 'confirm-new-buffer
"What to do when the output buffer is used by another shell command.
This option specifies how to resolve the conflict where a new command
wants to direct its output to the buffer `*Async Shell Command*',
wants to direct its output to the buffer `shell-command-buffer-name-async',
but this buffer is already taken by another running shell command.
The value `confirm-kill-process' is used to ask for confirmation before
@ -3585,14 +3593,14 @@ whose `car' is BUFFER."
Like `shell-command', but adds `&' at the end of COMMAND
to execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
The output appears in the buffer `shell-command-buffer-name-async'.
That buffer is in shell mode.
You can configure `async-shell-command-buffer' to specify what to do
when the `*Async Shell Command*' buffer is already taken by another
when the `shell-command-buffer-name-async' buffer is already taken by another
running shell command. To run COMMAND without displaying the output
in a window you can configure `display-buffer-alist' to use the action
`display-buffer-no-window' for the buffer `*Async Shell Command*'.
`display-buffer-no-window' for the buffer `shell-command-buffer-name-async'.
In Elisp, you will often be better served by calling `start-process'
directly, since it offers more control and does not impose the use of
@ -3628,12 +3636,12 @@ If `shell-command-prompt-show-cwd' is non-nil, show the current
directory in the prompt.
If COMMAND ends in `&', execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
The output appears in the buffer `shell-command-buffer-name-async'.
That buffer is in shell mode. You can also use
`async-shell-command' that automatically adds `&'.
Otherwise, COMMAND is executed synchronously. The output appears in
the buffer `*Shell Command Output*'. If the output is short enough to
the buffer `shell-command-buffer-name'. If the output is short enough to
display in the echo area (which is determined by the variables
`resize-mini-windows' and `max-mini-window-height'), it is shown
there, but it is nonetheless available in buffer `*Shell Command
@ -3756,7 +3764,7 @@ impose the use of a shell (with its need to quote arguments)."
(if (string-match "[ \t]*&[ \t]*\\'" command)
;; Command ending with ampersand means asynchronous.
(let* ((buffer (get-buffer-create
(or output-buffer "*Async Shell Command*")))
(or output-buffer shell-command-buffer-name-async)))
(bname (buffer-name buffer))
(proc (get-buffer-process buffer))
(directory default-directory))
@ -3908,7 +3916,7 @@ and are used only if a pop-up buffer is displayed."
error-buffer display-error-buffer
region-noncontiguous-p)
"Execute string COMMAND in inferior shell with region as input.
Normally display output (if any) in temp buffer `*Shell Command Output*';
Normally display output (if any) in temp buffer `shell-command-buffer-name';
Prefix arg means replace the region with it. Return the exit code of
COMMAND.
@ -3927,7 +3935,7 @@ in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there.
Otherwise it is displayed in the buffer `*Shell Command Output*'.
Otherwise it is displayed in the buffer `shell-command-buffer-name'.
The output is available in that buffer in both cases.
If there is output and an error, a message about the error
@ -3937,7 +3945,7 @@ Optional fourth arg OUTPUT-BUFFER specifies where to put the
command's output. If the value is a buffer or buffer name,
erase that buffer and insert the output there; a non-nil value of
`shell-command-dont-erase-buffer' prevent to erase the buffer.
If the value is nil, use the buffer `*Shell Command Output*'.
If the value is nil, use the buffer `shell-command-buffer-name'.
Any other non-nil value means to insert the output in the
current buffer after START.
@ -4006,7 +4014,7 @@ characters."
(funcall region-insert-function output))
(t
(let ((buffer (get-buffer-create
(or output-buffer "*Shell Command Output*"))))
(or output-buffer shell-command-buffer-name))))
(with-current-buffer buffer
(erase-buffer)
(funcall region-insert-function output))
@ -4025,7 +4033,7 @@ characters."
(list t error-file)
t)))
;; It is rude to delete a buffer that the command is not using.
;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
;; (let ((shell-buffer (get-buffer shell-command-buffer-name)))
;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
;; (kill-buffer shell-buffer)))
;; Don't muck with mark unless REPLACE says we should.
@ -4033,12 +4041,13 @@ characters."
;; No prefix argument: put the output in a temp buffer,
;; replacing its entire contents.
(let ((buffer (get-buffer-create
(or output-buffer "*Shell Command Output*"))))
(or output-buffer shell-command-buffer-name))))
(set-buffer-major-mode buffer) ; Enable globalized modes (bug#38111)
(unwind-protect
(if (and (eq buffer (current-buffer))
(or (memq shell-command-dont-erase-buffer '(nil erase))
(and (not (eq buffer (get-buffer "*Shell Command Output*")))
(and (not (eq buffer (get-buffer
shell-command-buffer-name)))
(not (region-active-p)))))
;; If the input is the same buffer as the output,
;; delete everything but the specified region,

101
lisp/skeleton.el
View file

@ -1,4 +1,4 @@
;;; skeleton.el --- Lisp language extension for writing statement skeletons
;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1996, 2001-2020 Free Software Foundation, Inc.
@ -135,7 +135,8 @@ A prefix argument of -1 says to wrap around region, even if not highlighted.
A prefix argument of zero says to wrap around zero words---that is, nothing.
This is a way of overriding the use of a highlighted region.")
(interactive "*P\nP")
(skeleton-proxy-new ',skeleton str arg))))
(atomic-change-group
(skeleton-proxy-new ',skeleton str arg)))))
;;;###autoload
(defun skeleton-proxy-new (skeleton &optional str arg)
@ -154,8 +155,7 @@ of `str' whereas the skeleton's interactor is then ignored."
(prefix-numeric-value (or arg
current-prefix-arg))
(and skeleton-autowrap
(or (eq last-command 'mouse-drag-region)
(and transient-mark-mode mark-active))
(use-region-p)
;; Deactivate the mark, in case one of the
;; elements of the skeleton is sensitive
;; to such situations (e.g. it is itself a
@ -258,23 +258,25 @@ available:
(goto-char (car skeleton-regions))
(setq skeleton-regions (cdr skeleton-regions)))
(let ((beg (point))
skeleton-modified skeleton-point resume: help input v1 v2)
(setq skeleton-positions nil)
(unwind-protect
(cl-progv
(mapcar #'car skeleton-further-elements)
(mapcar (lambda (x) (eval (cadr x))) skeleton-further-elements)
(skeleton-internal-list skeleton str))
(or (eolp) (not skeleton-end-newline) (newline-and-indent))
(run-hooks 'skeleton-end-hook)
(sit-for 0)
(or (not (eq (window-buffer) (current-buffer)))
(pos-visible-in-window-p beg)
(progn
(goto-char beg)
(recenter 0)))
(if skeleton-point
(goto-char skeleton-point))))))
skeleton-modified skeleton-point) ;; resume:
(with-suppressed-warnings ((lexical help input v1 v2))
(dlet (help input v1 v2)
(setq skeleton-positions nil)
(unwind-protect
(cl-progv
(mapcar #'car skeleton-further-elements)
(mapcar (lambda (x) (eval (cadr x) t)) skeleton-further-elements)
(skeleton-internal-list skeleton str))
(or (eolp) (not skeleton-end-newline) (newline-and-indent))
(run-hooks 'skeleton-end-hook)
(sit-for 0)
(or (not (eq (window-buffer) (current-buffer)))
(pos-visible-in-window-p beg)
(progn
(goto-char beg)
(recenter 0)))
(if skeleton-point
(goto-char skeleton-point))))))))
(defun skeleton-read (prompt &optional initial-input recursive)
"Function for reading a string from the minibuffer within skeletons.
@ -327,36 +329,39 @@ automatically, and you are prompted to fill in the variable parts.")))
(signal 'quit t)
prompt))
(defun skeleton-internal-list (skeleton-il &optional str recursive)
(defun skeleton-internal-list (skeleton &optional str recursive)
(let* ((start (line-beginning-position))
(column (current-column))
(line (buffer-substring start (line-end-position)))
opoint)
(or str
(setq str `(setq str
(skeleton-read ',(car skeleton-il) nil ,recursive))))
(when (and (eq (cadr skeleton-il) '\n) (not recursive)
(save-excursion (skip-chars-backward " \t") (bolp)))
(setq skeleton-il (cons nil (cons '> (cddr skeleton-il)))))
(while (setq skeleton-modified (eq opoint (point))
opoint (point)
skeleton-il (cdr skeleton-il))
(condition-case quit
(skeleton-internal-1 (car skeleton-il) nil recursive)
(quit
(if (eq (cdr quit) 'recursive)
(setq recursive 'quit
skeleton-il (memq 'resume: skeleton-il))
;; Remove the subskeleton as far as it has been shown
;; the subskeleton shouldn't have deleted outside current line.
(end-of-line)
(delete-region start (point))
(insert line)
(move-to-column column)
(if (cdr quit)
(setq skeleton-il ()
recursive nil)
(signal 'quit 'recursive)))))))
(skeleton-il skeleton)
opoint)
(with-suppressed-warnings ((lexical str))
(dlet ((str (or str
`(setq str
(skeleton-read ',(car skeleton-il)
nil ,recursive)))))
(when (and (eq (cadr skeleton-il) '\n) (not recursive)
(save-excursion (skip-chars-backward " \t") (bolp)))
(setq skeleton-il (cons nil (cons '> (cddr skeleton-il)))))
(while (setq skeleton-modified (eq opoint (point))
opoint (point)
skeleton-il (cdr skeleton-il))
(condition-case quit
(skeleton-internal-1 (car skeleton-il) nil recursive)
(quit
(if (eq (cdr quit) 'recursive)
(setq recursive 'quit
skeleton-il (memq 'resume: skeleton-il))
;; Remove the subskeleton as far as it has been shown
;; the subskeleton shouldn't have deleted outside current line.
(end-of-line)
(delete-region start (point))
(insert line)
(move-to-column column)
(if (cdr quit)
(setq skeleton-il ()
recursive nil)
(signal 'quit 'recursive)))))))))
;; maybe continue loop or go on to next outer resume: section
(if (eq recursive 'quit)
(signal 'quit 'recursive)

88
lisp/so-long.el
View file

@ -38,7 +38,7 @@
;; compacted into the smallest file size possible, which often entails removing
;; newlines should they not be strictly necessary). This can result in lines
;; which are many thousands of characters long, and most programming modes
;; simply aren't optimized (remotely) for this scenario, so performance can
;; simply aren't optimised (remotely) for this scenario, so performance can
;; suffer significantly.
;;
;; When such files are detected, the command `so-long' is automatically called,
@ -69,7 +69,7 @@
;; the long lines. In such circumstances you may find that `longlines-mode' is
;; the most helpful facility.
;;
;; Note also that the mitigation is automatically triggered when visiting a
;; Note also that the mitigations are automatically triggered when visiting a
;; file. The library does not automatically detect if long lines are inserted
;; into an existing buffer (although the `so-long' command can be invoked
;; manually in such situations).
@ -90,7 +90,7 @@
;; * Overview of modes and commands
;; --------------------------------
;; - `global-so-long-mode' - A global minor mode which enables the automated
;; behavior, causing the user's preferred action to be invoked whenever a
;; behaviour, causing the user's preferred action to be invoked whenever a
;; newly-visited file contains excessively long lines.
;; - `so-long-mode' - A major mode, and the default action.
;; - `so-long-minor-mode' - A minor mode version of the major mode, and an
@ -111,7 +111,7 @@
;;
;; On rare occasions you may choose to manually invoke the `so-long' command,
;; which invokes your preferred `so-long-action' (exactly as the automatic
;; behavior would do if it had detected long lines). You might use this if a
;; behaviour would do if it had detected long lines). You might use this if a
;; problematic file did not meet your configured criteria, and you wished to
;; trigger the performance improvements manually.
;;
@ -120,7 +120,7 @@
;; available to `so-long' but, like any other mode, they can be invoked directly
;; if you have a need to do that (see also "Other ways of using so-long" below).
;;
;; If the behavior ever triggers when you did not want it to, you can use the
;; If the behaviour ever triggers when you did not want it to, you can use the
;; `so-long-revert' command to restore the buffer to its original state.
;; * Basic configuration
@ -199,7 +199,7 @@
;;
;; Note that `so-long-minor-modes' is not useful for other global minor modes
;; (as distinguished from globalized minor modes), but in some cases it will be
;; possible to inhibit or otherwise counter-act the behavior of a global mode
;; possible to inhibit or otherwise counter-act the behaviour of a global mode
;; by overriding variables, or by employing hooks (see below). You would need
;; to inspect the code for a given global mode (on a case by case basis) to
;; determine whether it's possible to inhibit it for a single buffer -- and if
@ -211,7 +211,7 @@
;; If `so-long-action' is set to either `so-long-mode' or `so-long-minor-mode',
;; the buffer-local value for each variable in the list is set to the associated
;; value in the alist. Use this to enforce values which will improve
;; performance or otherwise avoid undesirable behaviors. If `so-long-revert'
;; performance or otherwise avoid undesirable behaviours. If `so-long-revert'
;; is called, then the original values are restored.
;; * Hooks
@ -325,7 +325,7 @@
;; meaning you would need to add to `safe-local-variable-values' in order to
;; avoid being queried about them.
;;
;; Finally, the `so-long-predicate' user option enables the automated behavior
;; Finally, the `so-long-predicate' user option enables the automated behaviour
;; to be determined by a custom function, if greater control is needed.
;; * Implementation notes
@ -342,7 +342,7 @@
;; * Caveats
;; ---------
;; The variables affecting the automated behavior of this library (such as
;; The variables affecting the automated behaviour of this library (such as
;; `so-long-action') can be used as file- or dir-local values in Emacs 26+, but
;; not in previous versions of Emacs. This is on account of improvements made
;; to `normal-mode' in 26.1, which altered the execution order with respect to
@ -386,7 +386,7 @@
;; - Added sgml-mode and nxml-mode to `so-long-target-modes'.
;; 0.7.4 - Refactored the handling of `whitespace-mode'.
;; 0.7.3 - Added customize group `so-long' with user options.
;; - Added `so-long-original-values' to generalize the storage and
;; - Added `so-long-original-values' to generalise the storage and
;; restoration of values from the original mode upon `so-long-revert'.
;; - Added `so-long-revert-hook'.
;; 0.7.2 - Remember the original major mode even with M-x `so-long-mode'.
@ -399,7 +399,7 @@
;; 0.6 - Added `so-long-minor-modes' and `so-long-hook'.
;; 0.5 - Renamed library to "so-long.el".
;; - Added explicit `so-long-enable' command to activate our advice.
;; 0.4 - Amended/documented behavior with file-local 'mode' variables.
;; 0.4 - Amended/documented behaviour with file-local 'mode' variables.
;; 0.3 - Defer to a file-local 'mode' variable.
;; 0.2 - Initial release to EmacsWiki.
;; 0.1 - Experimental.
@ -421,7 +421,7 @@
Has no effect if `global-so-long-mode' is not enabled.")
(defvar-local so-long--active nil ; internal use
"Non-nil when `so-long' mitigation is in effect.")
"Non-nil when `so-long' mitigations are in effect.")
(defvar so-long--set-auto-mode nil ; internal use
"Non-nil while `set-auto-mode' is executing.")
@ -500,7 +500,7 @@ files would prevent Emacs from handling them correctly."
(defcustom so-long-invisible-buffer-function #'so-long-deferred
"Function called in place of `so-long' when the buffer is not displayed.
This affects the behavior of `global-so-long-mode'.
This affects the behaviour of `global-so-long-mode'.
We treat invisible buffers differently from displayed buffers because, in
cases where a library is using a buffer for behind-the-scenes processing,
@ -548,7 +548,7 @@ Defaults to `so-long-detected-long-line-p'."
(defun so-long--action-type ()
"Generate a :type for `so-long-action' based on `so-long-action-alist'."
;; :type seemingly cannot be a form to be evaluated on demand, so we
;; endeavor to keep it up-to-date with `so-long-action-alist' by
;; endeavour to keep it up-to-date with `so-long-action-alist' by
;; calling this from `so-long--action-alist-setter'.
`(radio ,@(mapcar (lambda (x) (list 'const :tag (cadr x) (car x)))
(assq-delete-all nil so-long-action-alist))
@ -609,7 +609,7 @@ will be automatically processed; but custom actions can also do these things.
The value `longlines-mode' causes that minor mode to be enabled. See
longlines.el for more details.
Each action likewise determines the behavior of `so-long-revert'.
Each action likewise determines the behaviour of `so-long-revert'.
If the value is nil, or not defined in `so-long-action-alist', then no action
will be taken."
@ -740,7 +740,7 @@ was established."
)
;; It's not clear to me whether all of these would be problematic, but they
;; seemed like reasonable targets. Some are certainly excessive in smaller
;; buffers of minified code, but we should be aiming to maximize performance
;; buffers of minified code, but we should be aiming to maximise performance
;; by default, so that Emacs is as responsive as we can manage in even very
;; large buffers of minified code.
"List of buffer-local minor modes to explicitly disable.
@ -756,7 +756,7 @@ By default this happens if `so-long-action' is set to either `so-long-mode'
or `so-long-minor-mode'. If `so-long-revert' is subsequently invoked, then the
disabled modes are re-enabled by calling them with the numeric argument 1.
`so-long-hook' can be used where more custom behavior is desired.
`so-long-hook' can be used where more custom behaviour is desired.
Please submit bug reports to recommend additional modes for this list, whether
they are in Emacs core, GNU ELPA, or elsewhere."
@ -781,9 +781,20 @@ If `so-long-revert' is subsequently invoked, then the variables are restored
to their original states.
The combination of `line-move-visual' (enabled) and `truncate-lines' (disabled)
is important for maximizing responsiveness when moving vertically within an
is important for maximising responsiveness when moving vertically within an
extremely long line, as otherwise the full length of the line may need to be
scanned to find the next position."
scanned to find the next position.
Bidirectional text display -- especially handling the large quantities of
nested parentheses which are liable to occur in minified programming code --
can be very expensive for extremely long lines, and so this support is disabled
by default (insofar as is supported; in particular `bidi-inhibit-bpa' is not
available in Emacs versions < 27). For more information refer to info node
`(emacs) Bidirectional Editing' and info node `(elisp) Bidirectional Display'.
Buffers are made read-only by default to prevent potentially-slow editing from
occurring inadvertantly, as buffers with excessively long lines are likely not
intended to be edited manually."
:type '(alist :key-type (variable :tag "Variable")
:value-type (sexp :tag "Value"))
:options '((bidi-inhibit-bpa boolean)
@ -822,18 +833,18 @@ If nil, no mode line indicator will be displayed."
(defface so-long-mode-line-active
'((t :inherit mode-line-emphasis))
"Face for `so-long-mode-line-info' when mitigation is active."
"Face for `so-long-mode-line-info' when mitigations are active."
:package-version '(so-long . "1.0"))
(defface so-long-mode-line-inactive
'((t :inherit mode-line-inactive))
"Face for `so-long-mode-line-info' when mitigation has been reverted."
"Face for `so-long-mode-line-info' when mitigations have been reverted."
:package-version '(so-long . "1.0"))
;; Modes that go slowly and line lengths excessive
;; Font-lock performance becoming oppressive
;; All of my CPU tied up with strings
;; These are a few of my least-favorite things
;; These are a few of my least-favourite things
(defvar-local so-long-original-values nil
"Alist holding the buffer's original `major-mode' value, and other data.
@ -985,7 +996,7 @@ Displayed as part of `mode-line-misc-info'.
`so-long-mode-line-label' defines the text to be displayed (if any).
Face `so-long-mode-line-active' is used while mitigation is active, and
Face `so-long-mode-line-active' is used while mitigations are active, and
`so-long-mode-line-inactive' is used if `so-long-revert' is called.
Not displayed when `so-long-mode' is enabled, as the major mode construct
@ -1038,7 +1049,9 @@ This is the default value of `so-long-predicate'."
(let ((count 0) start)
(save-excursion
(goto-char (point-min))
(when so-long-skip-leading-comments
(when (and so-long-skip-leading-comments
(or comment-use-syntax ;; Refer to `comment-forward'.
(and comment-start-skip comment-end-skip)))
;; Skip the shebang line, if any. This is not necessarily comment
;; syntax, so we need to treat it specially.
(when (looking-at "#!")
@ -1131,7 +1144,7 @@ This minor mode is a standard `so-long-action' option."
(if so-long-minor-mode ;; We are enabling the mode.
(progn
;; Housekeeping. `so-long-minor-mode' might be invoked directly rather
;; than via `so-long', so replicate the necessary behaviors. The minor
;; than via `so-long', so replicate the necessary behaviours. The minor
;; mode also cares about whether `so-long' was already active, as we do
;; not want to remember values which were potentially overridden already.
(unless (or so-long--calling so-long--active)
@ -1203,9 +1216,9 @@ values), despite potential performance issues, type \\[so-long-revert].
Use \\[so-long-commentary] for more information.
Use \\[so-long-customize] to configure the behavior."
Use \\[so-long-customize] to configure the behaviour."
;; Housekeeping. `so-long-mode' might be invoked directly rather than via
;; `so-long', so replicate the necessary behaviors. We could use this same
;; `so-long', so replicate the necessary behaviours. We could use this same
;; test in `so-long-after-change-major-mode' to run `so-long-hook', but that's
;; not so obviously the right thing to do, so I've omitted it for now.
(unless so-long--calling
@ -1251,7 +1264,7 @@ Use \\[so-long-customize] to configure the behavior."
This advice acts before `so-long-mode', with the previous mode still active."
(unless (derived-mode-p 'so-long-mode)
;; Housekeeping. `so-long-mode' might be invoked directly rather than
;; via `so-long', so replicate the necessary behaviors.
;; via `so-long', so replicate the necessary behaviours.
(unless so-long--calling
(so-long-remember-all :reset))
;; Remember the original major mode, regardless.
@ -1336,7 +1349,7 @@ This is the `so-long-revert-function' for `so-long-mode'."
;; Emacs 26+ has already called `hack-local-variables' (during
;; `run-mode-hooks'; provided there was a `buffer-file-name'), but for older
;; versions we need to call it here. In Emacs 26+ the revised 'HANDLE-MODE'
;; argument is set to `no-mode' (being the non-nil-and-non-t behavior),
;; argument is set to `no-mode' (being the non-nil-and-non-t behaviour),
;; which we mimic here by binding `so-long--hack-local-variables-no-mode',
;; in order to prevent a local 'mode' variable from clobbering the major
;; mode we have just called.
@ -1373,7 +1386,7 @@ because we do not want to downgrade the major mode in that scenario."
;; Act only if `so-long-mode' would be enabled by the current action.
(when (and (symbolp (so-long-function))
(provided-mode-derived-p (so-long-function) 'so-long-mode))
;; Downgrade from `so-long-mode' to the `so-long-minor-mode' behavior.
;; Downgrade from `so-long-mode' to the `so-long-minor-mode' behaviour.
(setq so-long-function 'turn-on-so-long-minor-mode
so-long-revert-function 'turn-off-so-long-minor-mode))))
@ -1393,7 +1406,7 @@ and cannot be conveniently intercepted, so we are forced to replicate it here.
This special-case code will ultimately be removed from Emacs, as it exists to
deal with a deprecated feature; but until then we need to replicate it in order
to inhibit our own behavior in the presence of a header comment `mode'
to inhibit our own behaviour in the presence of a header comment `mode'
declaration.
If a file-local mode is detected in the header comment, then we call the
@ -1528,7 +1541,7 @@ by testing the value against `major-mode'; but as we may have changed the
major mode to `so-long-mode' by this point, that protection is insufficient
and so we need to perform our own test.
We likewise need to support an equivalent of the `no-mode' behavior in 26.1+
We likewise need to support an equivalent of the `no-mode' behaviour in 26.1+
to ensure that `so-long-mode-revert' will not restore a file-local mode again
after it has already reverted to the original mode.
@ -1661,7 +1674,7 @@ Equivalent to calling (global-so-long-mode 0)"
;;;###autoload
(define-minor-mode global-so-long-mode
"Toggle automated performance mitigation for files with long lines.
"Toggle automated performance mitigations for files with long lines.
Many Emacs modes struggle with buffers which contain excessively long lines,
and may consequently cause unacceptable performance issues.
@ -1675,7 +1688,7 @@ When such files are detected by `so-long-predicate', we invoke the selected
Use \\[so-long-commentary] for more information.
Use \\[so-long-customize] to configure the behavior."
Use \\[so-long-customize] to configure the behaviour."
:global t
:group 'so-long
(if global-so-long-mode
@ -1810,9 +1823,10 @@ If it appears in `%s', you should remove it."
;; Update to version 1.0 from earlier versions:
(when (version< so-long-version "1.0")
(remove-hook 'change-major-mode-hook 'so-long-change-major-mode)
(require 'advice)
(eval-and-compile (require 'advice)) ;; Both macros and functions.
(declare-function ad-find-advice "advice")
(declare-function ad-remove-advice "advice")
(declare-function ad-activate "advice")
(when (ad-find-advice 'hack-local-variables 'after 'so-long--file-local-mode)
(ad-remove-advice 'hack-local-variables 'after 'so-long--file-local-mode)
(ad-activate 'hack-local-variables))
@ -1864,8 +1878,8 @@ If it appears in `%s', you should remove it."
; LocalWords: noerror selectable mapc sgml nxml hl flydiff defs arg Phil Sainty
; LocalWords: defadvice nadvice whitespace ie bos eos eobp origmode un Un setq
; LocalWords: docstring auf Wiedersehen longlines alist autoload Refactored Inc
; LocalWords: MERCHANTABILITY RET REGEXP VAR ELPA WS EmacsWiki eval
; LocalWords: rx filename filenames
; LocalWords: MERCHANTABILITY RET REGEXP VAR ELPA WS mitigations EmacsWiki eval
; LocalWords: rx filename filenames bidi bpa
;; So long, farewell, auf Wiedersehen, goodbye
;; You have to go, this code is minified

6
lisp/subr.el
View file

@ -888,6 +888,10 @@ side-effects, and the argument LIST is not modified."
;;;; Keymap support.
;; Declare before first use of `save-match-data',
;; where it is used internally.
(defvar save-match-data-internal)
(defun kbd (keys)
"Convert KEYS to the internal Emacs key representation.
KEYS should be a string in the format returned by commands such
@ -4110,8 +4114,6 @@ MODES is as for `set-default-file-modes'."
;;; Matching and match data.
(defvar save-match-data-internal)
;; We use save-match-data-internal as the local variable because
;; that works ok in practice (people should not use that variable elsewhere).
;; We used to use an uninterned symbol; the compiler handles that properly

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