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

Merge remote-tracking branch 'origin/master' into feature/bignum

Browse source
This commit is contained in:
Tom Tromey 2018-08-09 17:56:53 -06:00
commit accb7b7ecc
220 changed files with 20431 additions and 5091 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -57,6 +57,7 @@ lib/execinfo.h
lib/fcntl.h
lib/getopt.h
lib/getopt-cdefs.h
lib/ieee754.h
lib/inttypes.h
lib/libgnu.a
lib/limits.h

14
admin/MAINTAINERS
View file

@ -37,7 +37,7 @@ Kenichi Handa
Mule
Stefan Monnier
src/regex.c
src/regex-emacs.c
src/syntax.c
src/keymap.c
font-lock/jit-lock/syntax
@ -61,7 +61,7 @@ Michael Albinus
lisp/net/tramp*.el
lisp/url/url-tramp.el
doc/misc/tramp*.texi
test/lisp/net/tramp-tests.el
test/lisp/net/tramp*-tests.el
test/lisp/url/url-tramp-tests.el
D-Bus
@ -210,11 +210,21 @@ Paul Eggert
Michael Albinus
src/inotify.c
lisp/autorevert.el
lisp/files.el (file-name-non-special)
lisp/eshell/em-tramp.el
lisp/net/ange-ftp.el
lisp/notifications.el
lisp/shadowfile.el
test/lisp/autorevert-tests.el
test/lisp/files-tests.el (file-name-non-special)
test/lisp/shadowfile-tests.el
test/src/inotify-test.el
Secret Service API in
lisp/auth-source.el
doc/misc/auth.texi
test/lisp/auth-source-tests.el
Nicolas Petton
lisp/emacs-lisp/subr-x.el
lisp/arc-mode.el

2
admin/find-gc.el
View file

@ -57,7 +57,7 @@ Each entry has the form (FUNCTION . FUNCTIONS-IT-CALLS).")
"keymap.c" "sysdep.c" "buffer.c" "filelock.c"
"insdel.c" "marker.c" "minibuf.c" "fileio.c"
"dired.c" "cmds.c" "casefiddle.c"
"indent.c" "search.c" "regex.c" "undo.c"
"indent.c" "search.c" "regex-emacs.c" "undo.c"
"alloc.c" "data.c" "doc.c" "editfns.c"
"callint.c" "eval.c" "fns.c" "print.c" "lread.c"
"syntax.c" "unexcoff.c"

9
admin/merge-gnulib
View file

@ -35,9 +35,9 @@ GNULIB_MODULES='
fcntl fcntl-h fdatasync fdopendir
filemode filevercmp flexmember fpieee fstatat fsusage fsync
getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog
ignore-value intprops largefile lstat
ieee754-h ignore-value intprops largefile lstat
manywarnings memrchr minmax mkostemp mktime nstrftime
pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat
pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat regex
sig2str socklen stat-time std-gnu11 stdalign stddef stdio
stpcpy strtoimax symlink sys_stat sys_time
tempname time time_r time_rz timegm timer-time timespec-add timespec-sub
@ -46,11 +46,12 @@ GNULIB_MODULES='
'
AVOIDED_MODULES='
close dup fchdir fstat
malloc-posix msvc-inval msvc-nothrow
btowc close dup fchdir fstat langinfo lock
malloc-posix mbrtowc mbsinit msvc-inval msvc-nothrow nl_langinfo
openat-die opendir raise
save-cwd select setenv sigprocmask stat stdarg stdbool
threadlib tzset unsetenv utime utime-h
wchar wcrtomb wctype-h
'
GNULIB_TOOL_FLAGS='

114
build-aux/config.guess vendored
View file

@ -2,7 +2,7 @@
# Attempt to guess a canonical system name.
# Copyright 1992-2018 Free Software Foundation, Inc.
timestamp='2018-07-06'
timestamp='2018-08-02'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@ -84,8 +84,6 @@ if test $# != 0; then
exit 1
fi
trap 'exit 1' 1 2 15
# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
# compiler to aid in system detection is discouraged as it requires
# temporary files to be created and, as you can see below, it is a
@ -96,34 +94,39 @@ trap 'exit 1' 1 2 15
# Portable tmp directory creation inspired by the Autoconf team.
set_cc_for_build='
trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
: ${TMPDIR=/tmp} ;
{ tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
{ test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp 2>/dev/null) ; } ||
{ tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } ||
{ echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;
dummy=$tmp/dummy ;
tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;
case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in
,,) echo "int x;" > "$dummy.c" ;
for c in cc gcc c89 c99 ; do
if ($c -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then
CC_FOR_BUILD="$c"; break ;
fi ;
done ;
if test x"$CC_FOR_BUILD" = x ; then
CC_FOR_BUILD=no_compiler_found ;
fi
;;
,,*) CC_FOR_BUILD=$CC ;;
,*,*) CC_FOR_BUILD=$HOST_CC ;;
esac ; set_cc_for_build= ;'
tmp=
# shellcheck disable=SC2172
trap 'test -z "$tmp" || rm -fr "$tmp"' 1 2 13 15
trap 'exitcode=$?; test -z "$tmp" || rm -fr "$tmp"; exit $exitcode' 0
set_cc_for_build() {
: "${TMPDIR=/tmp}"
# shellcheck disable=SC2039
{ tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
{ test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } ||
{ tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } ||
{ echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; }
dummy=$tmp/dummy
case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in
,,) echo "int x;" > "$dummy.c"
for driver in cc gcc c89 c99 ; do
if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then
CC_FOR_BUILD="$driver"
break
fi
done
if test x"$CC_FOR_BUILD" = x ; then
CC_FOR_BUILD=no_compiler_found
fi
;;
,,*) CC_FOR_BUILD=$CC ;;
,*,*) CC_FOR_BUILD=$HOST_CC ;;
esac
}
# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
# (ghazi@noc.rutgers.edu 1994-08-24)
if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
if test -f /.attbin/uname ; then
PATH=$PATH:/.attbin ; export PATH
fi
@ -138,7 +141,7 @@ Linux|GNU|GNU/*)
# We could probably try harder.
LIBC=gnu
eval "$set_cc_for_build"
set_cc_for_build
cat <<-EOF > "$dummy.c"
#include <features.h>
#if defined(__UCLIBC__)
@ -199,7 +202,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
os=netbsdelf
;;
arm*|i386|m68k|ns32k|sh3*|sparc|vax)
eval "$set_cc_for_build"
set_cc_for_build
if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
| grep -q __ELF__
then
@ -389,20 +392,15 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
echo i386-pc-auroraux"$UNAME_RELEASE"
exit ;;
i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)
eval "$set_cc_for_build"
SUN_ARCH=i386
# If there is a compiler, see if it is configured for 64-bit objects.
# Note that the Sun cc does not turn __LP64__ into 1 like gcc does.
# This test works for both compilers.
if [ "$CC_FOR_BUILD" != no_compiler_found ]; then
if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \
(CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \
grep IS_64BIT_ARCH >/dev/null
then
SUN_ARCH=x86_64
fi
fi
echo "$SUN_ARCH"-pc-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`"
UNAME_REL="`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`"
case `isainfo -b` in
32)
echo i386-pc-solaris2"$UNAME_REL"
;;
64)
echo x86_64-pc-solaris2"$UNAME_REL"
;;
esac
exit ;;
sun4*:SunOS:6*:*)
# According to config.sub, this is the proper way to canonicalize
@ -482,7 +480,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
echo clipper-intergraph-clix"$UNAME_RELEASE"
exit ;;
mips:*:*:UMIPS | mips:*:*:RISCos)
eval "$set_cc_for_build"
set_cc_for_build
sed 's/^ //' << EOF > "$dummy.c"
#ifdef __cplusplus
#include <stdio.h> /* for printf() prototype */
@ -579,7 +577,7 @@ EOF
exit ;;
*:AIX:2:3)
if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
eval "$set_cc_for_build"
set_cc_for_build
sed 's/^ //' << EOF > "$dummy.c"
#include <sys/systemcfg.h>
@ -660,7 +658,7 @@ EOF
esac
fi
if [ "$HP_ARCH" = "" ]; then
eval "$set_cc_for_build"
set_cc_for_build
sed 's/^ //' << EOF > "$dummy.c"
#define _HPUX_SOURCE
@ -700,7 +698,7 @@ EOF
esac
if [ "$HP_ARCH" = hppa2.0w ]
then
eval "$set_cc_for_build"
set_cc_for_build
# hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
# 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler
@ -726,7 +724,7 @@ EOF
echo ia64-hp-hpux"$HPUX_REV"
exit ;;
3050*:HI-UX:*:*)
eval "$set_cc_for_build"
set_cc_for_build
sed 's/^ //' << EOF > "$dummy.c"
#include <unistd.h>
int
@ -840,6 +838,17 @@ EOF
*:BSD/OS:*:*)
echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE"
exit ;;
arm*:FreeBSD:*:*)
UNAME_PROCESSOR=`uname -p`
set_cc_for_build
if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
| grep -q __ARM_PCS_VFP
then
echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabi
else
echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabihf
fi
exit ;;
*:FreeBSD:*:*)
UNAME_PROCESSOR=`/usr/bin/uname -p`
case "$UNAME_PROCESSOR" in
@ -922,7 +931,7 @@ EOF
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
exit ;;
arm*:Linux:*:*)
eval "$set_cc_for_build"
set_cc_for_build
if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
| grep -q __ARM_EABI__
then
@ -971,7 +980,7 @@ EOF
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
exit ;;
mips:Linux:*:* | mips64:Linux:*:*)
eval "$set_cc_for_build"
set_cc_for_build
sed 's/^ //' << EOF > "$dummy.c"
#undef CPU
#undef ${UNAME_MACHINE}
@ -1285,7 +1294,7 @@ EOF
exit ;;
*:Darwin:*:*)
UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
eval "$set_cc_for_build"
set_cc_for_build
if test "$UNAME_PROCESSOR" = unknown ; then
UNAME_PROCESSOR=powerpc
fi
@ -1358,6 +1367,7 @@ EOF
# "uname -m" is not consistent, so use $cputype instead. 386
# is converted to i386 for consistency with other x86
# operating systems.
# shellcheck disable=SC2154
if test "$cputype" = 386; then
UNAME_MACHINE=i386
else

10
build-aux/config.sub vendored
View file

@ -2,7 +2,7 @@
# Configuration validation subroutine script.
# Copyright 1992-2018 Free Software Foundation, Inc.
timestamp='2018-07-03'
timestamp='2018-07-25'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@ -307,7 +307,7 @@ case $1 in
os=mach
;;
vsta)
basic_machine=i386-unknown
basic_machine=i386-pc
os=vsta
;;
isi68 | isi)
@ -371,7 +371,7 @@ case $1 in
os=sysv4
;;
netbsd386)
basic_machine=i386-unknown
basic_machine=i386-pc
os=netbsd
;;
netwinder)
@ -739,6 +739,7 @@ case $basic_machine in
| mipsr5900-* | mipsr5900el-* \
| mipstx39-* | mipstx39el-* \
| mmix-* \
| moxie-* \
| mt-* \
| msp430-* \
| nds32-* | nds32le-* | nds32be-* \
@ -1263,9 +1264,6 @@ case $basic_machine in
pmac | pmac-mpw)
basic_machine=powerpc-apple
;;
*-unknown)
# Make sure to match an already-canonicalized machine name.
;;
*)
echo Invalid configuration \`"$1"\': machine \`"$basic_machine"\' not recognized 1>&2
exit 1

7
configure.ac
View file

@ -5483,9 +5483,10 @@ echo
if test "$HAVE_NS" = "yes"; then
echo
AS_ECHO(["You must run \"${MAKE-make} install\" in order to test the built application.
The installed application will go to nextstep/Emacs.app and can be
run or moved from there."])
AS_ECHO(["Run '${MAKE-make}' to build Emacs, then run 'src/emacs' to test it.
Run '${MAKE-make} install' in order to build an application bundle.
The application will go to nextstep/Emacs.app and can be run or moved
from there."])
if test "$EN_NS_SELF_CONTAINED" = "yes"; then
echo "The application will be fully self-contained."
else

5
doc/emacs/dired.texi
View file

@ -1468,6 +1468,11 @@ rotation is lossless, and uses an external utility called
directory's name, and creates that directory. It signals an error if
the directory already exists.
@findex dired-create-empty-file
The command (@code{dired-create-empty-file}) reads a
file name, and creates that file. It signals an error if
the file already exists.
@cindex searching multiple files via Dired
@kindex M-s a C-s @r{(Dired)}
@kindex M-s a M-C-s @r{(Dired)}

2
doc/emacs/files.texi
View file

@ -881,6 +881,8 @@ You can answer ``no'' to bypass copying of this file, this time. If
you want to cancel the shadowing permanently for a certain file, use
@w{@kbd{M-x shadow-cancel}} to eliminate or change the shadow file group.
File Shadowing is not available on MS Windows.
@node Time Stamps
@subsection Updating Time Stamps Automatically
@cindex time stamps

14
doc/emacs/fixit.texi
View file

@ -427,11 +427,15 @@ dictionary.
@cindex mode, Flyspell
@findex flyspell-mode
Flyspell mode is a minor mode that performs automatic spell-checking
as you type. When it finds a word that it does not recognize, it
highlights that word. Type @kbd{M-x flyspell-mode} to toggle Flyspell
mode in the current buffer. To enable Flyspell mode in all text mode
buffers, add @code{flyspell-mode} to @code{text-mode-hook}.
@xref{Hooks}.
of the text you type as you type it. When it finds a word that it
does not recognize, it highlights that word. Type @kbd{M-x
flyspell-mode} to toggle Flyspell mode in the current buffer. To
enable Flyspell mode in all text mode buffers, add
@code{flyspell-mode} to @code{text-mode-hook}. @xref{Hooks}. Note
that, as Flyspell mode needs to check each word across which you move,
it will slow down cursor motion and scrolling commands. It also
doesn't automatically check the text you didn't type or move across;
use @code{flyspell-region} or @code{flyspell-buffer} for that.
@findex flyspell-correct-word
@findex flyspell-auto-correct-word

21
doc/emacs/indent.texi
View file

@ -60,9 +60,9 @@ repositioned to the first non-whitespace character on the line.
@node Indentation Commands
@section Indentation Commands
Apart from the @key{TAB} (@code{indent-for-tab-command}) command,
Emacs provides a variety of commands to perform indentation in other
ways.
Apart from the @kbd{@key{TAB}} (@code{indent-for-tab-command})
command, Emacs provides a variety of commands to perform indentation
in other ways.
@table @kbd
@item C-M-o
@ -113,8 +113,8 @@ appears after the newline that is deleted. @xref{Fill Prefix}.
@item C-M-\
@kindex C-M-\
@findex indent-region
Indent all the lines in the region, as though you had typed @key{TAB}
at the beginning of each line (@code{indent-region}).
Indent all the lines in the region, as though you had typed
@kbd{@key{TAB}} at the beginning of each line (@code{indent-region}).
If a numeric argument is supplied, indent every line in the region to
that column number.
@ -128,11 +128,12 @@ in the region, moving the affected lines as a rigid unit.
If called with no argument, the command activates a transient mode for
adjusting the indentation of the affected lines interactively. While
this transient mode is active, typing @key{LEFT} or @key{RIGHT}
indents leftward and rightward, respectively, by one space. You can
also type @kbd{S-@key{LEFT}} or @kbd{S-@key{RIGHT}} to indent leftward
or rightward to the next tab stop (@pxref{Tab Stops}). Typing any
other key disables the transient mode, and resumes normal editing.
this transient mode is active, typing @kbd{@key{LEFT}} or
@kbd{@key{RIGHT}} indents leftward and rightward, respectively, by one
space. You can also type @kbd{S-@key{LEFT}} or @kbd{S-@key{RIGHT}} to
indent leftward or rightward to the next tab stop (@pxref{Tab Stops}).
Typing any other key disables the transient mode, and resumes normal
editing.
If called with a prefix argument @var{n}, this command indents the
lines forward by @var{n} spaces (without enabling the transient mode).

16
doc/emacs/maintaining.texi
View file

@ -1655,10 +1655,20 @@ not just to the next change log entry. You can also use
log files into a buffer in Change Log Mode, preserving the date
ordering of entries.
@vindex add-log-dont-create-changelog-file
Version control systems are another way to keep track of changes in
your program and keep a change log. In the VC log buffer, typing
@kbd{C-c C-a} (@code{log-edit-insert-changelog}) inserts the relevant
change log entry, if one exists. @xref{Log Buffer}.
your program and keep a change log. Many projects that use a VCS don't
keep a separate versioned change log file nowadays, so you may wish to
avoid having such a file in the repository. If the value of
@code{add-log-dont-create-changelog-file} is non-@code{nil}, commands
like @kbd{C-x 4 a} (@code{add-change-log-entry-other-window}) will
record changes in a suitably named temporary buffer instead of a file,
if such a file does not already exist.
Whether you have a change log file or use a temporary buffer for
change logs, you can type @kbd{C-c C-a}
(@code{log-edit-insert-changelog}) in the VC Log buffer to insert the
relevant change log entries, if they exist. @xref{Log Buffer}.
@node Format of ChangeLog
@subsection Format of ChangeLog

4
doc/emacs/misc.texi
View file

@ -1026,8 +1026,8 @@ Move backward across one shell command, but not beyond the current line
Ask the shell for its working directory, and update the Shell buffer's
default directory. @xref{Directory Tracking}.
@item M-x send-invisible @key{RET} @var{text} @key{RET}
@findex send-invisible
@item M-x comint-send-invisible @key{RET} @var{text} @key{RET}
@findex comint-send-invisible
Send @var{text} as input to the shell, after reading it without
echoing. This is useful when a shell command runs a program that asks
for a password.

19
doc/emacs/mule.texi
View file

@ -156,12 +156,19 @@ system encodes the character safely and with a single byte
(@pxref{Coding Systems}). If the character's encoding is longer than
one byte, Emacs shows @samp{file ...}.
As a special case, if the character lies in the range 128 (0200
octal) through 159 (0237 octal), it stands for a raw byte that
does not correspond to any specific displayable character. Such a
character lies within the @code{eight-bit-control} character set,
and is displayed as an escaped octal character code. In this case,
@kbd{C-x =} shows @samp{part of display ...} instead of @samp{file}.
@cindex eight-bit character set
@cindex raw bytes
On rare occasions, Emacs encounters @dfn{raw bytes}: single bytes
whose values are in the range 128 (0200 octal) through 255 (0377
octal), which Emacs cannot interpret as part of a known encoding of
some non-ASCII character. Such raw bytes are treated as if they
belonged to a special character set @code{eight-bit}; Emacs displays
them as escaped octal codes (this can be customized; @pxref{Display
Custom}). In this case, @kbd{C-x =} shows @samp{raw-byte} instead of
@samp{file}. In addition, @kbd{C-x =} shows the character codes of
raw bytes as if they were in the range @code{#x3FFF80..#x3FFFFF},
which is where Emacs maps them to distinguish them from Unicode
characters in the range @code{#x0080..#x00FF}.
@cindex character set of character at point
@cindex font of character at point

4
doc/emacs/regs.texi
View file

@ -80,7 +80,9 @@ information until you store something else in it.
@kindex C-x r j
@findex jump-to-register
The command @kbd{C-x r j @var{r}} switches to the buffer recorded in
register @var{r}, and moves point to the recorded position. The
register @var{r}, pushes a mark, and moves point to the recorded
position. (The mark is not pushed if point was already at the
recorded position, or in successive calls to the command.) The
contents of the register are not changed, so you can jump to the saved
position any number of times.

117
doc/lispref/debugging.texi
View file

@ -81,7 +81,8 @@ debugger recursively. @xref{Recursive Editing}.
* Function Debugging:: Entering it when a certain function is called.
* Variable Debugging:: Entering it when a variable is modified.
* Explicit Debug:: Entering it at a certain point in the program.
* Using Debugger:: What the debugger does; what you see while in it.
* Using Debugger:: What the debugger does.
* Backtraces:: What you see while in the debugger.
* Debugger Commands:: Commands used while in the debugger.
* Invoking the Debugger:: How to call the function @code{debug}.
* Internals of Debugger:: Subroutines of the debugger, and global variables.
@ -392,32 +393,82 @@ this is not what you want, you can either set
@code{eval-expression-debug-on-error} to @code{nil}, or set
@code{debug-on-error} to @code{nil} in @code{debugger-mode-hook}.
@cindex current stack frame
The backtrace buffer shows you the functions that are executing and
their argument values. It also allows you to specify a stack frame by
moving point to the line describing that frame. (A stack frame is the
place where the Lisp interpreter records information about a particular
invocation of a function.) The frame whose line point is on is
considered the @dfn{current frame}. Some of the debugger commands
operate on the current frame. If a line starts with a star, that means
that exiting that frame will call the debugger again. This is useful
for examining the return value of a function.
If a function name is underlined, that means the debugger knows
where its source code is located. You can click with the mouse on
that name, or move to it and type @key{RET}, to visit the source code.
The debugger itself must be run byte-compiled, since it makes
assumptions about how many stack frames are used for the debugger
itself. These assumptions are false if the debugger is running
interpreted.
assumptions about the state of the Lisp interpreter. These
assumptions are false if the debugger is running interpreted.
@node Backtraces
@subsection Backtraces
@cindex backtrace buffer
Debugger mode is derived from Backtrace mode, which is also used to
show backtraces by Edebug and ERT. (@pxref{Edebug}, and @ref{Top,the
ERT manual,, ert, ERT: Emacs Lisp Regression Testing}.)
@cindex stack frame
The backtrace buffer shows you the functions that are executing and
their argument values. When a backtrace buffer is created, it shows
each stack frame on one, possibly very long, line. (A stack frame is
the place where the Lisp interpreter records information about a
particular invocation of a function.) The most recently called
function will be at the top.
@cindex current stack frame
In a backtrace you can specify a stack frame by moving point to a line
describing that frame. The frame whose line point is on is considered
the @dfn{current frame}.
If a function name is underlined, that means Emacs knows where its
source code is located. You can click with the mouse on that name, or
move to it and type @key{RET}, to visit the source code. You can also
type @key{RET} while point is on any name of a function or variable
which is not underlined, to see help information for that symbol in a
help buffer, if any exists. The @code{xref-find-definitions} command,
bound to @key{M-.}, can also be used on any identifier in a backtrace
(@pxref{Looking Up Identifiers,,,emacs, The GNU Emacs Manual}).
In backtraces, the tails of long lists and the ends of long strings,
vectors or structures, as well as objects which are deeply nested,
will be printed as underlined ``...''. You can click with the mouse
on a ``...'', or type @key{RET} while point is on it, to show the part
of the object that was hidden. To control how much abbreviation is
done, customize @code{backtrace-line-length}.
Here is a list of commands for navigating and viewing backtraces:
@table @kbd
@item v
Toggle the display of local variables of the current stack frame.
@item p
Move to the beginning of the frame, or to the beginning
of the previous frame.
@item n
Move to the beginning of the next frame.
@item +
Add line breaks and indentation to the top-level Lisp form at point to
make it more readable.
@item -
Collapse the top-level Lisp form at point back to a single line.
@item #
Toggle @code{print-circle} for the frame at point.
@item .
Expand all the forms abbreviated with ``...'' in the frame at point.
@end table
@node Debugger Commands
@subsection Debugger Commands
@cindex debugger command list
The debugger buffer (in Debugger mode) provides special commands in
addition to the usual Emacs commands. The most important use of
addition to the usual Emacs commands and to the Backtrace mode commands
described in the previous section. The most important use of
debugger commands is for stepping through code, so that you can see
how control flows. The debugger can step through the control
structures of an interpreted function, but cannot do so in a
@ -427,6 +478,11 @@ the same function. (To do this, visit the source for the function and
type @kbd{C-M-x} on its definition.) You cannot use the Lisp debugger
to step through a primitive function.
Some of the debugger commands operate on the current frame. If a
frame starts with a star, that means that exiting that frame will call the
debugger again. This is useful for examining the return value of a
function.
@c FIXME: Add @findex for the following commands? --xfq
Here is a list of Debugger mode commands:
@ -502,8 +558,6 @@ Display a list of functions that will invoke the debugger when called.
This is a list of functions that are set to break on entry by means of
@code{debug-on-entry}.
@item v
Toggle the display of local variables of the current stack frame.
@end table
@node Invoking the Debugger
@ -624,20 +678,19 @@ of @code{debug} (@pxref{Invoking the Debugger}).
@cindex run time stack
@cindex call stack
This function prints a trace of Lisp function calls currently active.
This is the function used by @code{debug} to fill up the
@file{*Backtrace*} buffer. It is written in C, since it must have access
to the stack to determine which function calls are active. The return
value is always @code{nil}.
The trace is identical to the one that @code{debug} would show in the
@file{*Backtrace*} buffer. The return value is always nil.
In the following example, a Lisp expression calls @code{backtrace}
explicitly. This prints the backtrace to the stream
@code{standard-output}, which, in this case, is the buffer
@samp{backtrace-output}.
Each line of the backtrace represents one function call. The line shows
the values of the function's arguments if they are all known; if they
are still being computed, the line says so. The arguments of special
forms are elided.
Each line of the backtrace represents one function call. The line
shows the function followed by a list of the values of the function's
arguments if they are all known; if they are still being computed, the
line consists of a list containing the function and its unevaluated
arguments. Long lists or deeply nested structures may be elided.
@smallexample
@group
@ -654,7 +707,7 @@ forms are elided.
@group
----------- Buffer: backtrace-output ------------
backtrace()
(list ...computing arguments...)
(list 'testing (backtrace))
@end group
(progn ...)
eval((progn (1+ var) (list 'testing (backtrace))))
@ -685,7 +738,7 @@ example would look as follows:
@group
----------- Buffer: backtrace-output ------------
(backtrace)
(list ...computing arguments...)
(list 'testing (backtrace))
@end group
(progn ...)
(eval (progn (1+ var) (list 'testing (backtrace))))

12
doc/lispref/edebug.texi
View file

@ -442,8 +442,16 @@ Redisplay the most recently known expression result in the echo area
Display a backtrace, excluding Edebug's own functions for clarity
(@code{edebug-backtrace}).
You cannot use debugger commands in the backtrace buffer in Edebug as
you would in the standard debugger.
@xref{Backtraces}, for a description of backtraces
and the commands which work on them.
If you would like to see Edebug's functions in the backtrace,
use @kbd{M-x edebug-backtrace-show-instrumentation}. To hide them
again use @kbd{M-x edebug-backtrace-hide-instrumentation}.
If a backtrace frame starts with @samp{>} that means that Edebug knows
where the source code for the frame is located. Use @kbd{s} to jump
to the source code for the current frame.
The backtrace buffer is killed automatically when you continue
execution.

3
doc/lispref/eval.texi
View file

@ -507,9 +507,6 @@ Emacs Lisp with a reference to where each is described.
@item setq-default
@pxref{Creating Buffer-Local}
@item track-mouse
@pxref{Mouse Tracking}
@item unwind-protect
@pxref{Nonlocal Exits}

8
doc/lispref/files.texi
View file

@ -3005,10 +3005,16 @@ This command creates a directory named @var{dirname}. If
@var{parents} is non-@code{nil}, as is always the case in an
interactive call, that means to create the parent directories first,
if they don't already exist.
@code{mkdir} is an alias for this.
@end deffn
@deffn Command make-empty-file filename &optional parents
This command creates an empty file named @var{filename}.
As @code{make-directory}, this command creates parent directories
if @var{parents} is non-@code{nil}.
If @var{filename} already exists, this command signals an error.
@end deffn
@deffn Command copy-directory dirname newname &optional keep-time parents copy-contents
This command copies the directory named @var{dirname} to
@var{newname}. If @var{newname} is a directory name,

10
doc/lispref/frames.texi
View file

@ -3373,10 +3373,10 @@ occur. That is useful, because normally you don't want to track the
mouse forever---only until some other event, such as the release of a
button.
@defspec track-mouse body@dots{}
This special form executes @var{body}, with generation of mouse motion
events enabled. Typically, @var{body} would use @code{read-event} to
read the motion events and modify the display accordingly. @xref{Motion
@defmac track-mouse body@dots{}
This macro executes @var{body}, with generation of mouse motion events
enabled. Typically, @var{body} would use @code{read-event} to read
the motion events and modify the display accordingly. @xref{Motion
Events}, for the format of mouse motion events.
The value of @code{track-mouse} is that of the last form in @var{body}.
@ -3396,7 +3396,7 @@ on (@pxref{Pointer Shape}). Therefore, Lisp programs that need the
mouse pointer to retain its original shape during dragging should bind
@code{track-mouse} to the value @code{dragging} at the beginning of
their @var{body}.
@end defspec
@end defmac
The usual purpose of tracking mouse motion is to indicate on the screen
the consequences of pushing or releasing a button at the current

21
doc/lispref/lists.texi
View file

@ -50,16 +50,19 @@ convention; at the level of cons cells, the @sc{car} and @sc{cdr}
slots have similar properties). Hence, the @sc{cdr} slot of each cons
cell in a list refers to the following cons cell.
@cindex proper list
@cindex true list
Also by convention, the @sc{cdr} of the last cons cell in a list is
@code{nil}. We call such a @code{nil}-terminated structure a
@dfn{true list}. In Emacs Lisp, the symbol @code{nil} is both a
symbol and a list with no elements. For convenience, the symbol
@code{nil} is considered to have @code{nil} as its @sc{cdr} (and also
as its @sc{car}).
@dfn{proper list}@footnote{It is sometimes also referred to as a
@dfn{true list}, but we generally do not use this terminology in this
manual.}. In Emacs Lisp, the symbol @code{nil} is both a symbol and a
list with no elements. For convenience, the symbol @code{nil} is
considered to have @code{nil} as its @sc{cdr} (and also as its
@sc{car}).
Hence, the @sc{cdr} of a true list is always a true list. The
@sc{cdr} of a nonempty true list is a true list containing all the
Hence, the @sc{cdr} of a proper list is always a proper list. The
@sc{cdr} of a nonempty proper list is a proper list containing all the
elements except the first.
@cindex dotted list
@ -71,10 +74,10 @@ Pair Notation}). There is one other possibility: some cons cell's
@sc{cdr} could point to one of the previous cons cells in the list.
We call that structure a @dfn{circular list}.
For some purposes, it does not matter whether a list is true,
For some purposes, it does not matter whether a list is proper,
circular or dotted. If a program doesn't look far enough down the
list to see the @sc{cdr} of the final cons cell, it won't care.
However, some functions that operate on lists demand true lists and
However, some functions that operate on lists demand proper lists and
signal errors if given a dotted list. Most functions that try to find
the end of a list enter infinite loops if given a circular list.
@ -538,7 +541,7 @@ object. The final argument is not copied or converted; it becomes the
is itself a list, then its elements become in effect elements of the
result list. If the final element is not a list, the result is a
dotted list since its final @sc{cdr} is not @code{nil} as required
in a true list.
in a proper list (@pxref{Cons Cells}).
@end defun
Here is an example of using @code{append}:

2
doc/lispref/minibuf.texi
View file

@ -2199,7 +2199,7 @@ function @code{read-passwd}.
@defun read-passwd prompt &optional confirm default
This function reads a password, prompting with @var{prompt}. It does
not echo the password as the user types it; instead, it echoes
@samp{.} for each character in the password. If you want to apply
@samp{*} for each character in the password. If you want to apply
another character to hide the password, let-bind the variable
@code{read-hide-char} with that character.

36
doc/lispref/numbers.texi
View file

@ -213,7 +213,7 @@ least one digit after any decimal point in a floating-point number;
@samp{1500.} is an integer, not a floating-point number.
Emacs Lisp treats @code{-0.0} as numerically equal to ordinary zero
with respect to @code{equal} and @code{=}. This follows the
with respect to numeric comparisons like @code{=}. This follows the
@acronym{IEEE} floating-point standard, which says @code{-0.0} and
@code{0.0} are numerically equal even though other operations can
distinguish them.
@ -227,8 +227,20 @@ infinity and negative infinity as floating-point values. It also
provides for a class of values called NaN, or ``not a number'';
numerical functions return such values in cases where there is no
correct answer. For example, @code{(/ 0.0 0.0)} returns a NaN@.
Although NaN values carry a sign, for practical purposes there is no other
significant difference between different NaN values in Emacs Lisp.
A NaN is never numerically equal to any value, not even to itself.
NaNs carry a sign and a significand, and non-numeric functions treat
two NaNs as equal when their
signs and significands agree. Significands of NaNs are
machine-dependent, as are the digits in their string representation.
When NaNs and signed zeros are involved, non-numeric functions like
@code{eql}, @code{equal}, @code{sxhash-eql}, @code{sxhash-equal} and
@code{gethash} determine whether values are indistinguishable, not
whether they are numerically equal. For example, when @var{x} and
@var{y} are the same NaN, @code{(equal x y)} returns @code{t} whereas
@code{(= x y)} uses numeric comparison and returns @code{nil};
conversely, @code{(equal 0.0 -0.0)} returns @code{nil} whereas
@code{(= 0.0 -0.0)} returns @code{t}.
Here are read syntaxes for these special floating-point values:
@ -358,11 +370,15 @@ if so, @code{nil} otherwise. The argument must be a number.
@cindex comparing numbers
To test numbers for numerical equality, you should normally use
@code{=}, not @code{eq}. There can be many distinct floating-point
and large integer objects with the same numeric value. If you use
@code{eq} to compare them, then you test whether two values are the
same @emph{object}. By contrast, @code{=} compares only the numeric
values of the objects.
@code{=} instead of non-numeric comparison predicates like @code{eq},
@code{eql} and @code{equal}. Distinct floating-point and large
integer objects can be numerically equal. If you use @code{eq} to
compare them, you test whether they are the same @emph{object}; if you
use @code{eql} or @code{equal}, you test whether their values are
@emph{indistinguishable}. In contrast, @code{=} uses numeric
comparison, and sometimes returns @code{t} when a non-numeric
comparison would return @code{nil} and vice versa. @xref{Float
Basics}.
In Emacs Lisp, each small integer is a unique Lisp object.
Therefore, @code{eq} is equivalent to @code{=} where small integers are
@ -829,7 +845,7 @@ reproducing the same pattern moved over.
bits in @var{integer1} to the left @var{count} places, or to the right
if @var{count} is negative, bringing zeros into the vacated bits. If
@var{count} is negative, @code{lsh} shifts zeros into the leftmost
(most-significant) bit, producing a positive result even if
(most-significant) bit, producing a nonnegative result even if
@var{integer1} is negative. Contrast this with @code{ash}, below.
Here are two examples of @code{lsh}, shifting a pattern of bits one
@ -1167,7 +1183,7 @@ returns a NaN.
@defun expt x y
This function returns @var{x} raised to power @var{y}. If both
arguments are integers and @var{y} is positive, the result is an
arguments are integers and @var{y} is nonnegative, the result is an
integer; in this case, overflow causes truncation, so watch out.
If @var{x} is a finite negative number and @var{y} is a finite
non-integer, @code{expt} returns a NaN.

8
doc/lispref/sequences.texi
View file

@ -63,7 +63,8 @@ But it is possible to add elements to the list, or remove elements.
@defun sequencep object
This function returns @code{t} if @var{object} is a list, vector,
string, bool-vector, or char-table, @code{nil} otherwise.
string, bool-vector, or char-table, @code{nil} otherwise. See also
@code{seqp} below.
@end defun
@defun length sequence
@ -479,7 +480,8 @@ built-in sequence types, @code{seq-length} behaves like @code{length}.
@defun seqp object
This function returns non-@code{nil} if @var{object} is a sequence
(a list or array), or any additional type of sequence defined via
@file{seq.el} generic functions.
@file{seq.el} generic functions. This is an extensible variant of
@code{sequencep}.
@example
@group
@ -1355,7 +1357,7 @@ each initialized to @var{object}.
@defun vconcat &rest sequences
@cindex copying vectors
This function returns a new vector containing all the elements of
@var{sequences}. The arguments @var{sequences} may be true lists,
@var{sequences}. The arguments @var{sequences} may be proper lists,
vectors, strings or bool-vectors. If no @var{sequences} are given,
the empty vector is returned.

27
doc/lispref/strings.texi
View file

@ -922,7 +922,8 @@ Functions}). Thus, strings are enclosed in @samp{"} characters, and
@item %o
@cindex integer to octal
Replace the specification with the base-eight representation of an
unsigned integer. The object can also be a nonnegative floating-point
integer. Negative integers are formatted in a platform-dependent
way. The object can also be a nonnegative floating-point
number that is formatted as an integer, dropping any fraction, if the
integer does not exceed machine limits.
@ -935,7 +936,8 @@ formatted as an integer, dropping any fraction.
@itemx %X
@cindex integer to hexadecimal
Replace the specification with the base-sixteen representation of an
unsigned integer. @samp{%x} uses lower case and @samp{%X} uses upper
integer. Negative integers are formatted in a platform-dependent
way. @samp{%x} uses lower case and @samp{%X} uses upper
case. The object can also be a nonnegative floating-point number that
is formatted as an integer, dropping any fraction, if the integer does
not exceed machine limits.
@ -1015,17 +1017,17 @@ numbered or unnumbered format specifications but not both, except that
After the @samp{%} and any field number, you can put certain
@dfn{flag characters}.
The flag @samp{+} inserts a plus sign before a positive number, so
The flag @samp{+} inserts a plus sign before a nonnegative number, so
that it always has a sign. A space character as flag inserts a space
before a positive number. (Otherwise, positive numbers start with the
first digit.) These flags are useful for ensuring that positive
numbers and negative numbers use the same number of columns. They are
before a nonnegative number. (Otherwise, nonnegative numbers start with the
first digit.) These flags are useful for ensuring that nonnegative
and negative numbers use the same number of columns. They are
ignored except for @samp{%d}, @samp{%e}, @samp{%f}, @samp{%g}, and if
both flags are used, @samp{+} takes precedence.
The flag @samp{#} specifies an alternate form which depends on
the format in use. For @samp{%o}, it ensures that the result begins
with a @samp{0}. For @samp{%x} and @samp{%X}, it prefixes the result
with a @samp{0}. For @samp{%x} and @samp{%X}, it prefixes nonzero results
with @samp{0x} or @samp{0X}. For @samp{%e} and @samp{%f}, the
@samp{#} flag means include a decimal point even if the precision is
zero. For @samp{%g}, it always includes a decimal point, and also
@ -1108,6 +1110,17 @@ shows only the first three characters of the representation for
precision is what the local library functions of the @code{printf}
family produce.
@cindex formatting numbers for rereading later
If you plan to use @code{read} later on the formatted string to
retrieve a copy of the formatted value, use a specification that lets
@code{read} reconstruct the value. To format numbers in this
reversible way you can use @samp{%s} and @samp{%S}, to format just
integers you can also use @samp{%d}, and to format just nonnegative
integers you can also use @samp{#x%x} and @samp{#o%o}. Other formats
may be problematic; for example, @samp{%d} and @samp{%g} can mishandle
NaNs and can lose precision and type, and @samp{#x%x} and @samp{#o%o}
can mishandle negative integers. @xref{Input Functions}.
@node Case Conversion
@section Case Conversion in Lisp
@cindex upper case

23
doc/lispref/threads.texi
View file

@ -75,8 +75,8 @@ thread, @code{nil} otherwise.
@defun thread-join thread
Block until @var{thread} exits, or until the current thread is
signaled. If @var{thread} has already exited, this returns
immediately.
signaled. It returns the result of the @var{thread} function. If
@var{thread} has already exited, this returns immediately.
@end defun
@defun thread-signal thread error-symbol data
@ -87,6 +87,15 @@ thread, then this just calls @code{signal} immediately. Otherwise,
If @var{thread} was blocked by a call to @code{mutex-lock},
@code{condition-wait}, or @code{thread-join}; @code{thread-signal}
will unblock it.
Since signal handlers in Emacs are located in the main thread, a
signal must be propagated there in order to become visible. The
second @code{signal} call let the thread die:
@example
(thread-signal main-thread 'error data)
(signal 'error data)
@end example
@end defun
@defun thread-yield
@ -127,15 +136,21 @@ Return a list of all the live thread objects. A new list is returned
by each invocation.
@end defun
@defvar main-thread
This variable keeps the main thread Emacs is running, or @code{nil} if
Emacs is compiled without thread support.
@end defvar
When code run by a thread signals an error that is unhandled, the
thread exits. Other threads can access the error form which caused
the thread to exit using the following function.
@defun thread-last-error
@defun thread-last-error &optional cleanup
This function returns the last error form recorded when a thread
exited due to an error. Each thread that exits abnormally overwrites
the form stored by the previous thread's error with a new value, so
only the last one can be accessed.
only the last one can be accessed. If @var{cleanup} is
non-@code{nil}, the stored form is reset to @code{nil}.
@end defun
@node Mutexes

4
doc/misc/efaq.texi
View file

@ -2988,7 +2988,7 @@ Emacs compiled on a 64-bit machine can handle much larger buffers.
@cindex Shell buffer, echoed commands and @samp{^M} in
@cindex Echoed commands in @code{shell-mode}
Try typing @kbd{M-x shell-strip-ctrl-m @key{RET}} while in @code{shell-mode} to
Try typing @kbd{M-x comint-strip-ctrl-m @key{RET}} while in @code{shell-mode} to
make them go away. If that doesn't work, you have several options:
For @code{tcsh}, put this in your @file{.cshrc} (or @file{.tcshrc})
@ -3041,7 +3041,7 @@ characters from the buffer by adding this to your @file{.emacs} init
file:
@smalllisp
(add-hook 'comint-output-filter-functions 'shell-strip-ctrl-m)
(add-hook 'comint-output-filter-functions #'comint-strip-ctrl-m)
@end smalllisp
On a related note: if your shell is echoing your input line in the shell

8
doc/misc/ert.texi
View file

@ -273,9 +273,11 @@ moving point to it and typing @kbd{@key{RET}} jumps to its definition.
@cindex backtrace of a failed test
Pressing @kbd{r} re-runs the test near point on its own. Pressing
@kbd{d} re-runs it with the debugger enabled. @kbd{.} jumps to the
definition of the test near point (@kbd{@key{RET}} has the same effect if
point is on the name of the test). On a failed test, @kbd{b} shows
the backtrace of the failure.
definition of the test near point (@kbd{@key{RET}} has the same effect
if point is on the name of the test). On a failed test, @kbd{b} shows
the backtrace of the failure. @xref{Debugging,, Backtraces, elisp,
GNU Emacs Lisp Reference Manual}, for more information about
backtraces.
@kindex l@r{, in ert results buffer}
@kbd{l} shows the list of @code{should} forms executed in the test.

2
doc/misc/flymake.texi
View file

@ -4,7 +4,7 @@
@set VERSION 1.0
@set UPDATED June 2018
@settitle GNU Flymake @value{VERSION}
@include ../emacs/docstyle.texi
@include docstyle.texi
@syncodeindex pg cp
@syncodeindex vr cp
@syncodeindex fn cp

76
doc/misc/tramp.texi
View file

@ -544,9 +544,9 @@ file system), @file{@trampfn{dav,user@@host,/path/to/file}} and
@cindex method @option{gdrive}
@cindex @option{gdrive} method
@cindex google drive
@cindex method @option{owncloud}
@cindex @option{owncloud} method
@cindex nextcloud
@cindex method @option{nextcloud}
@cindex @option{nextcloud} method
@cindex owncloud
GVFS-based methods include also @acronym{GNOME} Online Accounts, which
support the @option{Files} service. These are the Google Drive file
@ -554,7 +554,7 @@ system, and the OwnCloud/NextCloud file system. The file name syntax
is here always
@file{@trampfn{gdrive,john.doe@@gmail.com,/path/to/file}}
(@samp{john.doe@@gmail.com} stands here for your Google Drive
account), or @file{@trampfn{owncloud,user@@host#8081,/path/to/file}}
account), or @file{@trampfn{nextcloud,user@@host#8081,/path/to/file}}
(@samp{8081} stands for the port number) for OwnCloud/NextCloud files.
@ -1094,6 +1094,10 @@ syntax requires a leading volume (share) name, for example:
based on standard protocols, such as HTTP@. @option{davs} does the same
but with SSL encryption. Both methods support the port numbers.
Paths being part of the WebDAV volume to be mounted by GVFS, as it is
common for OwnCloud or NextCloud file names, are not supported by
these methods. See method @option{nextcloud} for handling them.
@item @option{gdrive}
@cindex method @option{gdrive}
@cindex @option{gdrive} method
@ -1110,13 +1114,13 @@ Since Google Drive uses cryptic blob file names internally,
could produce unexpected behavior in case two files in the same
directory have the same @code{display-name}, such a situation must be avoided.
@item @option{owncloud}
@item @option{nextcloud}
@cindex @acronym{GNOME} Online Accounts
@cindex method @option{owncloud}
@cindex @option{owncloud} method
@cindex nextcloud
@cindex method @option{nextcloud}
@cindex @option{nextcloud} method
@cindex owncloud
As the name indicates, the method @option{owncloud} allows you to
As the name indicates, the method @option{nextcloud} allows you to
access OwnCloud or NextCloud hosted files and directories. Like the
@option{gdrive} method, your credentials must be populated in your
@command{Online Accounts} application outside Emacs. The method
@ -1135,7 +1139,7 @@ that for security reasons refuse @command{ssh} connections.
@defopt tramp-gvfs-methods
This user option is a list of external methods for GVFS@. By default,
this list includes @option{afp}, @option{dav}, @option{davs},
@option{gdrive}, @option{owncloud} and @option{sftp}. Other methods
@option{gdrive}, @option{nextcloud} and @option{sftp}. Other methods
to include are @option{ftp}, @option{http}, @option{https} and
@option{smb}. These methods are not intended to be used directly as
GVFS based method. Instead, they are added here for the benefit of
@ -1238,7 +1242,7 @@ improvement is not always true.
@cindex default user
@defopt tramp-default-user
@value{tramp} file name can omit the user name part since
A @value{tramp} file name can omit the user name part since
@value{tramp} substitutes the currently logged-in user name. However
this substitution can be overridden with @code{tramp-default-user}.
For example:
@ -1453,7 +1457,7 @@ support this command.
@subsection Tunneling with ssh
With ssh, you could use the @code{ProxyCommand} entry in the
With ssh, you could use the @code{ProxyCommand} entry in
@file{~/.ssh/config}:
@example
@ -1589,12 +1593,12 @@ A function dedicated to @file{/etc/hosts} for host names.
@item @code{tramp-parse-passwd}
@findex tramp-parse-passwd
A function which parses @file{/etc/passwd} files for user names.
A function which parses @file{/etc/passwd} for user names.
@item @code{tramp-parse-etc-group}
@findex tramp-parse-etc-group
A function which parses @file{/etc/group} files for group names.
A function which parses @file{/etc/group} for group names.
@item @code{tramp-parse-netrc}
@findex tramp-parse-netrc
@ -2194,7 +2198,7 @@ of the secretfile is now owned by the user logged in from
When @code{backup-directory-alist} is @code{nil} (the default), such
problems do not occur.
To ``turn off'' the backup feature for @value{tramp} files and stop
To ``turn off'' the backup feature for remote files and stop
@value{tramp} from saving to the backup directory, use this:
@lisp
@ -2256,12 +2260,11 @@ The backup file name of
@vindex auto-save-file-name-transforms
Just as for backup files, similar issues of file naming affect
auto-saving @value{tramp} files. Auto-saved files are saved in the
directory specified by the user option
@code{auto-save-file-name-transforms}. By default this is set to
the local temporary directory. But in some versions of Debian
GNU/Linux, this points to the source directory where the Emacs was
compiled. Reset such values to a valid directory.
auto-saving remote files. Auto-saved files are saved in the directory
specified by the user option @code{auto-save-file-name-transforms}.
By default this is set to the local temporary directory. But in some
versions of Debian GNU/Linux, this points to the source directory
where the Emacs was compiled. Reset such values to a valid directory.
Set @code{auto-save-file-name-transforms} to @code{nil} to save
auto-saved files to the same directory as the original file.
@ -2765,8 +2768,8 @@ hard-coded, fixed name. Note that using @code{:0} for X11 display name
here will not work as expected.
An alternate approach is specify @code{ForwardX11 yes} or
@code{ForwardX11Trusted yes} in the file @file{~/.ssh/config} on the
local host.
@code{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local
host.
@subsection Running @code{shell} on a remote host
@ -3446,6 +3449,19 @@ source "$@{HOME@}/.iterm2_shell_integration.bash"
@end group
@end example
And finally, bash's readline should not use key bindings like
@samp{C-j} to commands. Disable this in your @file{~/.inputrc}:
@example
@group
$if term=dumb
# Don't bind Control-J or it messes up @value{tramp}.
$else
"\C-j": next-history
$endif
@end group
@end example
@item
Echoed characters after login
@ -3582,13 +3598,13 @@ When testing, ensure the remote shell is the same shell
How to get notified after @value{tramp} completes file transfers?
Make Emacs beep after reading from or writing to the remote host with
the following code in @file{~/.emacs} file.
the following code in @file{~/.emacs}.
@lisp
@group
(defadvice tramp-handle-write-region
(after tramp-write-beep-advice activate)
"Make tramp beep after writing a file."
"Make @value{tramp} beep after writing a file."
(interactive)
(beep))
@end group
@ -3596,7 +3612,7 @@ the following code in @file{~/.emacs} file.
@group
(defadvice tramp-handle-do-copy-or-rename-file
(after tramp-copy-beep-advice activate)
"Make tramp beep after copying a file."
"Make @value{tramp} beep after copying a file."
(interactive)
(beep))
@end group
@ -3604,7 +3620,7 @@ the following code in @file{~/.emacs} file.
@group
(defadvice tramp-handle-insert-file-contents
(after tramp-insert-beep-advice activate)
"Make tramp beep after inserting a file."
"Make @value{tramp} beep after inserting a file."
(interactive)
(beep))
@end group
@ -3642,7 +3658,7 @@ then set them with a hook as follows:
@item
Why is @file{~/.sh_history} file on the remote host growing?
Why is @file{~/.sh_history} on the remote host growing?
@vindex tramp-histfile-override
@vindex HISTFILE@r{, environment variable}
@ -3663,7 +3679,7 @@ undesired results when using @command{bash} as remote shell.
Another approach is to disable @value{tramp}'s handling of the
@env{HISTFILE} at all by setting @code{tramp-histfile-override} to
@code{nil}. In this case, saving history could be turned off by
putting this shell code in the @file{.bashrc} or @file{.kshrc} file:
putting this shell code in @file{.bashrc} or @file{.kshrc}:
@example
@group
@ -3680,7 +3696,7 @@ fi
@end example
For @option{ssh}-based method, add the following line to your
@file{~/.ssh/environment} file:
@file{~/.ssh/environment}:
@example
HISTFILE=/dev/null

155
etc/NEWS
View file

@ -34,6 +34,13 @@ functions 'json-serialize', 'json-insert', 'json-parse-string', and
'json-parse-buffer' are typically much faster than their Lisp
counterparts from json.el.
** The etags program now uses the C library's regular expression matcher
when possible, and a compatible regex substitute otherwise. This will
let developers maintain Emacs's own regex code without having to also
support other programs. The new configure option '--without-included-regex'
forces etags to use the C library's regex matcher even if the regex
substitute ordinarily would be used to work around compatibility problems.
** Emacs has been ported to the -fcheck-pointer-bounds option of GCC.
This causes Emacs to check bounds of some arrays addressed by its
internal pointers, which can be helpful when debugging the Emacs
@ -84,14 +91,24 @@ work right without some adjustment:
- you can use the new 'package-quickstart' so activation of packages does not
need to pay attention to 'package-load-list' or 'package-user-dir' any more.
---
** Emacs now notifies systemd when startup finishes or shutdown begins.
Units that are ordered after 'emacs.service' will only be started
after Emacs has finished initialization and is ready for use.
(If your Emacs is installed in a non-standard location and you copied the
emacs.service file to eg ~/.config/systemd/user/, you will need to copy
the new version of the file again.)
* Changes in Emacs 27.1
+++
** The function 'read-passwd' uses '*' as default character to hide passwords.
---
** New variable 'xft-ignore-color-fonts'.
Default t means don't try to load color fonts when using Xft, as they
often cause crashes. Set it to nil if you really need those fonts.
(Bug#30874)
---
** The new option 'tooltip-resize-echo-area' avoids truncating tooltip text
@ -178,6 +195,9 @@ This triggers to search the program on the remote host as indicated by
* Editing Changes in Emacs 27.1
+++
** New command 'make-empty-file'.
---
** New variable 'x-wait-for-event-timeout'.
This controls how long Emacs will wait for updates to the graphical
@ -215,6 +235,29 @@ navigation and editing of large files.
* Changes in Specialized Modes and Packages in Emacs 27.1
+++
** Dired
*** New command 'dired-create-empty-file'.
** Change Logs and VC
*** Recording ChangeLog entries doesn't require an actual file.
If a ChangeLog file doesn't exist, and if the new variable
'add-log-dont-create-changelog-file' is non-nil (which is the
default), commands such as 'C-x 4 a' will add log entries to a
suitable named temporary buffer. (An existing ChangeLog file will
still be used if it exists.) Set the variable to nil to get the
previous behavior of always creating a buffer that visits a ChangeLog
file.
** diff-mode
*** Hunks are now automatically refined by default
To disable it, set the new defcustom 'diff-font-lock-refine' to nil.
*** File headers can be shortened, mimicking Magit's diff format
To enable it, set the new defcustom 'diff-font-lock-prettify to t.
** Browse-url
*** The function 'browse-url-emacs' can now visit a URL in selected window.
@ -223,6 +266,10 @@ shown in the currently selected window.
** Comint
+++
*** 'send-invisible' is now an obsolete alias for `comint-send-invisible'
Also, 'shell-strip-ctrl-m' is declared obsolete.
+++
*** 'C-c .' (comint-insert-previous-argument) no longer interprets '&'.
This feature caused problems when '&&' was present in the previous
@ -240,6 +287,11 @@ better emulate 'M-.' in both Bash and zsh, since the former counts
from the beginning of the arguments, while the latter counts from the
end.
** Term
---
*** 'term-read-noecho' is now obsolete, use 'read-passwd' instead.
** Flymake
+++
@ -371,6 +423,13 @@ bound to 'C-c C-f'.
when escaping text and in addition all numeric entities when
unescaping text.
** Python mode
---
*** Python mode supports three different font lock decoration levels.
The maximum level is used by default; customize
'font-lock-maximum-decoration' to tone down the decoration.
** Dired
+++
@ -417,6 +476,14 @@ the shift key.
*** Isearch now remembers the regexp-based search mode for words/symbols
and case-sensitivity together with search strings in the search ring.
** Debugger
+++
*** The Lisp Debugger is now based on 'backtrace-mode'.
Backtrace mode adds fontification and commands for changing the
appearance of backtrace frames. See the node "Backtraces" in the Elisp
manual for documentation of the new mode and its commands.
** Edebug
+++
@ -426,14 +493,27 @@ using the new variables 'edebug-behavior-alist',
'edebug-new-definition-function'. Edebug's behavior can be changed
globally or for individual definitions.
+++
*** Edebug's backtrace buffer now uses 'backtrace-mode'.
Backtrace mode adds fontification, links and commands for changing the
appearance of backtrace frames. See the node "Backtraces" in the Elisp
manual for documentation of the new mode and its commands.
The binding of 'd' in Edebug's keymap is now 'edebug-pop-to-backtrace'
which replaces 'edebug-backtrace'. Consequently Edebug's backtrace
windows now behave like those of the Lisp Debugger and of ERT, in that
when they appear they will be the selected window.
The new 'backtrace-goto-source' command, bound to 's', works in
Edebug's backtraces on backtrace frames whose source code has
been instrumented by Edebug.
** Enhanced xterm support
*** New variable 'xterm-set-window-title' controls whether Emacs sets
the XTerm window title. This feature is experimental and is disabled
by default.
** Gamegrid
** grep
+++
@ -450,6 +530,14 @@ The abbreviation can be disabled by the new option
*** New variable 'ert-quiet' allows to make ERT output in batch mode
less verbose by removing non-essential information.
+++
*** ERT's backtrace buffer now uses 'backtrace-mode'.
Backtrace mode adds fontification and commands for changing the
appearance of backtrace frames. See the node "Backtraces" in the Elisp
manual for documentation of the new mode and its commands.
** Gamegrid
---
*** Gamegrid now determines its default glyph size based on display
dimensions, instead of always using 16 pixels. As a result, Tetris,
@ -520,7 +608,7 @@ process. It now accepts signals specified either by name or by its number.
** Tramp
+++
*** New connection method "owncloud", which allows to access OwnCloud
*** New connection method "nextcloud", which allows to access OwnCloud
or NextCloud hosted files and directories.
+++
@ -534,6 +622,11 @@ are obsoleted in GVFS.
*** The user option 'tramp-ignored-file-name-regexp' allows to disable
Tramp for some look-alike remote file names.
** Register
---
*** The return value of method 'register-val-describe' includes the
names of buffers shown by the windows of a window configuration.
---
** The options.el library has been removed.
It was obsolete since Emacs 22.1, replaced by customize.
@ -542,7 +635,6 @@ It was obsolete since Emacs 22.1, replaced by customize.
Use of built-in libgnutls based functionality (described in the Emacs
GnuTLS manual) is recommended instead.
** Message
+++
@ -588,6 +680,17 @@ If this option is non-nil, messages appended to an output file by the
selects the messages to summarize with a regexp that matches the
sender of the current message.
** Threads
+++
*** New variable 'main-thread' holds Emacs's main thread.
This is handy in Lisp programs that run on a non-main thread and want
to signal the main thread, e.g., when they encounter an error.
+++
*** 'thread-join' returns the result of the finished thread now.
* New Modes and Packages in Emacs 27.1
+++
@ -605,6 +708,13 @@ transport strategies as well as a separate API to use them. A
transport implementation for process-based communication, such as is
used by the Language Server Protocol (LSP), is readily available.
+++
** Backtrace mode improves viewing of Elisp backtraces.
Backtrace mode adds pretty printing, fontification and ellipsis
expansion to backtrace buffers produced by the Lisp debugger, Edebug
and ERT. See the node "Backtraces" in the Elisp manual for
documentation of the new mode and its commands.
* Incompatible Lisp Changes in Emacs 27.1
@ -645,7 +755,7 @@ as new-style, bind the new variable 'force-new-style-backquotes' to t.
** When formatting a floating-point number as an octal or hexadecimal
integer, Emacs now signals an error if the number is too large for the
implementation to format (Bug#30408).
implementation to format.
---
** Some functions and variables obsolete since Emacs 22 have been removed:
@ -694,13 +804,15 @@ however applications should instead call 'display-buffer-in-side-window'
is backwards-compatible with versions of Emacs in which the old function
exists. See the node "Displaying Buffers in Side Windows" in the ELisp
manual for more details.
* Lisp Changes in Emacs 27.1
+++
** New function 'proper-list-p'.
Given a proper list as argument, this predicate returns its length;
otherwise, it returns nil.
otherwise, it returns nil. 'format-proper-list-p' is now an obsolete
alias for the new function.
+++
** Emacs Lisp integers can be of arbitrary precision. The new
@ -758,6 +870,15 @@ between two strings.
** 'print-quoted' now defaults to t, so if you want to see
(quote x) instead of 'x you will have to bind it to nil where applicable.
+++
** Numbers formatted via %o or %x may now be formatted as signed integers.
This avoids problems in calls like (read (format "#x%x" -1)), and is
more compatible with bignums, a planned feature. To get this
behavior, set the experimental variable binary-as-unsigned to nil,
and if the new behavior breaks your code please email
32252@debbugs.gnu.org. Because %o and %x can now format signed
integers, they now support the + and space flags.
** To avoid confusion caused by "smart quotes", the reader signals an
error when reading Lisp symbols which begin with one of the following
quotation characters: ‘’‛“”‟〞＂＇. A symbol beginning with such a
@ -782,12 +903,12 @@ The new variable 'comment-use-syntax-ppss' can be set to nil to recover the old
behavior if needed.
** The 'server-name' and 'server-socket-dir' variables are set when a
socket has been passed to Emacs (Bug#24218).
socket has been passed to Emacs.
---
** The 'file-system-info' function is now available on all platforms.
instead of just Microsoft platforms. This fixes a 'get-free-disk-space'
bug on OS X 10.8 and later (Bug#28639).
bug on OS X 10.8 and later.
+++
** 'memory-limit' now returns a better estimate of memory consumption.
@ -803,13 +924,23 @@ changes and the change hooks are time consuming.
** The function 'get-free-disk-space' returns now a non-nil value for
remote systems, which support this check.
+++
** 'eql', 'make-hash-table', etc. now treat NaNs consistently.
Formerly, some of these functions ignored signs and significands of
NaNs. Now, all these functions treat NaN signs and significands as
significant. For example, (eql 0.0e+NaN -0.0e+NaN) now returns nil
because the two NaNs have different signs; formerly it returned t.
Also, Emacs now reads and prints NaN significands; e.g., if X is a
NaN, (format "%s" X) now returns "0.0e+NaN", "1.0e+NaN", etc.,
depending on X's significand.
+++
** The function 'make-string' accepts an additional optional argument.
If the optional third argument is non-nil, 'make-string' will produce
a multibyte string even if its second argument is an ASCII character.
** (format "%d" X) no longer mishandles a floating-point number X that
does not fit in a machine integer (Bug#30408).
does not fit in a machine integer.
** New JSON parsing and serialization functions 'json-serialize',
'json-insert', 'json-parse-string', and 'json-parse-buffer'. These
@ -844,10 +975,6 @@ higher-level functions.
some years back. It now respects 'imagemagick-types-inhibit' as a way
to disable that.
+++
** The new function 'read-answer' accepts either long or short answers
depending on the new customizable variable 'read-answer-short'.
** The function 'load' now behaves correctly when loading modules.
Specifically, it puts the module name into 'load-history', prints
loading messages if requested, and protects against recursive loads.

8
etc/NEWS.26
View file

@ -85,12 +85,20 @@ it now shows the global revision number, in the form of its changeset
hash value. To get back the previous behavior, customize the new
option 'vc-hg-symbolic-revision-styles' to the value '("{rev}")'.
---
** shadowfile.el has been rewritten to support Tramp file names.
* New Modes and Packages in Emacs 26.2
* Incompatible Lisp Changes in Emacs 26.2
---
** shadowfile config files have changed their syntax.
Existing files "~/.emacs.d/shadows" and "~/.emacs.d/shadow_todo" must
be removed prior using the changed 'shadow-*' commands.
* Lisp Changes in Emacs 26.2

2
etc/emacs.service
View file

@ -7,7 +7,7 @@ Description=Emacs text editor
Documentation=info:emacs man:emacs(1) https://gnu.org/software/emacs/
[Service]
Type=simple
Type=notify
ExecStart=emacs --fg-daemon
ExecStop=emacsclient --eval "(kill-emacs)"
Environment=SSH_AUTH_SOCK=%t/keyring/ssh

4
etc/themes/adwaita-theme.el
View file

@ -99,8 +99,4 @@ default look of the Gnome 3 desktop.")
`(diff-added ((,class (:bold t :foreground "#4E9A06"))))
`(diff-removed ((,class (:bold t :foreground "#F5666D"))))))
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; adwaita-theme.el ends here

4
etc/themes/deeper-blue-theme.el
View file

@ -110,8 +110,4 @@
(provide-theme 'deeper-blue)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; deeper-blue-theme.el ends here

4
etc/themes/dichromacy-theme.el
View file

@ -122,8 +122,4 @@ Ansi-Color faces are included.")
(provide-theme 'dichromacy)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; dichromacy-theme.el ends here

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

@ -708,7 +708,6 @@ Semantic, and Ansi-Color faces are included -- and much more...")
;; time-stamp-format: "%:y%02m%02d.%02H%02M"
;; time-stamp-start: "Version: "
;; time-stamp-end: "$"
;; no-byte-compile: t
;; End:
;;; leuven-theme.el ends here

4
etc/themes/light-blue-theme.el
View file

@ -61,8 +61,4 @@
(provide-theme 'light-blue)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; light-blue-theme.el ends here

4
etc/themes/manoj-dark-theme.el
View file

@ -700,8 +700,4 @@ jarring angry fruit salad look to reduce eye fatigue.")
(provide-theme 'manoj-dark)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; manoj-dark.el ends here

4
etc/themes/misterioso-theme.el
View file

@ -103,8 +103,4 @@
(provide-theme 'misterioso)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; misterioso-theme.el ends here

4
etc/themes/tango-dark-theme.el
View file

@ -170,8 +170,4 @@ Semantic, and Ansi-Color faces are included.")
(provide-theme 'tango-dark)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; tango-dark-theme.el ends here

4
etc/themes/tango-theme.el
View file

@ -154,8 +154,4 @@ Semantic, and Ansi-Color faces are included.")
(provide-theme 'tango)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; tango-theme.el ends here

4
etc/themes/tsdh-dark-theme.el
View file

@ -144,8 +144,4 @@
(provide-theme 'tsdh-dark)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; tsdh-dark-theme.el ends here

5
etc/themes/tsdh-light-theme.el
View file

@ -106,9 +106,4 @@ Used and created by Tassilo Horn.")
(provide-theme 'tsdh-light)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; tsdh-light-theme.el ends here

4
etc/themes/wheatgrass-theme.el
View file

@ -83,8 +83,4 @@ of green, brown, and blue.")
(provide-theme 'wheatgrass)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; wheatgrass-theme.el ends here

4
etc/themes/whiteboard-theme.el
View file

@ -100,8 +100,4 @@
(provide-theme 'whiteboard)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; whiteboard-theme.el ends here

4
etc/themes/wombat-theme.el
View file

@ -102,8 +102,4 @@ are included.")
(provide-theme 'wombat)
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; wombat-theme.el ends here

8
lib-src/Makefile.in
View file

@ -361,13 +361,9 @@ TAGS: etags${EXEEXT} ${tagsfiles}
../lib/libgnu.a: $(config_h)
$(MAKE) -C ../lib all
regex.o: $(srcdir)/../src/regex.c $(srcdir)/../src/regex.h $(config_h)
$(AM_V_CC)$(CC) -c $(CPP_CFLAGS) $<
etags_deps = ${srcdir}/etags.c regex.o $(NTLIB) $(config_h)
etags_deps = ${srcdir}/etags.c $(NTLIB) $(config_h)
etags_cflags = -DEMACS_NAME="\"GNU Emacs\"" -DVERSION="\"${version}\"" -o $@
etags_libs = regex.o $(NTLIB) $(LOADLIBES)
etags_libs = $(NTLIB) $(LOADLIBES)
etags${EXEEXT}: ${etags_deps}
$(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $(etags_cflags) $< $(etags_libs)

2
lib-src/etags.c
View file

@ -6401,7 +6401,7 @@ add_regex (char *regexp_pattern, language *lang)
*patbuf = zeropattern;
if (ignore_case)
{
static char lc_trans[UCHAR_MAX + 1];
static unsigned char lc_trans[UCHAR_MAX + 1];
int i;
for (i = 0; i < UCHAR_MAX + 1; i++)
lc_trans[i] = c_tolower (i);

67
lib-src/ntlib.c
View file

@ -31,6 +31,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <ctype.h>
#include <sys/timeb.h>
#include <mbstring.h>
#include <locale.h>
#include <nl_types.h>
#include <langinfo.h>
#include "ntlib.h"
@ -423,3 +427,66 @@ sys_open (const char * path, int oflag, int mode)
{
return _open (path, oflag, mode);
}
/* Emulation of nl_langinfo that supports only CODESET.
Used in Gnulib regex.c. */
char *
nl_langinfo (nl_item item)
{
switch (item)
{
case CODESET:
{
/* Shamelessly stolen from Gnulib's nl_langinfo.c, modulo
CPP directives. */
static char buf[2 + 10 + 1];
char const *locale = setlocale (LC_CTYPE, NULL);
char *codeset = buf;
size_t codesetlen;
codeset[0] = '\0';
if (locale && locale[0])
{
/* If the locale name contains an encoding after the
dot, return it. */
char *dot = strchr (locale, '.');
if (dot)
{
/* Look for the possible @... trailer and remove it,
if any. */
char *codeset_start = dot + 1;
char const *modifier = strchr (codeset_start, '@');
if (! modifier)
codeset = codeset_start;
else
{
codesetlen = modifier - codeset_start;
if (codesetlen < sizeof buf)
{
codeset = memcpy (buf, codeset_start, codesetlen);
codeset[codesetlen] = '\0';
}
}
}
}
/* If setlocale is successful, it returns the number of the
codepage, as a string. Otherwise, fall back on Windows
API GetACP, which returns the locale's codepage as a
number (although this doesn't change according to what
the 'setlocale' call specified). Either way, prepend
"CP" to make it a valid codeset name. */
codesetlen = strlen (codeset);
if (0 < codesetlen && codesetlen < sizeof buf - 2)
memmove (buf + 2, codeset, codesetlen + 1);
else
sprintf (buf + 2, "%u", GetACP ());
codeset = memcpy (buf, "CP", 2);
return codeset;
}
default:
return (char *) "";
}
}

8
lib-src/pop.c
View file

@ -30,8 +30,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "ntlib.h"
#undef _WIN32_WINNT
#define _WIN32_WINNT 0x0501 /* for getaddrinfo stuff */
#include <winsock2.h>
#include <ws2tcpip.h>
#if defined __MINGW32_VERSION && __MINGW32_VERSION >= 5000002L
# include <windows.h>
#else
# include <winsock2.h>
#endif
# include <ws2tcpip.h>
#undef getaddrinfo
#define getaddrinfo sys_getaddrinfo
#undef freeaddrinfo

8
lib/Makefile.in
View file

@ -79,9 +79,15 @@ endif
Makefile: ../config.status $(srcdir)/Makefile.in
$(MAKE) -C .. src/$@
# Object modules that need not be built for Emacs.
# Emacs does not need e-regex.o (it has its own regex-emacs.c),
# and building it would just waste time.
not_emacs_OBJECTS = regex.o
libgnu_a_OBJECTS = $(gl_LIBOBJS) \
$(patsubst %.c,%.o,$(filter %.c,$(libgnu_a_SOURCES)))
libegnu_a_OBJECTS = $(patsubst %.o,e-%.o,$(libgnu_a_OBJECTS))
for_emacs_OBJECTS = $(filter-out $(not_emacs_OBJECTS),$(libgnu_a_OBJECTS))
libegnu_a_OBJECTS = $(patsubst %.o,e-%.o,$(for_emacs_OBJECTS))
$(libegnu_a_OBJECTS) $(libgnu_a_OBJECTS): $(BUILT_SOURCES)

170
lib/gnulib.mk.in
View file

@ -20,7 +20,134 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fpieee fstatat fsusage fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings
# Reproduce by:
# gnulib-tool --import \
# --lib=libgnu \
# --source-base=lib \
# --m4-base=m4 \
# --doc-base=doc \
# --tests-base=tests \
# --aux-dir=build-aux \
# --gnu-make \
# --makefile-name=gnulib.mk.in \
# --conditional-dependencies \
# --no-libtool \
# --macro-prefix=gl \
# --no-vc-files \
# --avoid=btowc \
# --avoid=close \
# --avoid=dup \
# --avoid=fchdir \
# --avoid=fstat \
# --avoid=langinfo \
# --avoid=lock \
# --avoid=malloc-posix \
# --avoid=mbrtowc \
# --avoid=mbsinit \
# --avoid=msvc-inval \
# --avoid=msvc-nothrow \
# --avoid=nl_langinfo \
# --avoid=openat-die \
# --avoid=opendir \
# --avoid=raise \
# --avoid=save-cwd \
# --avoid=select \
# --avoid=setenv \
# --avoid=sigprocmask \
# --avoid=stat \
# --avoid=stdarg \
# --avoid=stdbool \
# --avoid=threadlib \
# --avoid=tzset \
# --avoid=unsetenv \
# --avoid=utime \
# --avoid=utime-h \
# --avoid=wchar \
# --avoid=wcrtomb \
# --avoid=wctype-h \
# alloca-opt \
# binary-io \
# byteswap \
# c-ctype \
# c-strcase \
# careadlinkat \
# close-stream \
# count-leading-zeros \
# count-one-bits \
# count-trailing-zeros \
# crypto/md5-buffer \
# crypto/sha1-buffer \
# crypto/sha256-buffer \
# crypto/sha512-buffer \
# d-type \
# diffseq \
# dtoastr \
# dtotimespec \
# dup2 \
# environ \
# execinfo \
# explicit_bzero \
# faccessat \
# fcntl \
# fcntl-h \
# fdatasync \
# fdopendir \
# filemode \
# filevercmp \
# flexmember \
# fpieee \
# fstatat \
# fsusage \
# fsync \
# getloadavg \
# getopt-gnu \
# gettime \
# gettimeofday \
# gitlog-to-changelog \
# ieee754-h \
# ignore-value \
# intprops \
# largefile \
# lstat \
# manywarnings \
# memrchr \
# minmax \
# mkostemp \
# mktime \
# nstrftime \
# pipe2 \
# pselect \
# pthread_sigmask \
# putenv \
# qcopy-acl \
# readlink \
# readlinkat \
# regex \
# sig2str \
# socklen \
# stat-time \
# std-gnu11 \
# stdalign \
# stddef \
# stdio \
# stpcpy \
# strtoimax \
# symlink \
# sys_stat \
# sys_time \
# tempname \
# time \
# time_r \
# time_rz \
# timegm \
# timer-time \
# timespec-add \
# timespec-sub \
# unlocked-io \
# update-copyright \
# utimens \
# vla \
# warnings
MOSTLYCLEANFILES += core *.stackdump
@ -99,11 +226,13 @@ GETOPT_CDEFS_H = @GETOPT_CDEFS_H@
GETOPT_H = @GETOPT_H@
GFILENOTIFY_CFLAGS = @GFILENOTIFY_CFLAGS@
GFILENOTIFY_LIBS = @GFILENOTIFY_LIBS@
GLIBC21 = @GLIBC21@
GL_COND_LIBTOOL = @GL_COND_LIBTOOL@
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_IEEE754_H = @GL_GENERATE_IEEE754_H@
GL_GENERATE_LIMITS_H = @GL_GENERATE_LIMITS_H@
GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@
GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@
@ -530,6 +659,7 @@ HAVE_WINSOCK2_H = @HAVE_WINSOCK2_H@
HAVE_XSERVER = @HAVE_XSERVER@
HAVE__EXIT = @HAVE__EXIT@
HYBRID_MALLOC = @HYBRID_MALLOC@
IEEE754_H = @IEEE754_H@
IMAGEMAGICK_CFLAGS = @IMAGEMAGICK_CFLAGS@
IMAGEMAGICK_LIBS = @IMAGEMAGICK_LIBS@
INCLUDE_NEXT = @INCLUDE_NEXT@
@ -905,6 +1035,7 @@ 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_37f71b604aa9c54446783d80f42fe547 = @gl_GNULIB_ENABLED_37f71b604aa9c54446783d80f42fe547@
gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31@
gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c@
gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec = @gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec@
@ -1671,6 +1802,32 @@ EXTRA_libgnu_a_SOURCES += group-member.c
endif
## end gnulib module group-member
## begin gnulib module ieee754-h
ifeq (,$(OMIT_GNULIB_MODULE_ieee754-h))
BUILT_SOURCES += $(IEEE754_H)
# We need the following in order to create <ieee754.h> when the system
# doesn't have one that works with the given compiler.
ifneq (,$(GL_GENERATE_IEEE754_H))
ieee754.h: ieee754.in.h $(top_builddir)/config.status
$(AM_V_GEN)rm -f $@-t && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
sed -e 's/ifndef _GL_GNULIB_HEADER/if 0/g' \
$(srcdir)/ieee754.in.h; \
} > $@-t && \
mv -f $@-t $@
else
ieee754.h: $(top_builddir)/config.status
rm -f $@
endif
MOSTLYCLEANFILES += ieee754.h ieee754.h-t
EXTRA_DIST += ieee754.in.h
endif
## end gnulib module ieee754-h
## begin gnulib module ignore-value
ifeq (,$(OMIT_GNULIB_MODULE_ignore-value))
@ -1950,6 +2107,17 @@ EXTRA_libgnu_a_SOURCES += at-func.c readlinkat.c
endif
## end gnulib module readlinkat
## begin gnulib module regex
ifeq (,$(OMIT_GNULIB_MODULE_regex))
EXTRA_DIST += regcomp.c regex.c regex.h regex_internal.c regex_internal.h regexec.c
EXTRA_libgnu_a_SOURCES += regcomp.c regex.c regex_internal.c regexec.c
endif
## end gnulib module regex
## begin gnulib module root-uid
ifeq (,$(OMIT_GNULIB_MODULE_root-uid))

222
lib/ieee754.in.h Normal file
View file

@ -0,0 +1,222 @@
/* Copyright (C) 1992-2018 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library 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.
The GNU C Library 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 the GNU C Library; if not, see
<http://www.gnu.org/licenses/>. */
#ifndef _IEEE754_H
#define _IEEE754_H 1
#ifndef _GL_GNULIB_HEADER
/* Ordinary glibc usage. */
# include <features.h>
# include <endian.h>
#else
/* Gnulib usage. */
# ifndef __BEGIN_DECLS
# ifdef __cplusplus
# define __BEGIN_DECLS extern "C" {
# define __END_DECLS }
# else
# define __BEGIN_DECLS
# define __END_DECLS
# endif
# endif
# ifndef __FLOAT_WORD_ORDER
# define __LITTLE_ENDIAN 1234
# define __BIG_ENDIAN 4321
# ifdef WORDS_BIGENDIAN
# define __BYTE_ORDER __BIG_ENDIAN
# else
# define __BYTE_ORDER __LITTLE_ENDIAN
# endif
# define __FLOAT_WORD_ORDER __BYTE_ORDER
# endif
#endif
__BEGIN_DECLS
union ieee754_float
{
float f;
/* This is the IEEE 754 single-precision format. */
struct
{
#if __BYTE_ORDER == __BIG_ENDIAN
unsigned int negative:1;
unsigned int exponent:8;
unsigned int mantissa:23;
#endif /* Big endian. */
#if __BYTE_ORDER == __LITTLE_ENDIAN
unsigned int mantissa:23;
unsigned int exponent:8;
unsigned int negative:1;
#endif /* Little endian. */
} ieee;
/* This format makes it easier to see if a NaN is a signalling NaN. */
struct
{
#if __BYTE_ORDER == __BIG_ENDIAN
unsigned int negative:1;
unsigned int exponent:8;
unsigned int quiet_nan:1;
unsigned int mantissa:22;
#endif /* Big endian. */
#if __BYTE_ORDER == __LITTLE_ENDIAN
unsigned int mantissa:22;
unsigned int quiet_nan:1;
unsigned int exponent:8;
unsigned int negative:1;
#endif /* Little endian. */
} ieee_nan;
};
#define IEEE754_FLOAT_BIAS 0x7f /* Added to exponent. */
union ieee754_double
{
double d;
/* This is the IEEE 754 double-precision format. */
struct
{
#if __BYTE_ORDER == __BIG_ENDIAN
unsigned int negative:1;
unsigned int exponent:11;
/* Together these comprise the mantissa. */
unsigned int mantissa0:20;
unsigned int mantissa1:32;
#endif /* Big endian. */
#if __BYTE_ORDER == __LITTLE_ENDIAN
# if __FLOAT_WORD_ORDER == __BIG_ENDIAN
unsigned int mantissa0:20;
unsigned int exponent:11;
unsigned int negative:1;
unsigned int mantissa1:32;
# else
/* Together these comprise the mantissa. */
unsigned int mantissa1:32;
unsigned int mantissa0:20;
unsigned int exponent:11;
unsigned int negative:1;
# endif
#endif /* Little endian. */
} ieee;
/* This format makes it easier to see if a NaN is a signalling NaN. */
struct
{
#if __BYTE_ORDER == __BIG_ENDIAN
unsigned int negative:1;
unsigned int exponent:11;
unsigned int quiet_nan:1;
/* Together these comprise the mantissa. */
unsigned int mantissa0:19;
unsigned int mantissa1:32;
#else
# if __FLOAT_WORD_ORDER == __BIG_ENDIAN
unsigned int mantissa0:19;
unsigned int quiet_nan:1;
unsigned int exponent:11;
unsigned int negative:1;
unsigned int mantissa1:32;
# else
/* Together these comprise the mantissa. */
unsigned int mantissa1:32;
unsigned int mantissa0:19;
unsigned int quiet_nan:1;
unsigned int exponent:11;
unsigned int negative:1;
# endif
#endif
} ieee_nan;
};
#define IEEE754_DOUBLE_BIAS 0x3ff /* Added to exponent. */
union ieee854_long_double
{
long double d;
/* This is the IEEE 854 double-extended-precision format. */
struct
{
#if __BYTE_ORDER == __BIG_ENDIAN
unsigned int negative:1;
unsigned int exponent:15;
unsigned int empty:16;
unsigned int mantissa0:32;
unsigned int mantissa1:32;
#endif
#if __BYTE_ORDER == __LITTLE_ENDIAN
# if __FLOAT_WORD_ORDER == __BIG_ENDIAN
unsigned int exponent:15;
unsigned int negative:1;
unsigned int empty:16;
unsigned int mantissa0:32;
unsigned int mantissa1:32;
# else
unsigned int mantissa1:32;
unsigned int mantissa0:32;
unsigned int exponent:15;
unsigned int negative:1;
unsigned int empty:16;
# endif
#endif
} ieee;
/* This is for NaNs in the IEEE 854 double-extended-precision format. */
struct
{
#if __BYTE_ORDER == __BIG_ENDIAN
unsigned int negative:1;
unsigned int exponent:15;
unsigned int empty:16;
unsigned int one:1;
unsigned int quiet_nan:1;
unsigned int mantissa0:30;
unsigned int mantissa1:32;
#endif
#if __BYTE_ORDER == __LITTLE_ENDIAN
# if __FLOAT_WORD_ORDER == __BIG_ENDIAN
unsigned int exponent:15;
unsigned int negative:1;
unsigned int empty:16;
unsigned int mantissa0:30;
unsigned int quiet_nan:1;
unsigned int one:1;
unsigned int mantissa1:32;
# else
unsigned int mantissa1:32;
unsigned int mantissa0:30;
unsigned int quiet_nan:1;
unsigned int one:1;
unsigned int exponent:15;
unsigned int negative:1;
unsigned int empty:16;
# endif
#endif
} ieee_nan;
};
#define IEEE854_LONG_DOUBLE_BIAS 0x3fff
__END_DECLS
#endif /* ieee754.h */

3944
lib/regcomp.c Normal file
View file

File diff suppressed because it is too large Load diff

81
lib/regex.c Normal file
View file

@ -0,0 +1,81 @@
/* Extended regular expression matching and search library.
Copyright (C) 2002-2018 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
The GNU C Library 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.
The GNU C Library 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 the GNU C Library; if not, see
<https://www.gnu.org/licenses/>. */
#ifndef _LIBC
# include <config.h>
# if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__
# pragma GCC diagnostic ignored "-Wsuggest-attribute=pure"
# endif
# if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__
# pragma GCC diagnostic ignored "-Wold-style-definition"
# pragma GCC diagnostic ignored "-Wtype-limits"
# endif
#endif
/* Make sure no one compiles this code with a C++ compiler. */
#if defined __cplusplus && defined _LIBC
# error "This is C code, use a C compiler"
#endif
#ifdef _LIBC
/* We have to keep the namespace clean. */
# define regfree(preg) __regfree (preg)
# define regexec(pr, st, nm, pm, ef) __regexec (pr, st, nm, pm, ef)
# define regcomp(preg, pattern, cflags) __regcomp (preg, pattern, cflags)
# define regerror(errcode, preg, errbuf, errbuf_size) \
__regerror(errcode, preg, errbuf, errbuf_size)
# define re_set_registers(bu, re, nu, st, en) \
__re_set_registers (bu, re, nu, st, en)
# define re_match_2(bufp, string1, size1, string2, size2, pos, regs, stop) \
__re_match_2 (bufp, string1, size1, string2, size2, pos, regs, stop)
# define re_match(bufp, string, size, pos, regs) \
__re_match (bufp, string, size, pos, regs)
# define re_search(bufp, string, size, startpos, range, regs) \
__re_search (bufp, string, size, startpos, range, regs)
# define re_compile_pattern(pattern, length, bufp) \
__re_compile_pattern (pattern, length, bufp)
# define re_set_syntax(syntax) __re_set_syntax (syntax)
# define re_search_2(bufp, st1, s1, st2, s2, startpos, range, regs, stop) \
__re_search_2 (bufp, st1, s1, st2, s2, startpos, range, regs, stop)
# define re_compile_fastmap(bufp) __re_compile_fastmap (bufp)
# include "../locale/localeinfo.h"
#endif
/* On some systems, limits.h sets RE_DUP_MAX to a lower value than
GNU regex allows. Include it before <regex.h>, which correctly
#undefs RE_DUP_MAX and sets it to the right value. */
#include <limits.h>
#include <regex.h>
#include "regex_internal.h"
#include "regex_internal.c"
#include "regcomp.c"
#include "regexec.c"
/* Binary backward compatibility. */
#if _LIBC
# include <shlib-compat.h>
# if SHLIB_COMPAT (libc, GLIBC_2_0, GLIBC_2_3)
link_warning (re_max_failures, "the 're_max_failures' variable is obsolete and will go away.")
int re_max_failures = 2000;
# endif
#endif

658
lib/regex.h Normal file
View file

@ -0,0 +1,658 @@
/* Definitions for data structures and routines for the regular
expression library.
Copyright (C) 1985, 1989-2018 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library 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.
The GNU C Library 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 the GNU C Library; if not, see
<https://www.gnu.org/licenses/>. */
#ifndef _REGEX_H
#define _REGEX_H 1
#include <sys/types.h>
/* Allow the use in C++ code. */
#ifdef __cplusplus
extern "C" {
#endif
/* Define __USE_GNU to declare GNU extensions that violate the
POSIX name space rules. */
#ifdef _GNU_SOURCE
# define __USE_GNU 1
#endif
#ifdef _REGEX_LARGE_OFFSETS
/* Use types and values that are wide enough to represent signed and
unsigned byte offsets in memory. This currently works only when
the regex code is used outside of the GNU C library; it is not yet
supported within glibc itself, and glibc users should not define
_REGEX_LARGE_OFFSETS. */
/* The type of object sizes. */
typedef size_t __re_size_t;
/* The type of object sizes, in places where the traditional code
uses unsigned long int. */
typedef size_t __re_long_size_t;
#else
/* The traditional GNU regex implementation mishandles strings longer
than INT_MAX. */
typedef unsigned int __re_size_t;
typedef unsigned long int __re_long_size_t;
#endif
/* The following two types have to be signed and unsigned integer type
wide enough to hold a value of a pointer. For most ANSI compilers
ptrdiff_t and size_t should be likely OK. Still size of these two
types is 2 for Microsoft C. Ugh... */
typedef long int s_reg_t;
typedef unsigned long int active_reg_t;
/* The following bits are used to determine the regexp syntax we
recognize. The set/not-set meanings are chosen so that Emacs syntax
remains the value 0. The bits are given in alphabetical order, and
the definitions shifted by one from the previous bit; thus, when we
add or remove a bit, only one other definition need change. */
typedef unsigned long int reg_syntax_t;
#ifdef __USE_GNU
/* If this bit is not set, then \ inside a bracket expression is literal.
If set, then such a \ quotes the following character. */
# define RE_BACKSLASH_ESCAPE_IN_LISTS ((unsigned long int) 1)
/* If this bit is not set, then + and ? are operators, and \+ and \? are
literals.
If set, then \+ and \? are operators and + and ? are literals. */
# define RE_BK_PLUS_QM (RE_BACKSLASH_ESCAPE_IN_LISTS << 1)
/* If this bit is set, then character classes are supported. They are:
[:alpha:], [:upper:], [:lower:], [:digit:], [:alnum:], [:xdigit:],
[:space:], [:print:], [:punct:], [:graph:], and [:cntrl:].
If not set, then character classes are not supported. */
# define RE_CHAR_CLASSES (RE_BK_PLUS_QM << 1)
/* If this bit is set, then ^ and $ are always anchors (outside bracket
expressions, of course).
If this bit is not set, then it depends:
^ is an anchor if it is at the beginning of a regular
expression or after an open-group or an alternation operator;
$ is an anchor if it is at the end of a regular expression, or
before a close-group or an alternation operator.
This bit could be (re)combined with RE_CONTEXT_INDEP_OPS, because
POSIX draft 11.2 says that * etc. in leading positions is undefined.
We already implemented a previous draft which made those constructs
invalid, though, so we haven't changed the code back. */
# define RE_CONTEXT_INDEP_ANCHORS (RE_CHAR_CLASSES << 1)
/* If this bit is set, then special characters are always special
regardless of where they are in the pattern.
If this bit is not set, then special characters are special only in
some contexts; otherwise they are ordinary. Specifically,
* + ? and intervals are only special when not after the beginning,
open-group, or alternation operator. */
# define RE_CONTEXT_INDEP_OPS (RE_CONTEXT_INDEP_ANCHORS << 1)
/* If this bit is set, then *, +, ?, and { cannot be first in an re or
immediately after an alternation or begin-group operator. */
# define RE_CONTEXT_INVALID_OPS (RE_CONTEXT_INDEP_OPS << 1)
/* If this bit is set, then . matches newline.
If not set, then it doesn't. */
# define RE_DOT_NEWLINE (RE_CONTEXT_INVALID_OPS << 1)
/* If this bit is set, then . doesn't match NUL.
If not set, then it does. */
# define RE_DOT_NOT_NULL (RE_DOT_NEWLINE << 1)
/* If this bit is set, nonmatching lists [^...] do not match newline.
If not set, they do. */
# define RE_HAT_LISTS_NOT_NEWLINE (RE_DOT_NOT_NULL << 1)
/* If this bit is set, either \{...\} or {...} defines an
interval, depending on RE_NO_BK_BRACES.
If not set, \{, \}, {, and } are literals. */
# define RE_INTERVALS (RE_HAT_LISTS_NOT_NEWLINE << 1)
/* If this bit is set, +, ? and | aren't recognized as operators.
If not set, they are. */
# define RE_LIMITED_OPS (RE_INTERVALS << 1)
/* If this bit is set, newline is an alternation operator.
If not set, newline is literal. */
# define RE_NEWLINE_ALT (RE_LIMITED_OPS << 1)
/* If this bit is set, then '{...}' defines an interval, and \{ and \}
are literals.
If not set, then '\{...\}' defines an interval. */
# define RE_NO_BK_BRACES (RE_NEWLINE_ALT << 1)
/* If this bit is set, (...) defines a group, and \( and \) are literals.
If not set, \(...\) defines a group, and ( and ) are literals. */
# define RE_NO_BK_PARENS (RE_NO_BK_BRACES << 1)
/* If this bit is set, then \<digit> matches <digit>.
If not set, then \<digit> is a back-reference. */
# define RE_NO_BK_REFS (RE_NO_BK_PARENS << 1)
/* If this bit is set, then | is an alternation operator, and \| is literal.
If not set, then \| is an alternation operator, and | is literal. */
# define RE_NO_BK_VBAR (RE_NO_BK_REFS << 1)
/* If this bit is set, then an ending range point collating higher
than the starting range point, as in [z-a], is invalid.
If not set, then when ending range point collates higher than the
starting range point, the range is ignored. */
# define RE_NO_EMPTY_RANGES (RE_NO_BK_VBAR << 1)
/* If this bit is set, then an unmatched ) is ordinary.
If not set, then an unmatched ) is invalid. */
# define RE_UNMATCHED_RIGHT_PAREN_ORD (RE_NO_EMPTY_RANGES << 1)
/* If this bit is set, succeed as soon as we match the whole pattern,
without further backtracking. */
# define RE_NO_POSIX_BACKTRACKING (RE_UNMATCHED_RIGHT_PAREN_ORD << 1)
/* If this bit is set, do not process the GNU regex operators.
If not set, then the GNU regex operators are recognized. */
# define RE_NO_GNU_OPS (RE_NO_POSIX_BACKTRACKING << 1)
/* If this bit is set, turn on internal regex debugging.
If not set, and debugging was on, turn it off.
This only works if regex.c is compiled -DDEBUG.
We define this bit always, so that all that's needed to turn on
debugging is to recompile regex.c; the calling code can always have
this bit set, and it won't affect anything in the normal case. */
# define RE_DEBUG (RE_NO_GNU_OPS << 1)
/* If this bit is set, a syntactically invalid interval is treated as
a string of ordinary characters. For example, the ERE 'a{1' is
treated as 'a\{1'. */
# define RE_INVALID_INTERVAL_ORD (RE_DEBUG << 1)
/* If this bit is set, then ignore case when matching.
If not set, then case is significant. */
# define RE_ICASE (RE_INVALID_INTERVAL_ORD << 1)
/* This bit is used internally like RE_CONTEXT_INDEP_ANCHORS but only
for ^, because it is difficult to scan the regex backwards to find
whether ^ should be special. */
# define RE_CARET_ANCHORS_HERE (RE_ICASE << 1)
/* If this bit is set, then \{ cannot be first in a regex or
immediately after an alternation, open-group or \} operator. */
# define RE_CONTEXT_INVALID_DUP (RE_CARET_ANCHORS_HERE << 1)
/* If this bit is set, then no_sub will be set to 1 during
re_compile_pattern. */
# define RE_NO_SUB (RE_CONTEXT_INVALID_DUP << 1)
#endif
/* This global variable defines the particular regexp syntax to use (for
some interfaces). When a regexp is compiled, the syntax used is
stored in the pattern buffer, so changing this does not affect
already-compiled regexps. */
extern reg_syntax_t re_syntax_options;
#ifdef __USE_GNU
/* Define combinations of the above bits for the standard possibilities.
(The [[[ comments delimit what gets put into the Texinfo file, so
don't delete them!) */
/* [[[begin syntaxes]]] */
# define RE_SYNTAX_EMACS 0
# define RE_SYNTAX_AWK \
(RE_BACKSLASH_ESCAPE_IN_LISTS | RE_DOT_NOT_NULL \
| RE_NO_BK_PARENS | RE_NO_BK_REFS \
| RE_NO_BK_VBAR | RE_NO_EMPTY_RANGES \
| RE_DOT_NEWLINE | RE_CONTEXT_INDEP_ANCHORS \
| RE_CHAR_CLASSES \
| RE_UNMATCHED_RIGHT_PAREN_ORD | RE_NO_GNU_OPS)
# define RE_SYNTAX_GNU_AWK \
((RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS \
| RE_INVALID_INTERVAL_ORD) \
& ~(RE_DOT_NOT_NULL | RE_CONTEXT_INDEP_OPS \
| RE_CONTEXT_INVALID_OPS ))
# define RE_SYNTAX_POSIX_AWK \
(RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS \
| RE_INTERVALS | RE_NO_GNU_OPS \
| RE_INVALID_INTERVAL_ORD)
# define RE_SYNTAX_GREP \
((RE_SYNTAX_POSIX_BASIC | RE_NEWLINE_ALT) \
& ~(RE_CONTEXT_INVALID_DUP | RE_DOT_NOT_NULL))
# define RE_SYNTAX_EGREP \
((RE_SYNTAX_POSIX_EXTENDED | RE_INVALID_INTERVAL_ORD | RE_NEWLINE_ALT) \
& ~(RE_CONTEXT_INVALID_OPS | RE_DOT_NOT_NULL))
/* POSIX grep -E behavior is no longer incompatible with GNU. */
# define RE_SYNTAX_POSIX_EGREP \
RE_SYNTAX_EGREP
/* P1003.2/D11.2, section 4.20.7.1, lines 5078ff. */
# define RE_SYNTAX_ED RE_SYNTAX_POSIX_BASIC
# define RE_SYNTAX_SED RE_SYNTAX_POSIX_BASIC
/* Syntax bits common to both basic and extended POSIX regex syntax. */
# define _RE_SYNTAX_POSIX_COMMON \
(RE_CHAR_CLASSES | RE_DOT_NEWLINE | RE_DOT_NOT_NULL \
| RE_INTERVALS | RE_NO_EMPTY_RANGES)
# define RE_SYNTAX_POSIX_BASIC \
(_RE_SYNTAX_POSIX_COMMON | RE_BK_PLUS_QM | RE_CONTEXT_INVALID_DUP)
/* Differs from ..._POSIX_BASIC only in that RE_BK_PLUS_QM becomes
RE_LIMITED_OPS, i.e., \? \+ \| are not recognized. Actually, this
isn't minimal, since other operators, such as \`, aren't disabled. */
# define RE_SYNTAX_POSIX_MINIMAL_BASIC \
(_RE_SYNTAX_POSIX_COMMON | RE_LIMITED_OPS)
# define RE_SYNTAX_POSIX_EXTENDED \
(_RE_SYNTAX_POSIX_COMMON | RE_CONTEXT_INDEP_ANCHORS \
| RE_CONTEXT_INDEP_OPS | RE_NO_BK_BRACES \
| RE_NO_BK_PARENS | RE_NO_BK_VBAR \
| RE_CONTEXT_INVALID_OPS | RE_UNMATCHED_RIGHT_PAREN_ORD)
/* Differs from ..._POSIX_EXTENDED in that RE_CONTEXT_INDEP_OPS is
removed and RE_NO_BK_REFS is added. */
# define RE_SYNTAX_POSIX_MINIMAL_EXTENDED \
(_RE_SYNTAX_POSIX_COMMON | RE_CONTEXT_INDEP_ANCHORS \
| RE_CONTEXT_INVALID_OPS | RE_NO_BK_BRACES \
| RE_NO_BK_PARENS | RE_NO_BK_REFS \
| RE_NO_BK_VBAR | RE_UNMATCHED_RIGHT_PAREN_ORD)
/* [[[end syntaxes]]] */
/* Maximum number of duplicates an interval can allow. POSIX-conforming
systems might define this in <limits.h>, but we want our
value, so remove any previous define. */
# ifdef _REGEX_INCLUDE_LIMITS_H
# include <limits.h>
# endif
# ifdef RE_DUP_MAX
# undef RE_DUP_MAX
# endif
/* RE_DUP_MAX is 2**15 - 1 because an earlier implementation stored
the counter as a 2-byte signed integer. This is no longer true, so
RE_DUP_MAX could be increased to (INT_MAX / 10 - 1), or to
((SIZE_MAX - 9) / 10) if _REGEX_LARGE_OFFSETS is defined.
However, there would be a huge performance problem if someone
actually used a pattern like a\{214748363\}, so RE_DUP_MAX retains
its historical value. */
# define RE_DUP_MAX (0x7fff)
#endif
/* POSIX 'cflags' bits (i.e., information for 'regcomp'). */
/* If this bit is set, then use extended regular expression syntax.
If not set, then use basic regular expression syntax. */
#define REG_EXTENDED 1
/* If this bit is set, then ignore case when matching.
If not set, then case is significant. */
#define REG_ICASE (1 << 1)
/* If this bit is set, then anchors do not match at newline
characters in the string.
If not set, then anchors do match at newlines. */
#define REG_NEWLINE (1 << 2)
/* If this bit is set, then report only success or fail in regexec.
If not set, then returns differ between not matching and errors. */
#define REG_NOSUB (1 << 3)
/* POSIX 'eflags' bits (i.e., information for regexec). */
/* If this bit is set, then the beginning-of-line operator doesn't match
the beginning of the string (presumably because it's not the
beginning of a line).
If not set, then the beginning-of-line operator does match the
beginning of the string. */
#define REG_NOTBOL 1
/* Like REG_NOTBOL, except for the end-of-line. */
#define REG_NOTEOL (1 << 1)
/* Use PMATCH[0] to delimit the start and end of the search in the
buffer. */
#define REG_STARTEND (1 << 2)
/* If any error codes are removed, changed, or added, update the
'__re_error_msgid' table in regcomp.c. */
typedef enum
{
_REG_ENOSYS = -1, /* This will never happen for this implementation. */
_REG_NOERROR = 0, /* Success. */
_REG_NOMATCH, /* Didn't find a match (for regexec). */
/* POSIX regcomp return error codes. (In the order listed in the
standard.) */
_REG_BADPAT, /* Invalid pattern. */
_REG_ECOLLATE, /* Invalid collating element. */
_REG_ECTYPE, /* Invalid character class name. */
_REG_EESCAPE, /* Trailing backslash. */
_REG_ESUBREG, /* Invalid back reference. */
_REG_EBRACK, /* Unmatched left bracket. */
_REG_EPAREN, /* Parenthesis imbalance. */
_REG_EBRACE, /* Unmatched \{. */
_REG_BADBR, /* Invalid contents of \{\}. */
_REG_ERANGE, /* Invalid range end. */
_REG_ESPACE, /* Ran out of memory. */
_REG_BADRPT, /* No preceding re for repetition op. */
/* Error codes we've added. */
_REG_EEND, /* Premature end. */
_REG_ESIZE, /* Too large (e.g., repeat count too large). */
_REG_ERPAREN /* Unmatched ) or \); not returned from regcomp. */
} reg_errcode_t;
#if defined _XOPEN_SOURCE || defined __USE_XOPEN2K
# define REG_ENOSYS _REG_ENOSYS
#endif
#define REG_NOERROR _REG_NOERROR
#define REG_NOMATCH _REG_NOMATCH
#define REG_BADPAT _REG_BADPAT
#define REG_ECOLLATE _REG_ECOLLATE
#define REG_ECTYPE _REG_ECTYPE
#define REG_EESCAPE _REG_EESCAPE
#define REG_ESUBREG _REG_ESUBREG
#define REG_EBRACK _REG_EBRACK
#define REG_EPAREN _REG_EPAREN
#define REG_EBRACE _REG_EBRACE
#define REG_BADBR _REG_BADBR
#define REG_ERANGE _REG_ERANGE
#define REG_ESPACE _REG_ESPACE
#define REG_BADRPT _REG_BADRPT
#define REG_EEND _REG_EEND
#define REG_ESIZE _REG_ESIZE
#define REG_ERPAREN _REG_ERPAREN
/* This data structure represents a compiled pattern. Before calling
the pattern compiler, the fields 'buffer', 'allocated', 'fastmap',
and 'translate' can be set. After the pattern has been compiled,
the fields 're_nsub', 'not_bol' and 'not_eol' are available. All
other fields are private to the regex routines. */
#ifndef RE_TRANSLATE_TYPE
# define __RE_TRANSLATE_TYPE unsigned char *
# ifdef __USE_GNU
# define RE_TRANSLATE_TYPE __RE_TRANSLATE_TYPE
# endif
#endif
#ifdef __USE_GNU
# define __REPB_PREFIX(name) name
#else
# define __REPB_PREFIX(name) __##name
#endif
struct re_pattern_buffer
{
/* Space that holds the compiled pattern. The type
'struct re_dfa_t' is private and is not declared here. */
struct re_dfa_t *__REPB_PREFIX(buffer);
/* Number of bytes to which 'buffer' points. */
__re_long_size_t __REPB_PREFIX(allocated);
/* Number of bytes actually used in 'buffer'. */
__re_long_size_t __REPB_PREFIX(used);
/* Syntax setting with which the pattern was compiled. */
reg_syntax_t __REPB_PREFIX(syntax);
/* Pointer to a fastmap, if any, otherwise zero. re_search uses the
fastmap, if there is one, to skip over impossible starting points
for matches. */
char *__REPB_PREFIX(fastmap);
/* Either a translate table to apply to all characters before
comparing them, or zero for no translation. The translation is
applied to a pattern when it is compiled and to a string when it
is matched. */
__RE_TRANSLATE_TYPE __REPB_PREFIX(translate);
/* Number of subexpressions found by the compiler. */
size_t re_nsub;
/* Zero if this pattern cannot match the empty string, one else.
Well, in truth it's used only in 're_search_2', to see whether or
not we should use the fastmap, so we don't set this absolutely
perfectly; see 're_compile_fastmap' (the "duplicate" case). */
unsigned __REPB_PREFIX(can_be_null) : 1;
/* If REGS_UNALLOCATED, allocate space in the 'regs' structure
for 'max (RE_NREGS, re_nsub + 1)' groups.
If REGS_REALLOCATE, reallocate space if necessary.
If REGS_FIXED, use what's there. */
#ifdef __USE_GNU
# define REGS_UNALLOCATED 0
# define REGS_REALLOCATE 1
# define REGS_FIXED 2
#endif
unsigned __REPB_PREFIX(regs_allocated) : 2;
/* Set to zero when 're_compile_pattern' compiles a pattern; set to
one by 're_compile_fastmap' if it updates the fastmap. */
unsigned __REPB_PREFIX(fastmap_accurate) : 1;
/* If set, 're_match_2' does not return information about
subexpressions. */
unsigned __REPB_PREFIX(no_sub) : 1;
/* If set, a beginning-of-line anchor doesn't match at the beginning
of the string. */
unsigned __REPB_PREFIX(not_bol) : 1;
/* Similarly for an end-of-line anchor. */
unsigned __REPB_PREFIX(not_eol) : 1;
/* If true, an anchor at a newline matches. */
unsigned __REPB_PREFIX(newline_anchor) : 1;
};
typedef struct re_pattern_buffer regex_t;
/* Type for byte offsets within the string. POSIX mandates this. */
#ifdef _REGEX_LARGE_OFFSETS
/* POSIX 1003.1-2008 requires that regoff_t be at least as wide as
ptrdiff_t and ssize_t. We don't know of any hosts where ptrdiff_t
is wider than ssize_t, so ssize_t is safe. ptrdiff_t is not
visible here, so use ssize_t. */
typedef ssize_t regoff_t;
#else
/* The traditional GNU regex implementation mishandles strings longer
than INT_MAX. */
typedef int regoff_t;
#endif
#ifdef __USE_GNU
/* This is the structure we store register match data in. See
regex.texinfo for a full description of what registers match. */
struct re_registers
{
__re_size_t num_regs;
regoff_t *start;
regoff_t *end;
};
/* If 'regs_allocated' is REGS_UNALLOCATED in the pattern buffer,
're_match_2' returns information about at least this many registers
the first time a 'regs' structure is passed. */
# ifndef RE_NREGS
# define RE_NREGS 30
# endif
#endif
/* POSIX specification for registers. Aside from the different names than
're_registers', POSIX uses an array of structures, instead of a
structure of arrays. */
typedef struct
{
regoff_t rm_so; /* Byte offset from string's start to substring's start. */
regoff_t rm_eo; /* Byte offset from string's start to substring's end. */
} regmatch_t;
/* Declarations for routines. */
#ifdef __USE_GNU
/* Sets the current default syntax to SYNTAX, and return the old syntax.
You can also simply assign to the 're_syntax_options' variable. */
extern reg_syntax_t re_set_syntax (reg_syntax_t __syntax);
/* Compile the regular expression PATTERN, with length LENGTH
and syntax given by the global 're_syntax_options', into the buffer
BUFFER. Return NULL if successful, and an error string if not.
To free the allocated storage, you must call 'regfree' on BUFFER.
Note that the translate table must either have been initialized by
'regcomp', with a malloc'ed value, or set to NULL before calling
'regfree'. */
extern const char *re_compile_pattern (const char *__pattern, size_t __length,
struct re_pattern_buffer *__buffer);
/* Compile a fastmap for the compiled pattern in BUFFER; used to
accelerate searches. Return 0 if successful and -2 if was an
internal error. */
extern int re_compile_fastmap (struct re_pattern_buffer *__buffer);
/* Search in the string STRING (with length LENGTH) for the pattern
compiled into BUFFER. Start searching at position START, for RANGE
characters. Return the starting position of the match, -1 for no
match, or -2 for an internal error. Also return register
information in REGS (if REGS and BUFFER->no_sub are nonzero). */
extern regoff_t re_search (struct re_pattern_buffer *__buffer,
const char *__String, regoff_t __length,
regoff_t __start, regoff_t __range,
struct re_registers *__regs);
/* Like 're_search', but search in the concatenation of STRING1 and
STRING2. Also, stop searching at index START + STOP. */
extern regoff_t re_search_2 (struct re_pattern_buffer *__buffer,
const char *__string1, regoff_t __length1,
const char *__string2, regoff_t __length2,
regoff_t __start, regoff_t __range,
struct re_registers *__regs,
regoff_t __stop);
/* Like 're_search', but return how many characters in STRING the regexp
in BUFFER matched, starting at position START. */
extern regoff_t re_match (struct re_pattern_buffer *__buffer,
const char *__String, regoff_t __length,
regoff_t __start, struct re_registers *__regs);
/* Relates to 're_match' as 're_search_2' relates to 're_search'. */
extern regoff_t re_match_2 (struct re_pattern_buffer *__buffer,
const char *__string1, regoff_t __length1,
const char *__string2, regoff_t __length2,
regoff_t __start, struct re_registers *__regs,
regoff_t __stop);
/* Set REGS to hold NUM_REGS registers, storing them in STARTS and
ENDS. Subsequent matches using BUFFER and REGS will use this memory
for recording register information. STARTS and ENDS must be
allocated with malloc, and must each be at least 'NUM_REGS * sizeof
(regoff_t)' bytes long.
If NUM_REGS == 0, then subsequent matches should allocate their own
register data.
Unless this function is called, the first search or match using
BUFFER will allocate its own register data, without
freeing the old data. */
extern void re_set_registers (struct re_pattern_buffer *__buffer,
struct re_registers *__regs,
__re_size_t __num_regs,
regoff_t *__starts, regoff_t *__ends);
#endif /* Use GNU */
#if defined _REGEX_RE_COMP || (defined _LIBC && defined __USE_MISC)
# ifndef _CRAY
/* 4.2 bsd compatibility. */
extern char *re_comp (const char *);
extern int re_exec (const char *);
# endif
#endif
/* For plain 'restrict', use glibc's __restrict if defined.
Otherwise, GCC 2.95 and later have "__restrict"; C99 compilers have
"restrict", and "configure" may have defined "restrict".
Other compilers use __restrict, __restrict__, and _Restrict, and
'configure' might #define 'restrict' to those words, so pick a
different name. */
#ifndef _Restrict_
# if defined __restrict || 2 < __GNUC__ + (95 <= __GNUC_MINOR__)
# define _Restrict_ __restrict
# elif 199901L <= __STDC_VERSION__ || defined restrict
# define _Restrict_ restrict
# else
# define _Restrict_
# endif
#endif
/* For [restrict], use glibc's __restrict_arr if available.
Otherwise, GCC 3.1 (not in C++ mode) and C99 support [restrict]. */
#ifndef _Restrict_arr_
# ifdef __restrict_arr
# define _Restrict_arr_ __restrict_arr
# elif ((199901L <= __STDC_VERSION__ || 3 < __GNUC__ + (1 <= __GNUC_MINOR__)) \
&& !defined __GNUG__)
# define _Restrict_arr_ _Restrict_
# else
# define _Restrict_arr_
# endif
#endif
/* POSIX compatibility. */
extern int regcomp (regex_t *_Restrict_ __preg,
const char *_Restrict_ __pattern,
int __cflags);
extern int regexec (const regex_t *_Restrict_ __preg,
const char *_Restrict_ __String, size_t __nmatch,
regmatch_t __pmatch[_Restrict_arr_],
int __eflags);
extern size_t regerror (int __errcode, const regex_t *_Restrict_ __preg,
char *_Restrict_ __errbuf, size_t __errbuf_size);
extern void regfree (regex_t *__preg);
#ifdef __cplusplus
}
#endif /* C++ */
#endif /* regex.h */

1740
lib/regex_internal.c Normal file
View file

File diff suppressed because it is too large Load diff

911
lib/regex_internal.h Normal file
View file

@ -0,0 +1,911 @@
/* Extended regular expression matching and search library.
Copyright (C) 2002-2018 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
The GNU C Library 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.
The GNU C Library 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 the GNU C Library; if not, see
<https://www.gnu.org/licenses/>. */
#ifndef _REGEX_INTERNAL_H
#define _REGEX_INTERNAL_H 1
#include <assert.h>
#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <langinfo.h>
#include <locale.h>
#include <wchar.h>
#include <wctype.h>
#include <stdbool.h>
#include <stdint.h>
/* Properties of integers. Although Gnulib has intprops.h, glibc does
without for now. */
#ifndef _LIBC
# include "intprops.h"
#else
/* True if the real type T is signed. */
# define TYPE_SIGNED(t) (! ((t) 0 < (t) -1))
/* True if adding the nonnegative Idx values A and B would overflow.
If false, set *R to A + B. A, B, and R may be evaluated more than
once, or zero times. Although this is not a full implementation of
Gnulib INT_ADD_WRAPV, it is good enough for glibc regex code.
FIXME: This implementation is a fragile stopgap, and this file would
be simpler and more robust if intprops.h were migrated into glibc. */
# define INT_ADD_WRAPV(a, b, r) \
(IDX_MAX - (a) < (b) ? true : (*(r) = (a) + (b), false))
#endif
#ifdef _LIBC
# include <libc-lock.h>
# define lock_define(name) __libc_lock_define (, name)
# define lock_init(lock) (__libc_lock_init (lock), 0)
# define lock_fini(lock) ((void) 0)
# define lock_lock(lock) __libc_lock_lock (lock)
# define lock_unlock(lock) __libc_lock_unlock (lock)
#elif defined GNULIB_LOCK && !defined USE_UNLOCKED_IO
# include "glthread/lock.h"
/* Use gl_lock_define if empty macro arguments are known to work.
Otherwise, fall back on less-portable substitutes. */
# if ((defined __GNUC__ && !defined __STRICT_ANSI__) \
|| (defined __STDC_VERSION__ && 199901L <= __STDC_VERSION__))
# define lock_define(name) gl_lock_define (, name)
# elif USE_POSIX_THREADS
# define lock_define(name) pthread_mutex_t name;
# elif USE_PTH_THREADS
# define lock_define(name) pth_mutex_t name;
# elif USE_SOLARIS_THREADS
# define lock_define(name) mutex_t name;
# elif USE_WINDOWS_THREADS
# define lock_define(name) gl_lock_t name;
# else
# define lock_define(name)
# endif
# define lock_init(lock) glthread_lock_init (&(lock))
# define lock_fini(lock) glthread_lock_destroy (&(lock))
# define lock_lock(lock) glthread_lock_lock (&(lock))
# define lock_unlock(lock) glthread_lock_unlock (&(lock))
#elif defined GNULIB_PTHREAD && !defined USE_UNLOCKED_IO
# include <pthread.h>
# define lock_define(name) pthread_mutex_t name;
# define lock_init(lock) pthread_mutex_init (&(lock), 0)
# define lock_fini(lock) pthread_mutex_destroy (&(lock))
# define lock_lock(lock) pthread_mutex_lock (&(lock))
# define lock_unlock(lock) pthread_mutex_unlock (&(lock))
#else
# define lock_define(name)
# define lock_init(lock) 0
# define lock_fini(lock) ((void) 0)
/* The 'dfa' avoids an "unused variable 'dfa'" warning from GCC. */
# define lock_lock(lock) ((void) dfa)
# define lock_unlock(lock) ((void) 0)
#endif
/* In case that the system doesn't have isblank(). */
#if !defined _LIBC && ! (defined isblank || (HAVE_ISBLANK && HAVE_DECL_ISBLANK))
# define isblank(ch) ((ch) == ' ' || (ch) == '\t')
#endif
#ifdef _LIBC
# ifndef _RE_DEFINE_LOCALE_FUNCTIONS
# define _RE_DEFINE_LOCALE_FUNCTIONS 1
# include <locale/localeinfo.h>
# include <locale/coll-lookup.h>
# endif
#endif
/* This is for other GNU distributions with internationalized messages. */
#if (HAVE_LIBINTL_H && ENABLE_NLS) || defined _LIBC
# include <libintl.h>
# ifdef _LIBC
# undef gettext
# define gettext(msgid) \
__dcgettext (_libc_intl_domainname, msgid, LC_MESSAGES)
# endif
#else
# undef gettext
# define gettext(msgid) (msgid)
#endif
#ifndef gettext_noop
/* This define is so xgettext can find the internationalizable
strings. */
# define gettext_noop(String) String
#endif
#if (defined MB_CUR_MAX && HAVE_WCTYPE_H && HAVE_ISWCTYPE) || _LIBC
# define RE_ENABLE_I18N
#endif
#define BE(expr, val) __builtin_expect (expr, val)
/* Number of ASCII characters. */
#define ASCII_CHARS 0x80
/* Number of single byte characters. */
#define SBC_MAX (UCHAR_MAX + 1)
#define COLL_ELEM_LEN_MAX 8
/* The character which represents newline. */
#define NEWLINE_CHAR '\n'
#define WIDE_NEWLINE_CHAR L'\n'
/* Rename to standard API for using out of glibc. */
#ifndef _LIBC
# undef __wctype
# undef __iswctype
# define __wctype wctype
# define __iswalnum iswalnum
# define __iswctype iswctype
# define __towlower towlower
# define __towupper towupper
# define __btowc btowc
# define __mbrtowc mbrtowc
# define __wcrtomb wcrtomb
# define __regfree regfree
# define attribute_hidden
#endif /* not _LIBC */
#if __GNUC__ < 3 + (__GNUC_MINOR__ < 1)
# define __attribute__(arg)
#endif
#ifndef SSIZE_MAX
# define SSIZE_MAX ((ssize_t) (SIZE_MAX / 2))
#endif
/* The type of indexes into strings. This is signed, not size_t,
since the API requires indexes to fit in regoff_t anyway, and using
signed integers makes the code a bit smaller and presumably faster.
The traditional GNU regex implementation uses int for indexes.
The POSIX-compatible implementation uses a possibly-wider type.
The name 'Idx' is three letters to minimize the hassle of
reindenting a lot of regex code that formerly used 'int'. */
typedef regoff_t Idx;
#ifdef _REGEX_LARGE_OFFSETS
# define IDX_MAX SSIZE_MAX
#else
# define IDX_MAX INT_MAX
#endif
/* A hash value, suitable for computing hash tables. */
typedef __re_size_t re_hashval_t;
/* An integer used to represent a set of bits. It must be unsigned,
and must be at least as wide as unsigned int. */
typedef unsigned long int bitset_word_t;
/* All bits set in a bitset_word_t. */
#define BITSET_WORD_MAX ULONG_MAX
/* Number of bits in a bitset_word_t. For portability to hosts with
padding bits, do not use '(sizeof (bitset_word_t) * CHAR_BIT)';
instead, deduce it directly from BITSET_WORD_MAX. Avoid
greater-than-32-bit integers and unconditional shifts by more than
31 bits, as they're not portable. */
#if BITSET_WORD_MAX == 0xffffffffUL
# define BITSET_WORD_BITS 32
#elif BITSET_WORD_MAX >> 31 >> 4 == 1
# define BITSET_WORD_BITS 36
#elif BITSET_WORD_MAX >> 31 >> 16 == 1
# define BITSET_WORD_BITS 48
#elif BITSET_WORD_MAX >> 31 >> 28 == 1
# define BITSET_WORD_BITS 60
#elif BITSET_WORD_MAX >> 31 >> 31 >> 1 == 1
# define BITSET_WORD_BITS 64
#elif BITSET_WORD_MAX >> 31 >> 31 >> 9 == 1
# define BITSET_WORD_BITS 72
#elif BITSET_WORD_MAX >> 31 >> 31 >> 31 >> 31 >> 3 == 1
# define BITSET_WORD_BITS 128
#elif BITSET_WORD_MAX >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 7 == 1
# define BITSET_WORD_BITS 256
#elif BITSET_WORD_MAX >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 7 > 1
# define BITSET_WORD_BITS 257 /* any value > SBC_MAX will do here */
# if BITSET_WORD_BITS <= SBC_MAX
# error "Invalid SBC_MAX"
# endif
#else
# error "Add case for new bitset_word_t size"
#endif
/* Number of bitset_word_t values in a bitset_t. */
#define BITSET_WORDS ((SBC_MAX + BITSET_WORD_BITS - 1) / BITSET_WORD_BITS)
typedef bitset_word_t bitset_t[BITSET_WORDS];
typedef bitset_word_t *re_bitset_ptr_t;
typedef const bitset_word_t *re_const_bitset_ptr_t;
#define PREV_WORD_CONSTRAINT 0x0001
#define PREV_NOTWORD_CONSTRAINT 0x0002
#define NEXT_WORD_CONSTRAINT 0x0004
#define NEXT_NOTWORD_CONSTRAINT 0x0008
#define PREV_NEWLINE_CONSTRAINT 0x0010
#define NEXT_NEWLINE_CONSTRAINT 0x0020
#define PREV_BEGBUF_CONSTRAINT 0x0040
#define NEXT_ENDBUF_CONSTRAINT 0x0080
#define WORD_DELIM_CONSTRAINT 0x0100
#define NOT_WORD_DELIM_CONSTRAINT 0x0200
typedef enum
{
INSIDE_WORD = PREV_WORD_CONSTRAINT | NEXT_WORD_CONSTRAINT,
WORD_FIRST = PREV_NOTWORD_CONSTRAINT | NEXT_WORD_CONSTRAINT,
WORD_LAST = PREV_WORD_CONSTRAINT | NEXT_NOTWORD_CONSTRAINT,
INSIDE_NOTWORD = PREV_NOTWORD_CONSTRAINT | NEXT_NOTWORD_CONSTRAINT,
LINE_FIRST = PREV_NEWLINE_CONSTRAINT,
LINE_LAST = NEXT_NEWLINE_CONSTRAINT,
BUF_FIRST = PREV_BEGBUF_CONSTRAINT,
BUF_LAST = NEXT_ENDBUF_CONSTRAINT,
WORD_DELIM = WORD_DELIM_CONSTRAINT,
NOT_WORD_DELIM = NOT_WORD_DELIM_CONSTRAINT
} re_context_type;
typedef struct
{
Idx alloc;
Idx nelem;
Idx *elems;
} re_node_set;
typedef enum
{
NON_TYPE = 0,
/* Node type, These are used by token, node, tree. */
CHARACTER = 1,
END_OF_RE = 2,
SIMPLE_BRACKET = 3,
OP_BACK_REF = 4,
OP_PERIOD = 5,
#ifdef RE_ENABLE_I18N
COMPLEX_BRACKET = 6,
OP_UTF8_PERIOD = 7,
#endif /* RE_ENABLE_I18N */
/* We define EPSILON_BIT as a macro so that OP_OPEN_SUBEXP is used
when the debugger shows values of this enum type. */
#define EPSILON_BIT 8
OP_OPEN_SUBEXP = EPSILON_BIT | 0,
OP_CLOSE_SUBEXP = EPSILON_BIT | 1,
OP_ALT = EPSILON_BIT | 2,
OP_DUP_ASTERISK = EPSILON_BIT | 3,
ANCHOR = EPSILON_BIT | 4,
/* Tree type, these are used only by tree. */
CONCAT = 16,
SUBEXP = 17,
/* Token type, these are used only by token. */
OP_DUP_PLUS = 18,
OP_DUP_QUESTION,
OP_OPEN_BRACKET,
OP_CLOSE_BRACKET,
OP_CHARSET_RANGE,
OP_OPEN_DUP_NUM,
OP_CLOSE_DUP_NUM,
OP_NON_MATCH_LIST,
OP_OPEN_COLL_ELEM,
OP_CLOSE_COLL_ELEM,
OP_OPEN_EQUIV_CLASS,
OP_CLOSE_EQUIV_CLASS,
OP_OPEN_CHAR_CLASS,
OP_CLOSE_CHAR_CLASS,
OP_WORD,
OP_NOTWORD,
OP_SPACE,
OP_NOTSPACE,
BACK_SLASH
} re_token_type_t;
#ifdef RE_ENABLE_I18N
typedef struct
{
/* Multibyte characters. */
wchar_t *mbchars;
/* Collating symbols. */
# ifdef _LIBC
int32_t *coll_syms;
# endif
/* Equivalence classes. */
# ifdef _LIBC
int32_t *equiv_classes;
# endif
/* Range expressions. */
# ifdef _LIBC
uint32_t *range_starts;
uint32_t *range_ends;
# else /* not _LIBC */
wchar_t *range_starts;
wchar_t *range_ends;
# endif /* not _LIBC */
/* Character classes. */
wctype_t *char_classes;
/* If this character set is the non-matching list. */
unsigned int non_match : 1;
/* # of multibyte characters. */
Idx nmbchars;
/* # of collating symbols. */
Idx ncoll_syms;
/* # of equivalence classes. */
Idx nequiv_classes;
/* # of range expressions. */
Idx nranges;
/* # of character classes. */
Idx nchar_classes;
} re_charset_t;
#endif /* RE_ENABLE_I18N */
typedef struct
{
union
{
unsigned char c; /* for CHARACTER */
re_bitset_ptr_t sbcset; /* for SIMPLE_BRACKET */
#ifdef RE_ENABLE_I18N
re_charset_t *mbcset; /* for COMPLEX_BRACKET */
#endif /* RE_ENABLE_I18N */
Idx idx; /* for BACK_REF */
re_context_type ctx_type; /* for ANCHOR */
} opr;
#if __GNUC__ >= 2 && !defined __STRICT_ANSI__
re_token_type_t type : 8;
#else
re_token_type_t type;
#endif
unsigned int constraint : 10; /* context constraint */
unsigned int duplicated : 1;
unsigned int opt_subexp : 1;
#ifdef RE_ENABLE_I18N
unsigned int accept_mb : 1;
/* These 2 bits can be moved into the union if needed (e.g. if running out
of bits; move opr.c to opr.c.c and move the flags to opr.c.flags). */
unsigned int mb_partial : 1;
#endif
unsigned int word_char : 1;
} re_token_t;
#define IS_EPSILON_NODE(type) ((type) & EPSILON_BIT)
struct re_string_t
{
/* Indicate the raw buffer which is the original string passed as an
argument of regexec(), re_search(), etc.. */
const unsigned char *raw_mbs;
/* Store the multibyte string. In case of "case insensitive mode" like
REG_ICASE, upper cases of the string are stored, otherwise MBS points
the same address that RAW_MBS points. */
unsigned char *mbs;
#ifdef RE_ENABLE_I18N
/* Store the wide character string which is corresponding to MBS. */
wint_t *wcs;
Idx *offsets;
mbstate_t cur_state;
#endif
/* Index in RAW_MBS. Each character mbs[i] corresponds to
raw_mbs[raw_mbs_idx + i]. */
Idx raw_mbs_idx;
/* The length of the valid characters in the buffers. */
Idx valid_len;
/* The corresponding number of bytes in raw_mbs array. */
Idx valid_raw_len;
/* The length of the buffers MBS and WCS. */
Idx bufs_len;
/* The index in MBS, which is updated by re_string_fetch_byte. */
Idx cur_idx;
/* length of RAW_MBS array. */
Idx raw_len;
/* This is RAW_LEN - RAW_MBS_IDX + VALID_LEN - VALID_RAW_LEN. */
Idx len;
/* End of the buffer may be shorter than its length in the cases such
as re_match_2, re_search_2. Then, we use STOP for end of the buffer
instead of LEN. */
Idx raw_stop;
/* This is RAW_STOP - RAW_MBS_IDX adjusted through OFFSETS. */
Idx stop;
/* The context of mbs[0]. We store the context independently, since
the context of mbs[0] may be different from raw_mbs[0], which is
the beginning of the input string. */
unsigned int tip_context;
/* The translation passed as a part of an argument of re_compile_pattern. */
RE_TRANSLATE_TYPE trans;
/* Copy of re_dfa_t's word_char. */
re_const_bitset_ptr_t word_char;
/* true if REG_ICASE. */
unsigned char icase;
unsigned char is_utf8;
unsigned char map_notascii;
unsigned char mbs_allocated;
unsigned char offsets_needed;
unsigned char newline_anchor;
unsigned char word_ops_used;
int mb_cur_max;
};
typedef struct re_string_t re_string_t;
struct re_dfa_t;
typedef struct re_dfa_t re_dfa_t;
#ifndef _LIBC
# define IS_IN(libc) false
#endif
#define re_string_peek_byte(pstr, offset) \
((pstr)->mbs[(pstr)->cur_idx + offset])
#define re_string_fetch_byte(pstr) \
((pstr)->mbs[(pstr)->cur_idx++])
#define re_string_first_byte(pstr, idx) \
((idx) == (pstr)->valid_len || (pstr)->wcs[idx] != WEOF)
#define re_string_is_single_byte_char(pstr, idx) \
((pstr)->wcs[idx] != WEOF && ((pstr)->valid_len == (idx) + 1 \
|| (pstr)->wcs[(idx) + 1] != WEOF))
#define re_string_eoi(pstr) ((pstr)->stop <= (pstr)->cur_idx)
#define re_string_cur_idx(pstr) ((pstr)->cur_idx)
#define re_string_get_buffer(pstr) ((pstr)->mbs)
#define re_string_length(pstr) ((pstr)->len)
#define re_string_byte_at(pstr,idx) ((pstr)->mbs[idx])
#define re_string_skip_bytes(pstr,idx) ((pstr)->cur_idx += (idx))
#define re_string_set_index(pstr,idx) ((pstr)->cur_idx = (idx))
#if defined _LIBC || HAVE_ALLOCA
# include <alloca.h>
#endif
#ifndef _LIBC
# if HAVE_ALLOCA
/* The OS usually guarantees only one guard page at the bottom of the stack,
and a page size can be as small as 4096 bytes. So we cannot safely
allocate anything larger than 4096 bytes. Also care for the possibility
of a few compiler-allocated temporary stack slots. */
# define __libc_use_alloca(n) ((n) < 4032)
# else
/* alloca is implemented with malloc, so just use malloc. */
# define __libc_use_alloca(n) 0
# undef alloca
# define alloca(n) malloc (n)
# endif
#endif
#ifdef _LIBC
# define MALLOC_0_IS_NONNULL 1
#elif !defined MALLOC_0_IS_NONNULL
# define MALLOC_0_IS_NONNULL 0
#endif
#ifndef MAX
# define MAX(a,b) ((a) < (b) ? (b) : (a))
#endif
#ifndef MIN
# define MIN(a,b) ((a) < (b) ? (a) : (b))
#endif
#define re_malloc(t,n) ((t *) malloc ((n) * sizeof (t)))
#define re_realloc(p,t,n) ((t *) realloc (p, (n) * sizeof (t)))
#define re_free(p) free (p)
struct bin_tree_t
{
struct bin_tree_t *parent;
struct bin_tree_t *left;
struct bin_tree_t *right;
struct bin_tree_t *first;
struct bin_tree_t *next;
re_token_t token;
/* 'node_idx' is the index in dfa->nodes, if 'type' == 0.
Otherwise 'type' indicate the type of this node. */
Idx node_idx;
};
typedef struct bin_tree_t bin_tree_t;
#define BIN_TREE_STORAGE_SIZE \
((1024 - sizeof (void *)) / sizeof (bin_tree_t))
struct bin_tree_storage_t
{
struct bin_tree_storage_t *next;
bin_tree_t data[BIN_TREE_STORAGE_SIZE];
};
typedef struct bin_tree_storage_t bin_tree_storage_t;
#define CONTEXT_WORD 1
#define CONTEXT_NEWLINE (CONTEXT_WORD << 1)
#define CONTEXT_BEGBUF (CONTEXT_NEWLINE << 1)
#define CONTEXT_ENDBUF (CONTEXT_BEGBUF << 1)
#define IS_WORD_CONTEXT(c) ((c) & CONTEXT_WORD)
#define IS_NEWLINE_CONTEXT(c) ((c) & CONTEXT_NEWLINE)
#define IS_BEGBUF_CONTEXT(c) ((c) & CONTEXT_BEGBUF)
#define IS_ENDBUF_CONTEXT(c) ((c) & CONTEXT_ENDBUF)
#define IS_ORDINARY_CONTEXT(c) ((c) == 0)
#define IS_WORD_CHAR(ch) (isalnum (ch) || (ch) == '_')
#define IS_NEWLINE(ch) ((ch) == NEWLINE_CHAR)
#define IS_WIDE_WORD_CHAR(ch) (__iswalnum (ch) || (ch) == L'_')
#define IS_WIDE_NEWLINE(ch) ((ch) == WIDE_NEWLINE_CHAR)
#define NOT_SATISFY_PREV_CONSTRAINT(constraint,context) \
((((constraint) & PREV_WORD_CONSTRAINT) && !IS_WORD_CONTEXT (context)) \
|| ((constraint & PREV_NOTWORD_CONSTRAINT) && IS_WORD_CONTEXT (context)) \
|| ((constraint & PREV_NEWLINE_CONSTRAINT) && !IS_NEWLINE_CONTEXT (context))\
|| ((constraint & PREV_BEGBUF_CONSTRAINT) && !IS_BEGBUF_CONTEXT (context)))
#define NOT_SATISFY_NEXT_CONSTRAINT(constraint,context) \
((((constraint) & NEXT_WORD_CONSTRAINT) && !IS_WORD_CONTEXT (context)) \
|| (((constraint) & NEXT_NOTWORD_CONSTRAINT) && IS_WORD_CONTEXT (context)) \
|| (((constraint) & NEXT_NEWLINE_CONSTRAINT) && !IS_NEWLINE_CONTEXT (context)) \
|| (((constraint) & NEXT_ENDBUF_CONSTRAINT) && !IS_ENDBUF_CONTEXT (context)))
struct re_dfastate_t
{
re_hashval_t hash;
re_node_set nodes;
re_node_set non_eps_nodes;
re_node_set inveclosure;
re_node_set *entrance_nodes;
struct re_dfastate_t **trtable, **word_trtable;
unsigned int context : 4;
unsigned int halt : 1;
/* If this state can accept "multi byte".
Note that we refer to multibyte characters, and multi character
collating elements as "multi byte". */
unsigned int accept_mb : 1;
/* If this state has backreference node(s). */
unsigned int has_backref : 1;
unsigned int has_constraint : 1;
};
typedef struct re_dfastate_t re_dfastate_t;
struct re_state_table_entry
{
Idx num;
Idx alloc;
re_dfastate_t **array;
};
/* Array type used in re_sub_match_last_t and re_sub_match_top_t. */
typedef struct
{
Idx next_idx;
Idx alloc;
re_dfastate_t **array;
} state_array_t;
/* Store information about the node NODE whose type is OP_CLOSE_SUBEXP. */
typedef struct
{
Idx node;
Idx str_idx; /* The position NODE match at. */
state_array_t path;
} re_sub_match_last_t;
/* Store information about the node NODE whose type is OP_OPEN_SUBEXP.
And information about the node, whose type is OP_CLOSE_SUBEXP,
corresponding to NODE is stored in LASTS. */
typedef struct
{
Idx str_idx;
Idx node;
state_array_t *path;
Idx alasts; /* Allocation size of LASTS. */
Idx nlasts; /* The number of LASTS. */
re_sub_match_last_t **lasts;
} re_sub_match_top_t;
struct re_backref_cache_entry
{
Idx node;
Idx str_idx;
Idx subexp_from;
Idx subexp_to;
char more;
char unused;
unsigned short int eps_reachable_subexps_map;
};
typedef struct
{
/* The string object corresponding to the input string. */
re_string_t input;
#if defined _LIBC || (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L)
const re_dfa_t *const dfa;
#else
const re_dfa_t *dfa;
#endif
/* EFLAGS of the argument of regexec. */
int eflags;
/* Where the matching ends. */
Idx match_last;
Idx last_node;
/* The state log used by the matcher. */
re_dfastate_t **state_log;
Idx state_log_top;
/* Back reference cache. */
Idx nbkref_ents;
Idx abkref_ents;
struct re_backref_cache_entry *bkref_ents;
int max_mb_elem_len;
Idx nsub_tops;
Idx asub_tops;
re_sub_match_top_t **sub_tops;
} re_match_context_t;
typedef struct
{
re_dfastate_t **sifted_states;
re_dfastate_t **limited_states;
Idx last_node;
Idx last_str_idx;
re_node_set limits;
} re_sift_context_t;
struct re_fail_stack_ent_t
{
Idx idx;
Idx node;
regmatch_t *regs;
re_node_set eps_via_nodes;
};
struct re_fail_stack_t
{
Idx num;
Idx alloc;
struct re_fail_stack_ent_t *stack;
};
struct re_dfa_t
{
re_token_t *nodes;
size_t nodes_alloc;
size_t nodes_len;
Idx *nexts;
Idx *org_indices;
re_node_set *edests;
re_node_set *eclosures;
re_node_set *inveclosures;
struct re_state_table_entry *state_table;
re_dfastate_t *init_state;
re_dfastate_t *init_state_word;
re_dfastate_t *init_state_nl;
re_dfastate_t *init_state_begbuf;
bin_tree_t *str_tree;
bin_tree_storage_t *str_tree_storage;
re_bitset_ptr_t sb_char;
int str_tree_storage_idx;
/* number of subexpressions 're_nsub' is in regex_t. */
re_hashval_t state_hash_mask;
Idx init_node;
Idx nbackref; /* The number of backreference in this dfa. */
/* Bitmap expressing which backreference is used. */
bitset_word_t used_bkref_map;
bitset_word_t completed_bkref_map;
unsigned int has_plural_match : 1;
/* If this dfa has "multibyte node", which is a backreference or
a node which can accept multibyte character or multi character
collating element. */
unsigned int has_mb_node : 1;
unsigned int is_utf8 : 1;
unsigned int map_notascii : 1;
unsigned int word_ops_used : 1;
int mb_cur_max;
bitset_t word_char;
reg_syntax_t syntax;
Idx *subexp_map;
#ifdef DEBUG
char* re_str;
#endif
lock_define (lock)
};
#define re_node_set_init_empty(set) memset (set, '\0', sizeof (re_node_set))
#define re_node_set_remove(set,id) \
(re_node_set_remove_at (set, re_node_set_contains (set, id) - 1))
#define re_node_set_empty(p) ((p)->nelem = 0)
#define re_node_set_free(set) re_free ((set)->elems)
typedef enum
{
SB_CHAR,
MB_CHAR,
EQUIV_CLASS,
COLL_SYM,
CHAR_CLASS
} bracket_elem_type;
typedef struct
{
bracket_elem_type type;
union
{
unsigned char ch;
unsigned char *name;
wchar_t wch;
} opr;
} bracket_elem_t;
/* Functions for bitset_t operation. */
static inline void
bitset_set (bitset_t set, Idx i)
{
set[i / BITSET_WORD_BITS] |= (bitset_word_t) 1 << i % BITSET_WORD_BITS;
}
static inline void
bitset_clear (bitset_t set, Idx i)
{
set[i / BITSET_WORD_BITS] &= ~ ((bitset_word_t) 1 << i % BITSET_WORD_BITS);
}
static inline bool
bitset_contain (const bitset_t set, Idx i)
{
return (set[i / BITSET_WORD_BITS] >> i % BITSET_WORD_BITS) & 1;
}
static inline void
bitset_empty (bitset_t set)
{
memset (set, '\0', sizeof (bitset_t));
}
static inline void
bitset_set_all (bitset_t set)
{
memset (set, -1, sizeof (bitset_word_t) * (SBC_MAX / BITSET_WORD_BITS));
if (SBC_MAX % BITSET_WORD_BITS != 0)
set[BITSET_WORDS - 1] =
((bitset_word_t) 1 << SBC_MAX % BITSET_WORD_BITS) - 1;
}
static inline void
bitset_copy (bitset_t dest, const bitset_t src)
{
memcpy (dest, src, sizeof (bitset_t));
}
static inline void
bitset_not (bitset_t set)
{
int bitset_i;
for (bitset_i = 0; bitset_i < SBC_MAX / BITSET_WORD_BITS; ++bitset_i)
set[bitset_i] = ~set[bitset_i];
if (SBC_MAX % BITSET_WORD_BITS != 0)
set[BITSET_WORDS - 1] =
((((bitset_word_t) 1 << SBC_MAX % BITSET_WORD_BITS) - 1)
& ~set[BITSET_WORDS - 1]);
}
static inline void
bitset_merge (bitset_t dest, const bitset_t src)
{
int bitset_i;
for (bitset_i = 0; bitset_i < BITSET_WORDS; ++bitset_i)
dest[bitset_i] |= src[bitset_i];
}
static inline void
bitset_mask (bitset_t dest, const bitset_t src)
{
int bitset_i;
for (bitset_i = 0; bitset_i < BITSET_WORDS; ++bitset_i)
dest[bitset_i] &= src[bitset_i];
}
#ifdef RE_ENABLE_I18N
/* Functions for re_string. */
static int
__attribute__ ((pure, unused))
re_string_char_size_at (const re_string_t *pstr, Idx idx)
{
int byte_idx;
if (pstr->mb_cur_max == 1)
return 1;
for (byte_idx = 1; idx + byte_idx < pstr->valid_len; ++byte_idx)
if (pstr->wcs[idx + byte_idx] != WEOF)
break;
return byte_idx;
}
static wint_t
__attribute__ ((pure, unused))
re_string_wchar_at (const re_string_t *pstr, Idx idx)
{
if (pstr->mb_cur_max == 1)
return (wint_t) pstr->mbs[idx];
return (wint_t) pstr->wcs[idx];
}
# ifdef _LIBC
# include <locale/weight.h>
# endif
static int
__attribute__ ((pure, unused))
re_string_elem_size_at (const re_string_t *pstr, Idx idx)
{
# ifdef _LIBC
const unsigned char *p, *extra;
const int32_t *table, *indirect;
uint_fast32_t nrules = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES);
if (nrules != 0)
{
table = (const int32_t *) _NL_CURRENT (LC_COLLATE, _NL_COLLATE_TABLEMB);
extra = (const unsigned char *)
_NL_CURRENT (LC_COLLATE, _NL_COLLATE_EXTRAMB);
indirect = (const int32_t *) _NL_CURRENT (LC_COLLATE,
_NL_COLLATE_INDIRECTMB);
p = pstr->mbs + idx;
findidx (table, indirect, extra, &p, pstr->len - idx);
return p - pstr->mbs - idx;
}
else
# endif /* _LIBC */
return 1;
}
#endif /* RE_ENABLE_I18N */
#ifndef __GNUC_PREREQ
# if defined __GNUC__ && defined __GNUC_MINOR__
# define __GNUC_PREREQ(maj, min) \
((__GNUC__ << 16) + __GNUC_MINOR__ >= ((maj) << 16) + (min))
# else
# define __GNUC_PREREQ(maj, min) 0
# endif
#endif
#if __GNUC_PREREQ (3,4)
# undef __attribute_warn_unused_result__
# define __attribute_warn_unused_result__ \
__attribute__ ((__warn_unused_result__))
#else
# define __attribute_warn_unused_result__ /* empty */
#endif
#ifndef FALLTHROUGH
# if __GNUC__ < 7
# define FALLTHROUGH ((void) 0)
# else
# define FALLTHROUGH __attribute__ ((__fallthrough__))
# endif
#endif
#endif /* _REGEX_INTERNAL_H */

4324
lib/regexec.c Normal file
View file

File diff suppressed because it is too large Load diff

4
lib/unistd.in.h
View file

@ -432,12 +432,12 @@ extern char **environ;
#elif defined GNULIB_POSIXCHECK
# if HAVE_RAW_DECL_ENVIRON
_GL_UNISTD_INLINE char ***
_GL_WARN_ON_USE_ATTRIBUTE ("environ is unportable - "
"use gnulib module environ for portability")
rpl_environ (void)
{
return &environ;
}
_GL_WARN_ON_USE (rpl_environ, "environ is unportable - "
"use gnulib module environ for portability");
# undef environ
# define environ (*rpl_environ ())
# endif

64
lib/warn-on-use.h
View file

@ -20,23 +20,32 @@
supported by the compiler. If the compiler does not support this
feature, the macro expands to an unused extern declaration.
This macro is useful for marking a function as a potential
_GL_WARN_ON_USE_ATTRIBUTE ("literal string") expands to the
attribute used in _GL_WARN_ON_USE. If the compiler does not support
this feature, it expands to empty.
These macros are useful for marking a function as a potential
portability trap, with the intent that "literal string" include
instructions on the replacement function that should be used
instead. However, one of the reasons that a function is a
portability trap is if it has the wrong signature. Declaring
FUNCTION with a different signature in C is a compilation error, so
this macro must use the same type as any existing declaration so
that programs that avoid the problematic FUNCTION do not fail to
compile merely because they included a header that poisoned the
function. But this implies that _GL_WARN_ON_USE is only safe to
use if FUNCTION is known to already have a declaration. Use of
this macro implies that there must not be any other macro hiding
the declaration of FUNCTION; but undefining FUNCTION first is part
of the poisoning process anyway (although for symbols that are
provided only via a macro, the result is a compilation error rather
than a warning containing "literal string"). Also note that in
C++, it is only safe to use if FUNCTION has no overloads.
instead.
_GL_WARN_ON_USE is for functions with 'extern' linkage.
_GL_WARN_ON_USE_ATTRIBUTE is for functions with 'static' or 'inline'
linkage.
However, one of the reasons that a function is a portability trap is
if it has the wrong signature. Declaring FUNCTION with a different
signature in C is a compilation error, so this macro must use the
same type as any existing declaration so that programs that avoid
the problematic FUNCTION do not fail to compile merely because they
included a header that poisoned the function. But this implies that
_GL_WARN_ON_USE is only safe to use if FUNCTION is known to already
have a declaration. Use of this macro implies that there must not
be any other macro hiding the declaration of FUNCTION; but
undefining FUNCTION first is part of the poisoning process anyway
(although for symbols that are provided only via a macro, the result
is a compilation error rather than a warning containing
"literal string"). Also note that in C++, it is only safe to use if
FUNCTION has no overloads.
For an example, it is possible to poison 'getline' by:
- adding a call to gl_WARN_ON_USE_PREPARE([[#include <stdio.h>]],
@ -54,12 +63,21 @@
(less common usage, like &environ, will cause a compilation error
rather than issue the nice warning, but the end result of informing
the developer about their portability problem is still achieved):
#if HAVE_RAW_DECL_ENVIRON
static char ***rpl_environ (void) { return &environ; }
_GL_WARN_ON_USE (rpl_environ, "environ is not always properly declared");
# undef environ
# define environ (*rpl_environ ())
#endif
#if HAVE_RAW_DECL_ENVIRON
static char ***
rpl_environ (void) { return &environ; }
_GL_WARN_ON_USE (rpl_environ, "environ is not always properly declared");
# undef environ
# define environ (*rpl_environ ())
#endif
or better (avoiding contradictory use of 'static' and 'extern'):
#if HAVE_RAW_DECL_ENVIRON
static char ***
_GL_WARN_ON_USE_ATTRIBUTE ("environ is not always properly declared")
rpl_environ (void) { return &environ; }
# undef environ
# define environ (*rpl_environ ())
#endif
*/
#ifndef _GL_WARN_ON_USE
@ -67,13 +85,17 @@
/* A compiler attribute is available in gcc versions 4.3.0 and later. */
# define _GL_WARN_ON_USE(function, message) \
extern __typeof__ (function) function __attribute__ ((__warning__ (message)))
# define _GL_WARN_ON_USE_ATTRIBUTE(message) \
__attribute__ ((__warning__ (message)))
# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING
/* Verify the existence of the function. */
# define _GL_WARN_ON_USE(function, message) \
extern __typeof__ (function) function
# define _GL_WARN_ON_USE_ATTRIBUTE(message)
# else /* Unsupported. */
# define _GL_WARN_ON_USE(function, message) \
_GL_WARN_EXTERN_C int _gl_warn_on_use
# define _GL_WARN_ON_USE_ATTRIBUTE(message)
# endif
#endif

2
lisp/auth-source.el
View file

@ -779,7 +779,7 @@ Calls `auth-source-search' with the :delete property in SPEC set to t.
The backend may not actually delete the entries.
Returns the deleted entries."
(auth-source-search (plist-put spec :delete t)))
(apply #'auth-source-search (plist-put spec :delete t)))
(defun auth-source-search-collection (collection value)
"Returns t is VALUE is t or COLLECTION is t or COLLECTION contains VALUE."

7
lisp/bookmark.el
View file

@ -1102,7 +1102,7 @@ BOOKMARK is usually a bookmark name (a string). It can also be a
bookmark record, but this is usually only done by programmatic callers.
If DISPLAY-FUNC is non-nil, it is a function to invoke to display the
bookmark. It defaults to `switch-to-buffer'. A typical value for
bookmark. It defaults to `pop-to-buffer-same-window'. A typical value for
DISPLAY-FUNC would be `switch-to-buffer-other-window'."
(interactive
(list (bookmark-completing-read "Jump to bookmark"
@ -1110,7 +1110,10 @@ DISPLAY-FUNC would be `switch-to-buffer-other-window'."
(unless bookmark
(error "No bookmark specified"))
(bookmark-maybe-historicize-string bookmark)
(bookmark--jump-via bookmark (or display-func 'switch-to-buffer)))
;; Don't use `switch-to-buffer' because it would let the
;; window-point override the bookmark's point when
;; `switch-to-buffer-preserve-window-point' is non-nil.
(bookmark--jump-via bookmark (or display-func 'pop-to-buffer-same-window)))
;;;###autoload

202
lisp/calendar/todo-mode.el
View file

@ -853,17 +853,18 @@ category. With non-nil argument BACK, visit the numerically
previous category (the highest numbered one, if the current
category is the first)."
(interactive)
(setq todo-category-number
(1+ (mod (- todo-category-number (if back 2 0))
(length todo-categories))))
(when todo-skip-archived-categories
(while (and (zerop (todo-get-count 'todo))
(zerop (todo-get-count 'done))
(not (zerop (todo-get-count 'archived))))
(setq todo-category-number
(funcall (if back #'1- #'1+) todo-category-number))))
(todo-category-select)
(goto-char (point-min)))
(let ((setcatnum (lambda () (1+ (mod (- todo-category-number
(if back 2 0))
(length todo-categories))))))
(setq todo-category-number (funcall setcatnum))
(when todo-skip-archived-categories
(while (and (zerop (todo-get-count 'todo))
(zerop (todo-get-count 'done))
(not (zerop (todo-get-count 'archived))))
(setq todo-category-number (funcall setcatnum))))
(todo-category-select)
(if transient-mark-mode (deactivate-mark))
(goto-char (point-min))))
(defun todo-backward-category ()
"Visit the numerically previous category in this todo file.
@ -928,11 +929,13 @@ Categories mode."
(when goto-archive (todo-archive-mode))
(set-window-buffer (selected-window)
(set-buffer (find-buffer-visiting file0)))
(if transient-mark-mode (deactivate-mark))
(unless todo-global-current-todo-file
(setq todo-global-current-todo-file todo-current-todo-file))
(todo-category-number category)
(todo-category-select)
(goto-char (point-min))
(if (bound-and-true-p hl-line-mode) (hl-line-highlight))
(when add-item (todo-insert-item--basic))))))
(defun todo-next-item (&optional count)
@ -1018,15 +1021,17 @@ empty line above the done items separator."
(setq shown (progn
(goto-char (point-min))
(re-search-forward todo-done-string-start nil t)))
(if (not (pos-visible-in-window-p shown))
(recenter)
(goto-char opoint)))))))
(if (pos-visible-in-window-p shown)
(goto-char opoint)
(recenter)
(if transient-mark-mode (deactivate-mark))))))))
(defun todo-toggle-view-done-only ()
"Switch between displaying only done or only todo items."
(interactive)
(setq todo-show-done-only (not todo-show-done-only))
(todo-category-select))
(todo-category-select)
(if transient-mark-mode (deactivate-mark)))
(defun todo-toggle-item-highlighting ()
"Highlight or unhighlight the todo item the cursor is on."
@ -1860,15 +1865,18 @@ their associated keys and their effects."
(region (eq where 'region))
(here (eq where 'here))
diary-item)
(when copy
(cond
((not (eq major-mode 'todo-mode))
(user-error "You must be in Todo mode to copy a todo item"))
((todo-done-item-p)
(user-error "You cannot copy a done item as a new todo item"))
((looking-at "^$")
(user-error "Point must be on a todo item to copy it")))
(setq diary-item (todo-diary-item-p)))
(when (and arg here)
(user-error "Here insertion only valid in current category"))
(when (and (or copy here)
(or (not (eq major-mode 'todo-mode)) (todo-done-item-p)
(when copy (looking-at "^$"))
(save-excursion
(beginning-of-line)
;; Point is on done items separator.
(looking-at todo-category-done))))
(user-error (concat "Item " (if copy "copying" "insertion")
" is not valid here")))
(when copy (setq diary-item (todo-diary-item-p)))
(when region
(let (use-empty-active-region)
(unless (and todo-use-only-highlighted-region (use-region-p))
@ -1876,7 +1884,6 @@ their associated keys and their effects."
(let* ((obuf (current-buffer))
(ocat (todo-current-category))
(opoint (point))
(todo-mm (eq major-mode 'todo-mode))
(cat+file (cond ((equal arg '(4))
(todo-read-category "Insert in category: "))
((equal arg '(16))
@ -1894,7 +1901,10 @@ their associated keys and their effects."
(new-item (cond (copy (todo-item-string))
(region (buffer-substring-no-properties
(region-beginning) (region-end)))
(t (read-from-minibuffer "Todo item: "))))
(t (if (eq major-mode 'todo-archive-mode)
(user-error (concat "Cannot insert a new Todo"
" item in an archive"))
(read-from-minibuffer "Todo item: ")))))
(date-string (cond
((eq date-type 'date)
(todo-read-date))
@ -1931,7 +1941,6 @@ their associated keys and their effects."
(unless todo-global-current-todo-file
(setq todo-global-current-todo-file todo-current-todo-file))
(let ((buffer-read-only nil)
(called-from-outside (not (and todo-mm (equal cat ocat))))
done-only item-added)
(unless copy
(setq new-item
@ -1955,14 +1964,8 @@ their associated keys and their effects."
"\n\t" new-item nil nil 1)))
(unwind-protect
(progn
;; Make sure the correct category is selected. There
;; are two cases: (i) we just visited the file, so no
;; category is selected yet, or (ii) we invoked
;; insertion "here" from outside the category we want
;; to insert in (with priority insertion, category
;; selection is done by todo-set-item-priority).
(when (or (= (- (point-max) (point-min)) (buffer-size))
(and here called-from-outside))
;; If we just visited the file, no category is selected yet.
(when (= (- (point-max) (point-min)) (buffer-size))
(todo-category-number cat)
(todo-category-select))
;; If only done items are displayed in category,
@ -1973,16 +1976,7 @@ their associated keys and their effects."
(setq done-only t)
(todo-toggle-view-done-only))
(if here
(progn
;; If command was invoked with point in done
;; items section or outside of the current
;; category, can't insert "here", so to be
;; useful give new item top priority.
(when (or (todo-done-item-section-p)
called-from-outside
done-only)
(goto-char (point-min)))
(todo-insert-with-overlays new-item))
(todo-insert-with-overlays new-item)
(todo-set-item-priority new-item cat t))
(setq item-added t))
;; If user cancels before setting priority, restore
@ -2097,7 +2091,14 @@ the item at point."
(setq todo-categories-with-marks
(assq-delete-all cat todo-categories-with-marks)))
(todo-update-categories-sexp)
(todo-prefix-overlays)))
(todo-prefix-overlays)
(when (and (zerop (todo-get-count 'diary))
(save-excursion
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote todo-category-done))
nil t)))
(let (todo-show-with-done) (todo-category-select)))))
(if ov (delete-overlay ov)))))
(defvar todo-edit-item--param-key-alist)
@ -2233,7 +2234,8 @@ made in the number or names of categories."
(insert item))
(kill-buffer)
(unless (eq (current-buffer) buf)
(set-window-buffer (selected-window) (set-buffer buf))))
(set-window-buffer (selected-window) (set-buffer buf)))
(if transient-mark-mode (deactivate-mark)))
;; We got here via `F e'.
(when (todo-check-format)
;; FIXME: separate out sexp check?
@ -2340,7 +2342,7 @@ made in the number or names of categories."
((or (string= omonth "*") (= mm 13))
(user-error "Cannot increment *"))
(t
(let ((mminc (+ mm inc)))
(let ((mminc (+ mm inc (if (< inc 0) 12 0))))
;; Increment or decrement month by INC
;; modulo 12.
(setq mm (% mminc 12))
@ -2549,7 +2551,11 @@ whose value can be either of the symbols `raise' or `lower',
meaning to raise or lower the item's priority by one."
(interactive)
(unless (and (or (called-interactively-p 'any) (memq arg '(raise lower)))
(or (todo-done-item-p) (looking-at "^$")))
;; Noop if point is not on a todo (i.e. not done) item.
(or (todo-done-item-p) (looking-at "^$")
;; On done items separator.
(save-excursion (beginning-of-line)
(looking-at todo-category-done))))
(let* ((item (or item (todo-item-string)))
(marked (todo-marked-item-p))
(cat (or cat (cond ((eq major-mode 'todo-mode)
@ -2697,9 +2703,13 @@ section in the category moved to."
(interactive "P")
(let* ((cat1 (todo-current-category))
(marked (assoc cat1 todo-categories-with-marks)))
;; Noop if point is not on an item and there are no marked items.
(unless (and (looking-at "^$")
(not marked))
(unless
;; Noop if point is not on an item and there are no marked items.
(and (or (looking-at "^$")
;; On done items separator.
(save-excursion (beginning-of-line)
(looking-at todo-category-done)))
(not marked))
(let* ((buffer-read-only)
(file1 todo-current-todo-file)
(item (todo-item-string))
@ -2856,10 +2866,14 @@ visible."
(let* ((cat (todo-current-category))
(marked (assoc cat todo-categories-with-marks)))
(when marked (todo--user-error-if-marked-done-item))
(unless (and (not marked)
(or (todo-done-item-p)
;; Point is between todo and done items.
(looking-at "^$")))
(unless
;; Noop if point is not on a todo (i.e. not done) item and
;; there are no marked items.
(and (or (todo-done-item-p) (looking-at "^$")
;; On done items separator.
(save-excursion (beginning-of-line)
(looking-at todo-category-done)))
(not marked))
(let* ((date-string (calendar-date-string (calendar-current-date) t t))
(time-string (if todo-always-add-time-string
(concat " " (substring (current-time-string)
@ -3830,6 +3844,7 @@ face."
(goto-char (point-min))
(while (not (eobp))
(setq match (re-search-forward regex nil t))
(if (and match transient-mark-mode) (deactivate-mark))
(goto-char (line-beginning-position))
(unless (or (equal (point) 1)
(looking-at (concat "^" (regexp-quote todo-category-beg))))
@ -4028,19 +4043,22 @@ regexp items."
(interactive "P")
(todo-filter-items 'regexp arg t))
(defvar todo--fifiles-history nil
"List of short file names used by todo-find-filtered-items-file.")
(defun todo-find-filtered-items-file ()
"Choose a filtered items file and visit it."
(interactive)
(let ((files (directory-files todo-directory t "\\.tod[rty]$" t))
falist file)
(dolist (f files)
(let ((type (cond ((equal (file-name-extension f) "todr") "regexp")
(let ((sf-name (todo-short-file-name f))
(type (cond ((equal (file-name-extension f) "todr") "regexp")
((equal (file-name-extension f) "todt") "top")
((equal (file-name-extension f) "tody") "diary"))))
(push (cons (concat (todo-short-file-name f) " (" type ")") f)
falist)))
(setq file (completing-read "Choose a filtered items file: "
falist nil t nil nil (car falist)))
(push (cons (concat sf-name " (" type ")") f) falist)))
(setq file (completing-read "Choose a filtered items file: " falist nil t nil
'todo--fifiles-history (caar falist)))
(setq file (cdr (assoc-string file falist)))
(find-file file)
(unless (derived-mode-p 'todo-filtered-items-mode)
@ -4050,25 +4068,27 @@ regexp items."
(defun todo-go-to-source-item ()
"Display the file and category of the filtered item at point."
(interactive)
(let* ((str (todo-item-string))
(buf (current-buffer))
(res (todo-find-item str))
(found (nth 0 res))
(file (nth 1 res))
(cat (nth 2 res)))
(if (not found)
(message "Category %s does not contain this item." cat)
(kill-buffer buf)
(set-window-buffer (selected-window)
(set-buffer (find-buffer-visiting file)))
(setq todo-current-todo-file file)
(setq todo-category-number (todo-category-number cat))
(let ((todo-show-with-done (if (or todo-filter-done-items
(eq (cdr found) 'done))
t
todo-show-with-done)))
(todo-category-select))
(goto-char (car found)))))
(unless (looking-at "^$") ; Empty line at EOB.
(let* ((str (todo-item-string))
(buf (current-buffer))
(res (todo-find-item str))
(found (nth 0 res))
(file (nth 1 res))
(cat (nth 2 res)))
(if (not found)
(message "Category %s does not contain this item." cat)
(kill-buffer buf)
(set-window-buffer (selected-window)
(set-buffer (find-buffer-visiting file)))
(setq todo-current-todo-file file)
(setq todo-category-number (todo-category-number cat))
(let ((todo-show-with-done (if (or todo-filter-done-items
(eq (cdr found) 'done))
t
todo-show-with-done)))
(todo-category-select))
(if transient-mark-mode (deactivate-mark))
(goto-char (car found))))))
(defvar todo-multiple-filter-files nil
"List of files selected from `todo-multiple-filter-files' widget.")
@ -4520,8 +4540,11 @@ its priority has changed, and `same' otherwise."
(defun todo-save-filtered-items-buffer ()
"Save current Filtered Items buffer to a file.
If the file already exists, overwrite it only on confirmation."
(let ((filename (or (buffer-file-name) (todo-filter-items-filename))))
(write-file filename t)))
(let ((filename (or (buffer-file-name) (todo-filter-items-filename)))
(bufname (buffer-name)))
(write-file filename t)
(setq buffer-read-only t)
(rename-buffer bufname)))
;; -----------------------------------------------------------------------------
;;; Printing Todo mode buffers
@ -5132,6 +5155,8 @@ but the categories sexp differs from the current value of
(forward-line)
(looking-at (concat "^"
(regexp-quote todo-category-done))))))
;; Point is on done items separator.
(save-excursion (beginning-of-line) (looking-at todo-category-done))
;; Buffer is widened.
(looking-at (regexp-quote todo-category-beg)))
(goto-char (line-beginning-position))
@ -5141,8 +5166,11 @@ but the categories sexp differs from the current value of
(defun todo-item-end ()
"Move to end of current todo item and return its position."
;; Items cannot end with a blank line.
(unless (looking-at "^$")
(unless (or
;; Items cannot end with a blank line.
(looking-at "^$")
;; Point is on done items separator.
(save-excursion (beginning-of-line) (looking-at todo-category-done)))
(let* ((done (todo-done-item-p))
(to-lim nil)
;; For todo items, end is before the done items section, for done
@ -5293,6 +5321,7 @@ Overrides `diary-goto-entry'."
nil t)
(todo-category-number (match-string 1))
(todo-category-select)
(if transient-mark-mode (deactivate-mark))
(goto-char opoint))))))
(add-function :override diary-goto-entry-function #'todo-diary-goto-entry)
@ -6419,9 +6448,6 @@ Filtered Items mode following todo (not done) items."
("N" todo-toggle-prefix-numbers)
("PB" todo-print-buffer)
("PF" todo-print-buffer-to-file)
("b" todo-backward-category)
("d" todo-item-done)
("f" todo-forward-category)
("j" todo-jump-to-category)
("n" todo-next-item)
("p" todo-previous-item)
@ -6436,6 +6462,8 @@ Filtered Items mode following todo (not done) items."
("Fc" todo-show-categories-table)
("S" todo-search)
("X" todo-clear-matches)
("b" todo-backward-category)
("f" todo-forward-category)
("*" todo-toggle-mark-item)
)
"List of key bindings for Todo and Todo Archive modes.")

2
lisp/char-fold.el
View file

@ -214,7 +214,7 @@ from which to start."
(when (> spaces 0)
(push (char-fold--make-space-string spaces) out))
(let ((regexp (apply #'concat (nreverse out))))
;; Limited by `MAX_BUF_SIZE' in `regex.c'.
;; Limited by `MAX_BUF_SIZE' in `regex-emacs.c'.
(if (> (length regexp) 5000)
(regexp-quote string)
regexp))))

19
lisp/comint.el
View file

@ -78,7 +78,7 @@
;;
;; Not bound by default in comint-mode (some are in shell mode)
;; comint-run Run a program under comint-mode
;; send-invisible Read a line w/o echo, and send to proc
;; comint-send-invisible Read a line w/o echo, and send to proc
;; comint-dynamic-complete-filename Complete filename at point.
;; comint-dynamic-list-filename-completions List completions in help buffer.
;; comint-replace-by-expanded-filename Expand and complete filename at point;
@ -632,7 +632,7 @@ Input ring history expansion can be achieved with the commands
Input ring expansion is controlled by the variable `comint-input-autoexpand',
and addition is controlled by the variable `comint-input-ignoredups'.
Commands with no default key bindings include `send-invisible',
Commands with no default key bindings include `comint-send-invisible',
`completion-at-point', `comint-dynamic-list-filename-completions', and
`comint-magic-space'.
@ -2247,7 +2247,7 @@ This function could be on `comint-output-filter-functions' or bound to a key."
(error nil))
(while (re-search-forward "\r+$" pmark t)
(replace-match "" t t)))))
(defalias 'shell-strip-ctrl-m 'comint-strip-ctrl-m)
(define-obsolete-function-alias 'shell-strip-ctrl-m #'comint-strip-ctrl-m "27.1")
(defun comint-show-maximum-output ()
"Put the end of the buffer at the bottom of the window."
@ -2357,9 +2357,9 @@ a buffer local variable."
;; These three functions are for entering text you don't want echoed or
;; saved -- typically passwords to ftp, telnet, or somesuch.
;; Just enter m-x send-invisible and type in your line.
;; Just enter m-x comint-send-invisible and type in your line.
(defun send-invisible (&optional prompt)
(defun comint-send-invisible (&optional prompt)
"Read a string without echoing.
Then send it to the process running in the current buffer.
The string is sent using `comint-input-sender'.
@ -2382,18 +2382,19 @@ Security bug: your string can still be temporarily recovered with
(message "Warning: text will be echoed")))
(error "Buffer %s has no process" (current-buffer)))))
(define-obsolete-function-alias 'send-invisible #'comint-send-invisible "27.1")
(defun comint-watch-for-password-prompt (string)
"Prompt in the minibuffer for password and send without echoing.
This function uses `send-invisible' to read and send a password to the buffer's
process if STRING contains a password prompt defined by
`comint-password-prompt-regexp'.
Looks for a match to `comint-password-prompt-regexp' in order
to detect the need to (prompt and) send a password.
This function could be in the list `comint-output-filter-functions'."
(when (let ((case-fold-search t))
(string-match comint-password-prompt-regexp string))
(when (string-match "^[ \n\r\t\v\f\b\a]+" string)
(setq string (replace-match "" t t string)))
(send-invisible string)))
(comint-send-invisible string)))
;; Low-level process communication

63
lisp/cus-theme.el
View file

@ -1,4 +1,4 @@
;;; cus-theme.el -- custom theme creation user interface
;;; cus-theme.el -- custom theme creation user interface -*- lexical-binding: t -*-
;;
;; Copyright (C) 2001-2018 Free Software Foundation, Inc.
;;
@ -47,7 +47,7 @@
Do not call this mode function yourself. It is meant for internal use."
(use-local-map custom-new-theme-mode-map)
(custom--initialize-widget-variables)
(set (make-local-variable 'revert-buffer-function) 'custom-theme-revert))
(setq-local revert-buffer-function #'custom-theme-revert))
(put 'custom-new-theme-mode 'mode-class 'special)
(defvar custom-theme-name nil)
@ -93,15 +93,14 @@ named *Custom Theme*."
(switch-to-buffer (get-buffer-create (or buffer "*Custom Theme*")))
(let ((inhibit-read-only t))
(erase-buffer)
(dolist (ov (overlays-in (point-min) (point-max)))
(delete-overlay ov)))
(delete-all-overlays))
(custom-new-theme-mode)
(make-local-variable 'custom-theme-name)
(set (make-local-variable 'custom-theme--save-name) theme)
(set (make-local-variable 'custom-theme-faces) nil)
(set (make-local-variable 'custom-theme-variables) nil)
(set (make-local-variable 'custom-theme-description) "")
(set (make-local-variable 'custom-theme--migrate-settings) nil)
(setq-local custom-theme--save-name theme)
(setq-local custom-theme-faces nil)
(setq-local custom-theme-variables nil)
(setq-local custom-theme-description "")
(setq-local custom-theme--migrate-settings nil)
(make-local-variable 'custom-theme-insert-face-marker)
(make-local-variable 'custom-theme-insert-variable-marker)
(make-local-variable 'custom-theme--listed-faces)
@ -118,13 +117,13 @@ remove them from your saved Custom file.\n\n"))
:tag " Visit Theme "
:help-echo "Insert the settings of a pre-defined theme."
:action (lambda (_widget &optional _event)
(call-interactively 'custom-theme-visit-theme)))
(call-interactively #'custom-theme-visit-theme)))
(widget-insert " ")
(widget-create 'push-button
:tag " Merge Theme "
:help-echo "Merge in the settings of a pre-defined theme."
:action (lambda (_widget &optional _event)
(call-interactively 'custom-theme-merge-theme)))
(call-interactively #'custom-theme-merge-theme)))
(widget-insert " ")
(widget-create 'push-button
:tag " Revert "
@ -142,7 +141,7 @@ remove them from your saved Custom file.\n\n"))
(widget-create 'text
:value (format-time-string "Created %Y-%m-%d.")))
(widget-create 'push-button
:notify (function custom-theme-write)
:notify #'custom-theme-write
" Save Theme ")
(when (eq theme 'user)
(setq custom-theme--migrate-settings t)
@ -188,7 +187,7 @@ remove them from your saved Custom file.\n\n"))
:mouse-face 'highlight
:pressed-face 'highlight
:action (lambda (_widget &optional _event)
(call-interactively 'custom-theme-add-face)))
(call-interactively #'custom-theme-add-face)))
;; If THEME is non-nil, insert all of that theme's variables.
(widget-insert "\n\n Theme variables:\n ")
@ -207,7 +206,7 @@ remove them from your saved Custom file.\n\n"))
:mouse-face 'highlight
:pressed-face 'highlight
:action (lambda (_widget &optional _event)
(call-interactively 'custom-theme-add-variable)))
(call-interactively #'custom-theme-add-variable)))
(widget-insert ?\n)
(widget-setup)
(goto-char (point-min))
@ -254,7 +253,7 @@ interactively, this defaults to the current value of VAR."
:tag (custom-unlispify-tag-name symbol)
:value symbol
:shown-value (list val)
:notify 'ignore
:notify #'ignore
:custom-level 0
:custom-state 'hidden
:custom-style 'simple))
@ -313,7 +312,7 @@ SPEC, if non-nil, should be a face spec to which to set the widget."
(interactive
(list
(intern (completing-read "Find custom theme: "
(mapcar 'symbol-name
(mapcar #'symbol-name
(custom-available-themes))))))
(unless (custom-theme-name-valid-p theme)
(error "No valid theme named `%s'" theme))
@ -328,7 +327,7 @@ SPEC, if non-nil, should be a face spec to which to set the widget."
(interactive
(list
(intern (completing-read "Merge custom theme: "
(mapcar 'symbol-name
(mapcar #'symbol-name
(custom-available-themes))))))
(unless (eq theme 'user)
(unless (custom-theme-name-valid-p theme)
@ -343,8 +342,8 @@ SPEC, if non-nil, should be a face spec to which to set the widget."
(memq name '(custom-enabled-themes
custom-safe-themes)))
(funcall (if option
'custom-theme-add-variable
'custom-theme-add-face)
#'custom-theme-add-variable
#'custom-theme-add-face)
name value)))))
theme)
@ -475,7 +474,7 @@ It includes all faces in list FACES."
(interactive
(list
(intern (completing-read "Describe custom theme: "
(mapcar 'symbol-name
(mapcar #'symbol-name
(custom-available-themes))))))
(unless (custom-theme-name-valid-p theme)
(error "Invalid theme name `%s'" theme))
@ -513,8 +512,7 @@ It includes all faces in list FACES."
(condition-case nil
(read (current-buffer))
(end-of-file nil)))))
(and sexp (listp sexp)
(eq (car sexp) 'deftheme)
(and (eq (car-safe sexp) 'deftheme)
(setq doc (nth 2 sexp)))))))
(princ "\n\nDocumentation:\n")
(princ (if (stringp doc)
@ -552,10 +550,10 @@ It includes all faces in list FACES."
Do not call this mode function yourself. It is meant for internal use."
(use-local-map custom-theme-choose-mode-map)
(custom--initialize-widget-variables)
(set (make-local-variable 'revert-buffer-function)
(lambda (_ignore-auto noconfirm)
(when (or noconfirm (y-or-n-p "Discard current choices? "))
(customize-themes (current-buffer))))))
(setq-local revert-buffer-function
(lambda (_ignore-auto noconfirm)
(when (or noconfirm (y-or-n-p "Discard current choices? "))
(customize-themes (current-buffer))))))
(put 'custom-theme-choose-mode 'mode-class 'special)
;;;###autoload
@ -568,7 +566,7 @@ omitted, a buffer named *Custom Themes* is used."
(let ((inhibit-read-only t))
(erase-buffer))
(custom-theme-choose-mode)
(set (make-local-variable 'custom--listed-themes) nil)
(setq-local custom--listed-themes nil)
(make-local-variable 'custom-theme-allow-multiple-selections)
(and (null custom-theme-allow-multiple-selections)
(> (length custom-enabled-themes) 1)
@ -616,11 +614,11 @@ Theme files are named *-theme.el in `"))
(widget-create 'push-button
:tag " Save Theme Settings "
:help-echo "Save the selected themes for future sessions."
:action 'custom-theme-save)
:action #'custom-theme-save)
(widget-insert ?\n)
(widget-create 'checkbox
:value custom-theme-allow-multiple-selections
:action 'custom-theme-selections-toggle)
:action #'custom-theme-selections-toggle)
(widget-insert (propertize " Select more than one theme at a time"
'face '(variable-pitch (:height 0.9))))
@ -632,13 +630,13 @@ Theme files are named *-theme.el in `"))
:value (custom-theme-enabled-p theme)
:theme-name theme
:help-echo help-echo
:action 'custom-theme-checkbox-toggle))
:action #'custom-theme-checkbox-toggle))
(push (cons theme widget) custom--listed-themes)
(widget-create-child-and-convert widget 'push-button
:button-face-get 'ignore
:mouse-face-get 'ignore
:value (format " %s" theme)
:action 'widget-parent-action
:action #'widget-parent-action
:help-echo help-echo)
(widget-insert " -- "
(propertize (custom-theme-summary theme)
@ -662,8 +660,7 @@ Theme files are named *-theme.el in `"))
(condition-case nil
(read (current-buffer))
(end-of-file nil)))))
(and sexp (listp sexp)
(eq (car sexp) 'deftheme)
(and (eq (car-safe sexp) 'deftheme)
(setq doc (nth 2 sexp))))))))
(cond ((null doc)
"(no documentation available)")

257
lisp/custom.el
View file

@ -1,4 +1,4 @@
;;; custom.el --- tools for declaring and initializing options
;;; custom.el --- tools for declaring and initializing options -*- lexical-binding: t -*-
;;
;; Copyright (C) 1996-1997, 1999, 2001-2018 Free Software Foundation,
;; Inc.
@ -150,7 +150,7 @@ set to nil, as the value is no longer rogue."
(put symbol 'force-value nil))
(if (keywordp doc)
(error "Doc string is missing"))
(let ((initialize 'custom-initialize-reset)
(let ((initialize #'custom-initialize-reset)
(requests nil))
(unless (memq :group args)
(custom-add-to-group (custom-current-group) symbol 'custom-variable))
@ -426,7 +426,7 @@ information."
(defun custom-declare-group (symbol members doc &rest args)
"Like `defgroup', but SYMBOL is evaluated as a normal argument."
(while members
(apply 'custom-add-to-group symbol (car members))
(apply #'custom-add-to-group symbol (car members))
(setq members (cdr members)))
(when doc
;; This text doesn't get into DOC.
@ -618,11 +618,8 @@ VARIABLE is a symbol that names a user option.
The result is that the change is treated as having been made through Custom."
(put variable 'customized-value (list (custom-quote (eval variable)))))
;;; Custom Themes
;;; Loading files needed to customize a symbol.
;;; This is in custom.el because menu-bar.el needs it for toggle cmds.
;; Loading files needed to customize a symbol.
;; This is in custom.el because menu-bar.el needs it for toggle cmds.
(defvar custom-load-recursion nil
"Hack to avoid recursive dependencies.")
@ -633,14 +630,12 @@ The result is that the change is treated as having been made through Custom."
(let ((custom-load-recursion t))
;; Load these files if not already done,
;; to make sure we know all the dependencies of SYMBOL.
(condition-case nil
(require 'cus-load)
(error nil))
(condition-case nil
(require 'cus-start)
(error nil))
(ignore-errors
(require 'cus-load))
(ignore-errors
(require 'cus-start))
(dolist (load (get symbol 'custom-loads))
(cond ((symbolp load) (condition-case nil (require load) (error nil)))
(cond ((symbolp load) (ignore-errors (require load)))
;; This is subsumed by the test below, but it's much faster.
((assoc load load-history))
;; This was just (assoc (locate-library load) load-history)
@ -658,7 +653,7 @@ The result is that the change is treated as having been made through Custom."
;; We are still loading it when we call this,
;; and it is not in load-history yet.
((equal load "cus-edit"))
(t (condition-case nil (load load) (error nil))))))))
(t (ignore-errors (load load))))))))
(defvar custom-local-buffer nil
"Non-nil, in a Customization buffer, means customize a specific buffer.
@ -691,16 +686,12 @@ this sets the local binding in that buffer instead."
(defun custom-quote (sexp)
"Quote SEXP if it is not self quoting."
(if (or (memq sexp '(t nil))
(keywordp sexp)
(and (listp sexp)
(memq (car sexp) '(lambda)))
(stringp sexp)
(numberp sexp)
(vectorp sexp)
;;; (and (fboundp 'characterp)
;;; (characterp sexp))
)
;; Can't use `macroexp-quote' because it is loaded after `custom.el'
;; during bootstrap. See `loadup.el'.
(if (and (not (consp sexp))
(or (keywordp sexp)
(not (symbolp sexp))
(booleanp sexp)))
sexp
(list 'quote sexp)))
@ -715,18 +706,16 @@ To actually save the value, call `custom-save-all'.
Return non-nil if the `saved-value' property actually changed."
(custom-load-symbol symbol)
(let* ((get (or (get symbol 'custom-get) 'default-value))
(let* ((get (or (get symbol 'custom-get) #'default-value))
(value (funcall get symbol))
(saved (get symbol 'saved-value))
(standard (get symbol 'standard-value))
(comment (get symbol 'customized-variable-comment)))
;; Save default value if different from standard value.
(if (or (null standard)
(not (equal value (condition-case nil
(eval (car standard))
(error nil)))))
(put symbol 'saved-value (list (custom-quote value)))
(put symbol 'saved-value nil))
(put symbol 'saved-value
(unless (and standard
(equal value (ignore-errors (eval (car standard)))))
(list (custom-quote value))))
;; Clear customized information (set, but not saved).
(put symbol 'customized-value nil)
;; Save any comment that might have been set.
@ -744,15 +733,14 @@ default value. Otherwise, set it to nil.
Return non-nil if the `customized-value' property actually changed."
(custom-load-symbol symbol)
(let* ((get (or (get symbol 'custom-get) 'default-value))
(let* ((get (or (get symbol 'custom-get) #'default-value))
(value (funcall get symbol))
(customized (get symbol 'customized-value))
(old (or (get symbol 'saved-value) (get symbol 'standard-value))))
;; Mark default value as set if different from old value.
(if (not (and old
(equal value (condition-case nil
(eval (car old))
(error nil)))))
(equal value (ignore-errors
(eval (car old))))))
(progn (put symbol 'customized-value (list (custom-quote value)))
(custom-push-theme 'theme-value symbol 'user 'set
(custom-quote value)))
@ -776,7 +764,7 @@ E.g. dumped variables whose default depends on run-time information."
;; always do the funcall step, even if symbol was not bound before.
(or (default-boundp symbol)
(eval `(defvar ,symbol nil))) ; reset below, so any value is fine
(funcall (or (get symbol 'custom-set) 'set-default)
(funcall (or (get symbol 'custom-set) #'set-default)
symbol
(eval (car (or (get symbol 'saved-value) (get symbol 'standard-value))))))
@ -946,7 +934,7 @@ the default value for the SYMBOL to the value of EXP.
REQUEST is a list of features we must require in order to
handle SYMBOL properly.
COMMENT is a comment string about SYMBOL."
(apply 'custom-theme-set-variables 'user args))
(apply #'custom-theme-set-variables 'user args))
(defun custom-theme-set-variables (theme &rest args)
"Initialize variables for theme THEME according to settings in ARGS.
@ -994,8 +982,8 @@ COMMENT is a comment string about SYMBOL."
set)
(when requests
(put symbol 'custom-requests requests)
(mapc 'require requests))
(setq set (or (get symbol 'custom-set) 'custom-set-default))
(mapc #'require requests))
(setq set (or (get symbol 'custom-set) #'custom-set-default))
(put symbol 'saved-value (list value))
(put symbol 'saved-variable-comment comment)
;; Allow for errors in the case where the setter has
@ -1091,26 +1079,29 @@ list, in which A occurs before B if B was defined with a
;; they were used to supply keyword-value pairs like `:immediate',
;; `:variable-reset-string', etc. We don't use any of these, so ignore them.
(defmacro deftheme (theme &optional doc &rest ignored)
(defmacro deftheme (theme &optional doc &rest _ignored)
"Declare THEME to be a Custom theme.
The optional argument DOC is a doc string describing the theme.
Any theme `foo' should be defined in a file called `foo-theme.el';
see `custom-make-theme-feature' for more information."
(declare (doc-string 2))
(declare (doc-string 2)
(advertised-calling-convention (theme &optional doc) "22.1"))
(let ((feature (custom-make-theme-feature theme)))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
(list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc)))
(defun custom-declare-theme (theme feature &optional doc &rest ignored)
(defun custom-declare-theme (theme feature &optional doc &rest _ignored)
"Like `deftheme', but THEME is evaluated as a normal argument.
FEATURE is the feature this theme provides. Normally, this is a symbol
created from THEME by `custom-make-theme-feature'."
(declare (advertised-calling-convention (theme feature &optional doc) "22.1"))
(unless (custom-theme-name-valid-p theme)
(error "Custom theme cannot be named %S" theme))
(add-to-list 'custom-known-themes theme)
(unless (memq theme custom-known-themes)
(push theme custom-known-themes))
(put theme 'theme-feature feature)
(when doc (put theme 'theme-documentation doc)))
@ -1218,7 +1209,7 @@ Return t if THEME was successfully loaded, nil otherwise."
(interactive
(list
(intern (completing-read "Load custom theme: "
(mapcar 'symbol-name
(mapcar #'symbol-name
(custom-available-themes))))
nil nil))
(unless (custom-theme-name-valid-p theme)
@ -1233,43 +1224,47 @@ Return t if THEME was successfully loaded, nil otherwise."
(put theme 'theme-settings nil)
(put theme 'theme-feature nil)
(put theme 'theme-documentation nil))
(let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
(custom-theme--load-path)
'("" "c"))))
(unless fn
(error "Unable to find theme file for `%s'" theme))
(with-temp-buffer
(insert-file-contents fn)
;; Check file safety with `custom-safe-themes', prompting the
;; user if necessary.
(when (or no-confirm
(eq custom-safe-themes t)
(and (memq 'default custom-safe-themes)
(equal (file-name-directory fn)
(expand-file-name "themes/" data-directory)))
(let ((hash (secure-hash 'sha256 (current-buffer))))
(or (member hash custom-safe-themes)
(custom-theme-load-confirm hash))))
(let ((custom--inhibit-theme-enable t)
(buffer-file-name fn)) ;For load-history.
(eval-buffer))
;; Optimization: if the theme changes the `default' face, put that
;; entry first. This avoids some `frame-set-background-mode' rigmarole
;; by assigning the new background immediately.
(let* ((settings (get theme 'theme-settings))
(tail settings)
found)
(while (and tail (not found))
(and (eq (nth 0 (car tail)) 'theme-face)
(eq (nth 1 (car tail)) 'default)
(setq found (car tail)))
(setq tail (cdr tail)))
(if found
(put theme 'theme-settings (cons found (delq found settings)))))
;; Finally, enable the theme.
(unless no-enable
(enable-theme theme))
t))))
(let ((file (locate-file (concat (symbol-name theme) "-theme.el")
(custom-theme--load-path)
'("" "c")))
(custom--inhibit-theme-enable t))
;; Check file safety with `custom-safe-themes', prompting the
;; user if necessary.
(cond ((not file)
(error "Unable to find theme file for `%s'" theme))
((or no-confirm
(eq custom-safe-themes t)
(and (memq 'default custom-safe-themes)
(equal (file-name-directory file)
(expand-file-name "themes/" data-directory))))
;; Theme is safe; load byte-compiled version if available.
(load (file-name-sans-extension file) nil t nil t))
((with-temp-buffer
(insert-file-contents file)
(let ((hash (secure-hash 'sha256 (current-buffer))))
(when (or (member hash custom-safe-themes)
(custom-theme-load-confirm hash))
(eval-buffer nil nil file)
t))))
(t
(error "Unable to load theme `%s'" theme))))
;; Optimization: if the theme changes the `default' face, put that
;; entry first. This avoids some `frame-set-background-mode' rigmarole
;; by assigning the new background immediately.
(let* ((settings (get theme 'theme-settings))
(tail settings)
found)
(while (and tail (not found))
(and (eq (nth 0 (car tail)) 'theme-face)
(eq (nth 1 (car tail)) 'default)
(setq found (car tail)))
(setq tail (cdr tail)))
(when found
(put theme 'theme-settings (cons found (delq found settings)))))
;; Finally, enable the theme.
(unless no-enable
(enable-theme theme))
t)
(defun custom-theme-load-confirm (hash)
"Query the user about loading a Custom theme that may not be safe.
@ -1292,11 +1287,9 @@ query also about adding HASH to `custom-safe-themes'."
(defun custom-theme-name-valid-p (name)
"Return t if NAME is a valid name for a Custom theme, nil otherwise.
NAME should be a symbol."
(and (symbolp name)
name
(not (or (zerop (length (symbol-name name)))
(eq name 'user)
(eq name 'changed)))))
(and (not (memq name '(nil user changed)))
(symbolp name)
(not (string= "" (symbol-name name)))))
(defun custom-available-themes ()
"Return a list of Custom themes available for loading.
@ -1307,19 +1300,25 @@ The returned symbols may not correspond to themes that have been
loaded, and no effort is made to check that the files contain
valid Custom themes. For a list of loaded themes, check the
variable `custom-known-themes'."
(let (sym themes)
(let ((suffix "-theme\\.el\\'")
themes)
(dolist (dir (custom-theme--load-path))
(when (file-directory-p dir)
(dolist (file (file-expand-wildcards
(expand-file-name "*-theme.el" dir) t))
(setq file (file-name-nondirectory file))
(and (string-match "\\`\\(.+\\)-theme.el\\'" file)
(setq sym (intern (match-string 1 file)))
(custom-theme-name-valid-p sym)
(push sym themes)))))
(nreverse (delete-dups themes))))
;; `custom-theme--load-path' promises DIR exists and is a
;; directory, but `custom.el' is loaded too early during
;; bootstrap to use `cl-lib' macros, so guard with
;; `file-directory-p' instead of calling `cl-assert'.
(dolist (file (and (file-directory-p dir)
(directory-files dir nil suffix)))
(let ((theme (intern (substring file 0 (string-match-p suffix file)))))
(and (custom-theme-name-valid-p theme)
(not (memq theme themes))
(push theme themes)))))
(nreverse themes)))
(defun custom-theme--load-path ()
"Expand `custom-theme-load-path' into a list of directories.
Members of `custom-theme-load-path' that either don't exist or
are not directories are omitted from the expansion."
(let (lpath)
(dolist (f custom-theme-load-path)
(cond ((eq f 'custom-theme-directory)
@ -1346,8 +1345,8 @@ function runs. To disable other themes, use `disable-theme'."
(completing-read
"Enable custom theme: "
obarray (lambda (sym) (get sym 'theme-settings)) t))))
(if (not (custom-theme-p theme))
(error "Undefined Custom theme %s" theme))
(unless (custom-theme-p theme)
(error "Undefined Custom theme %s" theme))
(let ((settings (get theme 'theme-settings)))
;; Loop through theme settings, recalculating vars/faces.
(dolist (s settings)
@ -1387,23 +1386,23 @@ Setting this variable through Customize calls `enable-theme' or
(let (failures)
(setq themes (delq 'user (delete-dups themes)))
;; Disable all themes not in THEMES.
(if (boundp symbol)
(dolist (theme (symbol-value symbol))
(if (not (memq theme themes))
(disable-theme theme))))
(dolist (theme (and (boundp symbol)
(symbol-value symbol)))
(unless (memq theme themes)
(disable-theme theme)))
;; Call `enable-theme' or `load-theme' on each of THEMES.
(dolist (theme (reverse themes))
(condition-case nil
(if (custom-theme-p theme)
(enable-theme theme)
(load-theme theme))
(error (setq failures (cons theme failures)
themes (delq theme themes)))))
(error (push theme failures)
(setq themes (delq theme themes)))))
(enable-theme 'user)
(custom-set-default symbol themes)
(if failures
(message "Failed to enable theme: %s"
(mapconcat 'symbol-name failures ", "))))))
(when failures
(message "Failed to enable theme(s): %s"
(mapconcat #'symbol-name failures ", "))))))
(defsubst custom-theme-enabled-p (theme)
"Return non-nil if THEME is enabled."
@ -1415,7 +1414,7 @@ See `custom-enabled-themes' for a list of enabled themes."
(interactive (list (intern
(completing-read
"Disable custom theme: "
(mapcar 'symbol-name custom-enabled-themes)
(mapcar #'symbol-name custom-enabled-themes)
nil t))))
(when (custom-theme-enabled-p theme)
(let ((settings (get theme 'theme-settings)))
@ -1431,23 +1430,23 @@ See `custom-enabled-themes' for a list of enabled themes."
;; If the face spec specified by this theme is in the
;; saved-face property, reset that property.
(when (equal (nth 3 s) (get symbol 'saved-face))
(put symbol 'saved-face (and val (cadr (car val)))))))))
;; Recompute faces on all frames.
(dolist (frame (frame-list))
;; We must reset the fg and bg color frame parameters, or
;; `face-set-after-frame-default' will use the existing
;; parameters, which could be from the disabled theme.
(set-frame-parameter frame 'background-color
(custom--frame-color-default
frame :background "background" "Background"
"unspecified-bg" "white"))
(set-frame-parameter frame 'foreground-color
(custom--frame-color-default
frame :foreground "foreground" "Foreground"
"unspecified-fg" "black"))
(face-set-after-frame-default frame))
(setq custom-enabled-themes
(delq theme custom-enabled-themes)))))
(put symbol 'saved-face (cadar val))))))))
;; Recompute faces on all frames.
(dolist (frame (frame-list))
;; We must reset the fg and bg color frame parameters, or
;; `face-set-after-frame-default' will use the existing
;; parameters, which could be from the disabled theme.
(set-frame-parameter frame 'background-color
(custom--frame-color-default
frame :background "background" "Background"
"unspecified-bg" "white"))
(set-frame-parameter frame 'foreground-color
(custom--frame-color-default
frame :foreground "foreground" "Foreground"
"unspecified-fg" "black"))
(face-set-after-frame-default frame))
(setq custom-enabled-themes
(delq theme custom-enabled-themes))))
;; Only used if window-system not null.
(declare-function x-get-resource "frame.c"
@ -1481,7 +1480,7 @@ This function returns nil if no custom theme specifies a value for VARIABLE."
(if (and valspec
(or (get variable 'force-value)
(default-boundp variable)))
(funcall (or (get variable 'custom-set) 'set-default) variable
(funcall (or (get variable 'custom-set) #'set-default) variable
(eval (car valspec))))))
(defun custom-theme-recalc-face (face)
@ -1522,7 +1521,7 @@ Each of the arguments ARGS has this form:
(VARIABLE IGNORED)
This means reset VARIABLE. (The argument IGNORED is ignored)."
(apply 'custom-theme-reset-variables 'user args))
(apply #'custom-theme-reset-variables 'user args))
;;; The End.

37
lisp/dired-aux.el
View file

@ -1989,6 +1989,19 @@ Optional arg HOW-TO determines how to treat the target.
dired-dirs)))
;; We use this function in `dired-create-directory' and
;; `dired-create-empty-file'; the return value is the new entry
;; in the updated Dired buffer.
(defun dired--find-topmost-parent-dir (filename)
"Return the topmost nonexistent parent dir of FILENAME.
FILENAME is a full file name."
(let ((try filename) new)
(while (and try (not (file-exists-p try)) (not (equal new try)))
(setq new try
try (directory-file-name (file-name-directory try))))
new))
;;;###autoload
(defun dired-create-directory (directory)
"Create a directory called DIRECTORY.
@ -1997,18 +2010,32 @@ If DIRECTORY already exists, signal an error."
(interactive
(list (read-file-name "Create directory: " (dired-current-directory))))
(let* ((expanded (directory-file-name (expand-file-name directory)))
(try expanded) new)
new)
(if (file-exists-p expanded)
(error "Cannot create directory %s: file exists" expanded))
;; Find the topmost nonexistent parent dir (variable `new')
(while (and try (not (file-exists-p try)) (not (equal new try)))
(setq new try
try (directory-file-name (file-name-directory try))))
(setq new (dired--find-topmost-parent-dir expanded))
(make-directory expanded t)
(when new
(dired-add-file new)
(dired-move-to-filename))))
;;;###autoload
(defun dired-create-empty-file (file)
"Create an empty file called FILE.
Add a new entry for the new file in the Dired buffer.
Parent directories of FILE are created as needed.
If FILE already exists, signal an error."
(interactive (list (read-file-name "Create empty file: ")))
(let* ((expanded (expand-file-name file))
new)
(if (file-exists-p expanded)
(error "Cannot create file %s: file exists" expanded))
(setq new (dired--find-topmost-parent-dir expanded))
(make-empty-file file 'parents)
(when new
(dired-add-file new)
(dired-move-to-filename))))
(defun dired-into-dir-with-symlinks (target)
(and (file-directory-p target)
(not (file-symlink-p target))))

3
lisp/dired.el
View file

@ -1802,6 +1802,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(define-key map [menu-bar immediate create-directory]
'(menu-item "Create Directory..." dired-create-directory
:help "Create a directory"))
(define-key map [menu-bar immediate create-empty-file]
'(menu-item "Create Empty file..." dired-create-empty-file
:help "Create an empty file"))
(define-key map [menu-bar immediate wdired-mode]
'(menu-item "Edit File Names" wdired-change-to-wdired-mode
:help "Put a Dired buffer in a mode in which filenames are editable"

916
lisp/emacs-lisp/backtrace.el Normal file
View file

@ -0,0 +1,916 @@
;;; backtrace.el --- generic major mode for Elisp backtraces -*- lexical-binding: t -*-
;; Copyright (C) 2018 Free Software Foundation, Inc.
;; Author: Gemini Lasswell
;; Keywords: lisp, tools, maint
;; Version: 1.0
;; 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:
;; This file defines Backtrace mode, a generic major mode for displaying
;; Elisp stack backtraces, which can be used as is or inherited from
;; by another mode.
;; For usage information, see the documentation of `backtrace-mode'.
;;; Code:
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'pcase))
(eval-when-compile (require 'subr-x)) ; if-let
(require 'help-mode) ; Define `help-function-def' button type.
(require 'lisp-mode)
;;; Options
(defgroup backtrace nil
"Viewing of Elisp backtraces."
:group 'lisp)
(defcustom backtrace-fontify t
"If non-nil, fontify Backtrace buffers.
Set to nil to disable fontification, which may be necessary in
order to debug the code that does fontification."
:type 'boolean
:group 'backtrace
:version "27.1")
(defcustom backtrace-line-length 5000
"Target length for lines in Backtrace buffers.
Backtrace mode will attempt to abbreviate printing of backtrace
frames to make them shorter than this, but success is not
guaranteed. If set to nil or zero, Backtrace mode will not
abbreviate the forms it prints."
:type 'integer
:group 'backtrace
:version "27.1")
;;; Backtrace frame data structure
(cl-defstruct
(backtrace-frame
(:constructor backtrace-make-frame))
evald ; Non-nil if argument evaluation is complete.
fun ; The function called/to call in this frame.
args ; Either evaluated or unevaluated arguments to the function.
flags ; A plist, possible properties are :debug-on-exit and :source-available.
locals ; An alist containing variable names and values.
buffer ; If non-nil, the buffer in use by eval-buffer or eval-region.
pos ; The position in the buffer.
)
(cl-defun backtrace-get-frames
(&optional base &key (constructor #'backtrace-make-frame))
"Collect all frames of current backtrace into a list.
The list will contain objects made by CONSTRUCTOR, which
defaults to `backtrace-make-frame' and which, if provided, should
be the constructor of a structure which includes
`backtrace-frame'. If non-nil, BASE should be a function, and
frames before its nearest activation frame are discarded."
(let ((frames nil)
(eval-buffers eval-buffer-list))
(mapbacktrace (lambda (evald fun args flags)
(push (funcall constructor
:evald evald :fun fun
:args args :flags flags)
frames))
(or base 'backtrace-get-frames))
(setq frames (nreverse frames))
;; Add local variables to each frame, and the buffer position
;; to frames containing eval-buffer or eval-region.
(dotimes (idx (length frames))
(let ((frame (nth idx frames)))
;; `backtrace--locals' gives an error when idx is 0. But the
;; locals for frame 0 are not needed, because when we get here
;; from debug-on-entry, the locals aren't bound yet, and when
;; coming from Edebug or ERT there is an Edebug or ERT
;; function at frame 0.
(when (> idx 0)
(setf (backtrace-frame-locals frame)
(backtrace--locals idx (or base 'backtrace-get-frames))))
(when (and eval-buffers (memq (backtrace-frame-fun frame)
'(eval-buffer eval-region)))
;; This will get the wrong result if there are two nested
;; eval-region calls for the same buffer. That's not a very
;; useful case.
(with-current-buffer (pop eval-buffers)
(setf (backtrace-frame-buffer frame) (current-buffer))
(setf (backtrace-frame-pos frame) (point))))))
frames))
;; Button definition for jumping to a buffer position.
(define-button-type 'backtrace-buffer-pos
'action #'backtrace--pop-to-buffer-pos
'help-echo "mouse-2, RET: Show reading position")
(defun backtrace--pop-to-buffer-pos (button)
"Pop to the buffer and position for the BUTTON at point."
(let* ((buffer (button-get button 'backtrace-buffer))
(pos (button-get button 'backtrace-pos)))
(if (buffer-live-p buffer)
(progn
(pop-to-buffer buffer)
(goto-char (max (point-min) (min (point-max) pos))))
(message "Buffer has been killed"))))
;; Font Locking support
(defconst backtrace--font-lock-keywords
'((backtrace--match-ellipsis-in-string
(1 'button prepend)))
"Expressions to fontify in Backtrace mode.
Fontify these in addition to the expressions Emacs Lisp mode
fontifies.")
(defconst backtrace-font-lock-keywords
(append lisp-el-font-lock-keywords-for-backtraces
backtrace--font-lock-keywords)
"Default expressions to highlight in Backtrace mode.")
(defconst backtrace-font-lock-keywords-1
(append lisp-el-font-lock-keywords-for-backtraces-1
backtrace--font-lock-keywords)
"Subdued level highlighting for Backtrace mode.")
(defconst backtrace-font-lock-keywords-2
(append lisp-el-font-lock-keywords-for-backtraces-2
backtrace--font-lock-keywords)
"Gaudy level highlighting for Backtrace mode.")
(defun backtrace--match-ellipsis-in-string (bound)
;; Fontify ellipses within strings as buttons.
;; This is necessary because ellipses are text property buttons
;; instead of overlay buttons, which is done because there could
;; be a large number of them.
(when (re-search-forward "\\(\\.\\.\\.\\)\"" bound t)
(and (get-text-property (- (point) 2) 'cl-print-ellipsis)
(get-text-property (- (point) 3) 'cl-print-ellipsis)
(get-text-property (- (point) 4) 'cl-print-ellipsis))))
;;; Xref support
(defun backtrace--xref-backend () 'elisp)
;;; Backtrace mode variables
(defvar-local backtrace-frames nil
"Stack frames displayed in the current Backtrace buffer.
This should be a list of `backtrace-frame' objects.")
(defvar-local backtrace-view nil
"A plist describing how to render backtrace frames.
Possible entries are :show-flags, :show-locals and :print-circle.")
(defvar-local backtrace-insert-header-function nil
"Function for inserting a header for the current Backtrace buffer.
If nil, no header will be created. Note that Backtrace buffers
are fontified as in Emacs Lisp Mode, the header text included.")
(defvar backtrace-revert-hook nil
"Hook run before reverting a Backtrace buffer.
This is commonly used to recompute `backtrace-frames'.")
(defvar-local backtrace-print-function #'cl-prin1
"Function used to print values in the current Backtrace buffer.")
(defvar-local backtrace-goto-source-functions nil
"Abnormal hook used to jump to the source code for the current frame.
Each hook function is called with no argument, and should return
non-nil if it is able to switch to the buffer containing the
source code. Execution of the hook will stop if one of the
functions returns non-nil. When adding a function to this hook,
you should also set the :source-available flag for the backtrace
frames where the source code location is known.")
(defvar backtrace-mode-map
(let ((map (copy-keymap special-mode-map)))
(set-keymap-parent map button-buffer-map)
(define-key map "n" 'backtrace-forward-frame)
(define-key map "p" 'backtrace-backward-frame)
(define-key map "v" 'backtrace-toggle-locals)
(define-key map "#" 'backtrace-toggle-print-circle)
(define-key map "s" 'backtrace-goto-source)
(define-key map "\C-m" 'backtrace-help-follow-symbol)
(define-key map "+" 'backtrace-multi-line)
(define-key map "-" 'backtrace-single-line)
(define-key map "." 'backtrace-expand-ellipses)
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'mouse-select-window)
(easy-menu-define nil map ""
'("Backtrace"
["Next Frame" backtrace-forward-frame
:help "Move cursor forwards to the start of a backtrace frame"]
["Previous Frame" backtrace-backward-frame
:help "Move cursor backwards to the start of a backtrace frame"]
"--"
["Show Variables" backtrace-toggle-locals
:style toggle
:active (backtrace-get-index)
:selected (plist-get (backtrace-get-view) :show-locals)
:help "Show or hide the local variables for the frame at point"]
["Expand \"...\"s" backtrace-expand-ellipses
:help "Expand all the abbreviated forms in the current frame"]
["Show on Multiple Lines" backtrace-multi-line
:help "Use line breaks and indentation to make a form more readable"]
["Show on Single Line" backtrace-single-line]
"--"
["Go to Source" backtrace-goto-source
:active (and (backtrace-get-index)
(plist-get (backtrace-frame-flags
(nth (backtrace-get-index) backtrace-frames))
:source-available))
:help "Show the source code for the current frame"]
["Help for Symbol" backtrace-help-follow-symbol
:help "Show help for symbol at point"]
["Describe Backtrace Mode" describe-mode
:help "Display documentation for backtrace-mode"]))
map)
"Local keymap for `backtrace-mode' buffers.")
(defconst backtrace--flags-width 2
"Width in characters of the flags for a backtrace frame.")
;;; Navigation and Text Properties
;; This mode uses the following text properties:
;; backtrace-index: The index into the buffer-local variable
;; `backtrace-frames' for the frame at point, or nil if outside of a
;; frame (in the buffer header).
;; backtrace-view: A plist describing how the frame is printed. See
;; the docstring for the buffer-local variable `backtrace-view.
;; backtrace-section: The part of a frame which point is in. Either
;; `func' or `locals'. At the moment just used to show and hide the
;; local variables. Derived modes which do additional printing
;; could define their own frame sections.
;; backtrace-form: A value applied to each printed representation of a
;; top-level s-expression, which needs to be different for sexps
;; printed adjacent to each other, so the limits can be quickly
;; found for pretty-printing.
(defsubst backtrace-get-index (&optional pos)
"Return the index of the backtrace frame at POS.
The value is an index into `backtrace-frames', or nil.
POS, if omitted or nil, defaults to point."
(get-text-property (or pos (point)) 'backtrace-index))
(defsubst backtrace-get-section (&optional pos)
"Return the section of a backtrace frame at POS.
POS, if omitted or nil, defaults to point."
(get-text-property (or pos (point)) 'backtrace-section))
(defsubst backtrace-get-view (&optional pos)
"Return the view plist of the backtrace frame at POS.
POS, if omitted or nil, defaults to point."
(get-text-property (or pos (point)) 'backtrace-view))
(defsubst backtrace-get-form (&optional pos)
"Return the backtrace form data for the form printed at POS.
POS, if omitted or nil, defaults to point."
(get-text-property (or pos (point)) 'backtrace-form))
(defun backtrace-get-frame-start (&optional pos)
"Return the beginning position of the frame at POS in the buffer.
POS, if omitted or nil, defaults to point."
(let ((posn (or pos (point))))
(if (or (= (point-min) posn)
(not (eq (backtrace-get-index posn)
(backtrace-get-index (1- posn)))))
posn
(previous-single-property-change posn 'backtrace-index nil (point-min)))))
(defun backtrace-get-frame-end (&optional pos)
"Return the position of the end of the frame at POS in the buffer.
POS, if omitted or nil, defaults to point."
(next-single-property-change (or pos (point))
'backtrace-index nil (point-max)))
(defun backtrace-forward-frame ()
"Move forward to the beginning of the next frame."
(interactive)
(let ((max (backtrace-get-frame-end)))
(when (= max (point-max))
(user-error "No next stack frame"))
(goto-char max)))
(defun backtrace-backward-frame ()
"Move backward to the start of a stack frame."
(interactive)
(let ((current-index (backtrace-get-index))
(min (backtrace-get-frame-start)))
(if (or (and (/= (point) (point-max)) (null current-index))
(= min (point-min))
(and (= min (point))
(null (backtrace-get-index (1- min)))))
(user-error "No previous stack frame"))
(if (= min (point))
(goto-char (backtrace-get-frame-start (1- min)))
(goto-char min))))
;; Other Backtrace mode commands
(defun backtrace-revert (&rest _ignored)
"The `revert-buffer-function' for `backtrace-mode'.
It runs `backtrace-revert-hook', then calls `backtrace-print'."
(interactive)
(unless (derived-mode-p 'backtrace-mode)
(error "The current buffer is not in Backtrace mode"))
(run-hooks 'backtrace-revert-hook)
(backtrace-print t))
(defmacro backtrace--with-output-variables (view &rest body)
"Bind output variables according to VIEW and execute BODY."
(declare (indent 1))
`(let ((print-escape-control-characters t)
(print-escape-newlines t)
(print-circle (plist-get ,view :print-circle))
(standard-output (current-buffer)))
,@body))
(defun backtrace-toggle-locals (&optional all)
"Toggle the display of local variables for the backtrace frame at point.
With prefix argument ALL, toggle the value of :show-locals in
`backtrace-view', which affects all of the backtrace frames in
the buffer."
(interactive "P")
(if all
(let ((pos (make-marker))
(visible (not (plist-get backtrace-view :show-locals))))
(setq backtrace-view (plist-put backtrace-view :show-locals visible))
(set-marker-insertion-type pos t)
(set-marker pos (point))
(goto-char (point-min))
;; Skip the header.
(unless (backtrace-get-index)
(goto-char (backtrace-get-frame-end)))
(while (< (point) (point-max))
(backtrace--set-frame-locals-visible visible)
(goto-char (backtrace-get-frame-end)))
(goto-char pos)
(when (invisible-p pos)
(goto-char (backtrace-get-frame-start))))
(let ((index (backtrace-get-index)))
(unless index
(user-error "Not in a stack frame"))
(backtrace--set-frame-locals-visible
(not (plist-get (backtrace-get-view) :show-locals))))))
(defun backtrace--set-frame-locals-visible (visible)
"Set the visibility of the local vars for the frame at point to VISIBLE."
(let ((pos (point))
(index (backtrace-get-index))
(start (backtrace-get-frame-start))
(end (backtrace-get-frame-end))
(view (copy-sequence (backtrace-get-view)))
(inhibit-read-only t))
(setq view (plist-put view :show-locals visible))
(goto-char (backtrace-get-frame-start))
(while (not (or (= (point) end)
(eq (backtrace-get-section) 'locals)))
(goto-char (next-single-property-change (point)
'backtrace-section nil end)))
(cond
((and (= (point) end) visible)
;; The locals section doesn't exist so create it.
(let ((standard-output (current-buffer)))
(backtrace--with-output-variables view
(backtrace--print-locals
(nth index backtrace-frames) view))
(add-text-properties end (point) `(backtrace-index ,index))
(goto-char pos)))
((/= (point) end)
;; The locals section does exist, so add or remove the overlay.
(backtrace--set-locals-visible-overlay (point) end visible)
(goto-char (if (invisible-p pos) start pos))))
(add-text-properties start (backtrace-get-frame-end)
`(backtrace-view ,view))))
(defun backtrace--set-locals-visible-overlay (beg end visible)
(backtrace--change-button-skip beg end (not visible))
(if visible
(remove-overlays beg end 'invisible t)
(let ((o (make-overlay beg end)))
(overlay-put o 'invisible t)
(overlay-put o 'evaporate t))))
(defun backtrace--change-button-skip (beg end value)
"Change the skip property on all buttons between BEG and END.
Set it to VALUE unless the button is a `backtrace-ellipsis' button."
(let ((inhibit-read-only t))
(setq beg (next-button beg))
(while (and beg (< beg end))
(unless (eq (button-type beg) 'backtrace-ellipsis)
(button-put beg 'skip value))
(setq beg (next-button beg)))))
(defun backtrace-toggle-print-circle (&optional all)
"Toggle `print-circle' for the backtrace frame at point.
With prefix argument ALL, toggle the value of :print-circle in
`backtrace-view', which affects all of the backtrace frames in
the buffer."
(interactive "P")
(backtrace--toggle-feature :print-circle all))
(defun backtrace--toggle-feature (feature all)
"Toggle FEATURE for the current backtrace frame or for the buffer.
FEATURE should be one of the options in `backtrace-view'. If ALL
is non-nil, toggle FEATURE for all frames in the buffer. After
toggling the feature, reprint the affected frame(s). Afterwards
position point at the start of the frame it was in before."
(if all
(let ((index (backtrace-get-index))
(pos (point))
(at-end (= (point) (point-max)))
(value (not (plist-get backtrace-view feature))))
(setq backtrace-view (plist-put backtrace-view feature value))
(goto-char (point-min))
;; Skip the header.
(unless (backtrace-get-index)
(goto-char (backtrace-get-frame-end)))
(while (< (point) (point-max))
(backtrace--set-feature feature value)
(goto-char (backtrace-get-frame-end)))
(if (not index)
(goto-char (if at-end (point-max) pos))
(goto-char (point-min))
(while (and (not (eql index (backtrace-get-index)))
(< (point) (point-max)))
(goto-char (backtrace-get-frame-end)))))
(let ((index (backtrace-get-index)))
(unless index
(user-error "Not in a stack frame"))
(backtrace--set-feature feature
(not (plist-get (backtrace-get-view) feature))))))
(defun backtrace--set-feature (feature value)
"Set FEATURE in the view plist of the frame at point to VALUE.
Reprint the frame with the new view plist."
(let ((inhibit-read-only t)
(view (copy-sequence (backtrace-get-view)))
(index (backtrace-get-index))
(min (backtrace-get-frame-start))
(max (backtrace-get-frame-end)))
(setq view (plist-put view feature value))
(delete-region min max)
(goto-char min)
(backtrace-print-frame (nth index backtrace-frames) view)
(add-text-properties min (point)
`(backtrace-index ,index backtrace-view ,view))
(goto-char min)))
(defun backtrace-expand-ellipsis (button)
"Expand display of the elided form at BUTTON."
(interactive)
(goto-char (button-start button))
(unless (get-text-property (point) 'cl-print-ellipsis)
(if (and (> (point) (point-min))
(get-text-property (1- (point)) 'cl-print-ellipsis))
(backward-char)
(user-error "No ellipsis to expand here")))
(let* ((end (next-single-property-change (point) 'cl-print-ellipsis))
(begin (previous-single-property-change end 'cl-print-ellipsis))
(value (get-text-property begin 'cl-print-ellipsis))
(props (backtrace-get-text-properties begin))
(inhibit-read-only t))
(backtrace--with-output-variables (backtrace-get-view)
(delete-region begin end)
(insert (cl-print-to-string-with-limit #'cl-print-expand-ellipsis value
backtrace-line-length))
(setq end (point))
(goto-char begin)
(while (< (point) end)
(let ((next (next-single-property-change (point) 'cl-print-ellipsis
nil end)))
(when (get-text-property (point) 'cl-print-ellipsis)
(make-text-button (point) next :type 'backtrace-ellipsis))
(goto-char next)))
(goto-char begin)
(add-text-properties begin end props))))
(defun backtrace-expand-ellipses (&optional no-limit)
"Expand display of all \"...\"s in the backtrace frame at point.
\\<backtrace-mode-map>
Each ellipsis will be limited to `backtrace-line-length'
characters in its expansion. With optional prefix argument
NO-LIMIT, do not limit the number of characters. Note that with
or without the argument, using this command can result in very
long lines and very poor display performance. If this happens
and is a problem, use `\\[revert-buffer]' to return to the
initial state of the Backtrace buffer."
(interactive "P")
(save-excursion
(let ((start (backtrace-get-frame-start))
(end (backtrace-get-frame-end))
(backtrace-line-length (unless no-limit backtrace-line-length)))
(goto-char end)
(while (> (point) start)
(let ((next (previous-single-property-change (point) 'cl-print-ellipsis
nil start)))
(when (get-text-property (point) 'cl-print-ellipsis)
(push-button (point)))
(goto-char next))))))
(defun backtrace-multi-line ()
"Show the top level s-expression at point on multiple lines with indentation."
(interactive)
(backtrace--reformat-sexp #'backtrace--multi-line))
(defun backtrace--multi-line ()
"Pretty print the current buffer, then remove the trailing newline."
(set-syntax-table emacs-lisp-mode-syntax-table)
(pp-buffer)
(goto-char (1- (point-max)))
(delete-char 1))
(defun backtrace-single-line ()
"Show the top level s-expression at point on one line."
(interactive)
(backtrace--reformat-sexp #'backtrace--single-line))
(defun backtrace--single-line ()
"Replace line breaks and following indentation with spaces.
Works on the current buffer."
(goto-char (point-min))
(while (re-search-forward "\n[[:blank:]]*" nil t)
(replace-match " ")))
(defun backtrace--reformat-sexp (format-function)
"Reformat the top level sexp at point.
Locate the top level sexp at or following point on the same line,
and reformat it with FORMAT-FUNCTION, preserving the location of
point within the sexp. If no sexp is found before the end of
the line or buffer, signal an error.
FORMAT-FUNCTION will be called without arguments, with the
current buffer set to a temporary buffer containing only the
content of the sexp."
(let* ((orig-pos (point))
(pos (point))
(tag (backtrace-get-form pos))
(end (next-single-property-change pos 'backtrace-form))
(begin (previous-single-property-change end 'backtrace-form
nil (point-min))))
(unless tag
(when (or (= end (point-max)) (> end (point-at-eol)))
(user-error "No form here to reformat"))
(goto-char end)
(setq pos end
end (next-single-property-change pos 'backtrace-form)
begin (previous-single-property-change end 'backtrace-form
nil (point-min))))
(let* ((offset (when (>= orig-pos begin) (- orig-pos begin)))
(offset-marker (when offset (make-marker)))
(content (buffer-substring begin end))
(props (backtrace-get-text-properties begin))
(inhibit-read-only t))
(delete-region begin end)
(insert (with-temp-buffer
(insert content)
(when offset
(set-marker-insertion-type offset-marker t)
(set-marker offset-marker (+ (point-min) offset)))
(funcall format-function)
(when offset
(setq offset (- (marker-position offset-marker) (point-min))))
(buffer-string)))
(when offset
(set-marker offset-marker (+ begin offset)))
(save-excursion
(goto-char begin)
(indent-sexp))
(add-text-properties begin (point) props)
(if offset
(goto-char (marker-position offset-marker))
(goto-char orig-pos)))))
(defun backtrace-get-text-properties (pos)
"Return a plist of backtrace-mode's text properties at POS."
(apply #'append
(mapcar (lambda (prop)
(list prop (get-text-property pos prop)))
'(backtrace-section backtrace-index backtrace-view
backtrace-form))))
(defun backtrace-goto-source ()
"If its location is known, jump to the source code for the frame at point."
(interactive)
(let* ((index (or (backtrace-get-index) (user-error "Not in a stack frame")))
(frame (nth index backtrace-frames))
(source-available (plist-get (backtrace-frame-flags frame)
:source-available)))
(unless (and source-available
(catch 'done
(dolist (func backtrace-goto-source-functions)
(when (funcall func)
(throw 'done t)))))
(user-error "Source code location not known"))))
(defun backtrace-help-follow-symbol (&optional pos)
"Follow cross-reference at POS, defaulting to point.
For the cross-reference format, see `help-make-xrefs'."
(interactive "d")
(unless pos
(setq pos (point)))
(unless (push-button pos)
;; Check if the symbol under point is a function or variable.
(let ((sym
(intern
(save-excursion
(goto-char pos) (skip-syntax-backward "w_")
(buffer-substring (point)
(progn (skip-syntax-forward "w_")
(point)))))))
(when (or (boundp sym) (fboundp sym) (facep sym))
(describe-symbol sym)))))
;; Print backtrace frames
(defun backtrace-print (&optional remember-pos)
"Populate the current Backtrace mode buffer.
This erases the buffer and inserts printed representations of the
frames. Optional argument REMEMBER-POS, if non-nil, means to
move point to the entry with the same ID element as the current
line and recenter window line accordingly."
(let ((inhibit-read-only t)
entry-index saved-pt window-line)
(and remember-pos
(setq entry-index (backtrace-get-index))
(when (eq (window-buffer) (current-buffer))
(setq window-line
(count-screen-lines (window-start) (point)))))
(erase-buffer)
(when backtrace-insert-header-function
(funcall backtrace-insert-header-function))
(dotimes (idx (length backtrace-frames))
(let ((beg (point))
(elt (nth idx backtrace-frames)))
(and entry-index
(equal entry-index idx)
(setq entry-index nil
saved-pt (point)))
(backtrace-print-frame elt backtrace-view)
(add-text-properties
beg (point)
`(backtrace-index ,idx backtrace-view ,backtrace-view))))
(set-buffer-modified-p nil)
;; If REMEMBER-POS was specified, move to the "old" location.
(if saved-pt
(progn (goto-char saved-pt)
(when window-line
(recenter window-line)))
(goto-char (point-min)))))
;; Define button type used for ...'s.
;; Set skip property so you don't have to TAB through 100 of them to
;; get to the next function name.
(define-button-type 'backtrace-ellipsis
'skip t 'action #'backtrace-expand-ellipsis
'help-echo "mouse-2, RET: expand this ellipsis")
(defun backtrace-print-to-string (obj &optional limit)
"Return a printed representation of OBJ formatted for backtraces.
Attempt to get the length of the returned string under LIMIT
charcters with appropriate settings of `print-level' and
`print-length.' LIMIT defaults to `backtrace-line-length'."
(backtrace--with-output-variables backtrace-view
(backtrace--print-to-string obj limit)))
(defun backtrace--print-to-string (sexp &optional limit)
;; This is for use by callers who wrap the call with
;; backtrace--with-output-variables.
(setq limit (or limit backtrace-line-length))
(with-temp-buffer
(insert (cl-print-to-string-with-limit #'backtrace--print sexp limit))
;; Add a unique backtrace-form property.
(put-text-property (point-min) (point) 'backtrace-form (gensym))
;; Make buttons from all the "..."s. Since there might be many of
;; them, use text property buttons.
(goto-char (point-min))
(while (< (point) (point-max))
(let ((end (next-single-property-change (point) 'cl-print-ellipsis
nil (point-max))))
(when (get-text-property (point) 'cl-print-ellipsis)
(make-text-button (point) end :type 'backtrace-ellipsis))
(goto-char end)))
(buffer-string)))
(defun backtrace-print-frame (frame view)
"Insert a backtrace FRAME at point formatted according to VIEW.
Tag the sections of the frame with the `backtrace-section' text
property for use by navigation."
(backtrace--with-output-variables view
(backtrace--print-flags frame view)
(backtrace--print-func-and-args frame view)
(backtrace--print-locals frame view)))
(defun backtrace--print-flags (frame view)
"Print the flags of a backtrace FRAME if enabled in VIEW."
(let ((beg (point))
(flag (plist-get (backtrace-frame-flags frame) :debug-on-exit))
(source (plist-get (backtrace-frame-flags frame) :source-available)))
(when (plist-get view :show-flags)
(when source (insert ">"))
(when flag (insert "*")))
(insert (make-string (- backtrace--flags-width (- (point) beg)) ?\s))
(put-text-property beg (point) 'backtrace-section 'func)))
(defun backtrace--print-func-and-args (frame _view)
"Print the function, arguments and buffer position of a backtrace FRAME.
Format it according to VIEW."
(let* ((beg (point))
(evald (backtrace-frame-evald frame))
(fun (backtrace-frame-fun frame))
(args (backtrace-frame-args frame))
(def (and (symbolp fun) (fboundp fun) (symbol-function fun)))
(fun-file (or (symbol-file fun 'defun)
(and (subrp def)
(not (eq 'unevalled (cdr (subr-arity def))))
(find-lisp-object-file-name fun def))))
(fun-pt (point)))
(cond
((and evald (not debugger-stack-frame-as-list))
(if (atom fun)
(funcall backtrace-print-function fun)
(insert
(backtrace--print-to-string fun (when args (/ backtrace-line-length 2)))))
(if args
(insert (backtrace--print-to-string
args (max (truncate (/ backtrace-line-length 5))
(- backtrace-line-length (- (point) beg)))))
;; The backtrace-form property is so that backtrace-multi-line
;; will find it. backtrace-multi-line doesn't do anything
;; useful with it, just being consistent.
(let ((start (point)))
(insert "()")
(put-text-property start (point) 'backtrace-form t))))
(t
(let ((fun-and-args (cons fun args)))
(insert (backtrace--print-to-string fun-and-args)))
(cl-incf fun-pt)))
(when fun-file
(make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
:type 'help-function-def
'help-args (list fun fun-file)))
;; After any frame that uses eval-buffer, insert a comment that
;; states the buffer position it's reading at.
(when (backtrace-frame-pos frame)
(insert " ; Reading at ")
(let ((pos (point)))
(insert (format "buffer position %d" (backtrace-frame-pos frame)))
(make-button pos (point) :type 'backtrace-buffer-pos
'backtrace-buffer (backtrace-frame-buffer frame)
'backtrace-pos (backtrace-frame-pos frame))))
(insert "\n")
(put-text-property beg (point) 'backtrace-section 'func)))
(defun backtrace--print-locals (frame view)
"Print a backtrace FRAME's local variables according to VIEW.
Print them only if :show-locals is non-nil in the VIEW plist."
(when (plist-get view :show-locals)
(let* ((beg (point))
(locals (backtrace-frame-locals frame)))
(if (null locals)
(insert " [no locals]\n")
(pcase-dolist (`(,symbol . ,value) locals)
(insert " ")
(backtrace--print symbol)
(insert " = ")
(insert (backtrace--print-to-string value))
(insert "\n")))
(put-text-property beg (point) 'backtrace-section 'locals))))
(defun backtrace--print (obj &optional stream)
"Attempt to print OBJ to STREAM using `backtrace-print-function'.
Fall back to `prin1' if there is an error."
(condition-case err
(funcall backtrace-print-function obj stream)
(error
(message "Error in backtrace printer: %S" err)
(prin1 obj stream))))
(defun backtrace-update-flags ()
"Update the display of the flags in the backtrace frame at point."
(let ((view (backtrace-get-view))
(begin (backtrace-get-frame-start)))
(when (plist-get view :show-flags)
(save-excursion
(goto-char begin)
(let ((props (backtrace-get-text-properties begin))
(inhibit-read-only t)
(standard-output (current-buffer)))
(delete-char backtrace--flags-width)
(backtrace--print-flags (nth (backtrace-get-index) backtrace-frames)
view)
(add-text-properties begin (point) props))))))
(defun backtrace--filter-visible (beg end &optional _delete)
"Return the visible text between BEG and END."
(let ((result ""))
(while (< beg end)
(let ((next (next-single-char-property-change beg 'invisible)))
(unless (get-char-property beg 'invisible)
(setq result (concat result (buffer-substring beg (min end next)))))
(setq beg next)))
result))
;;; The mode definition
(define-derived-mode backtrace-mode special-mode "Backtrace"
"Generic major mode for examining an Elisp stack backtrace.
This mode can be used directly, or other major modes can be
derived from it, using `define-derived-mode'.
In this major mode, the buffer contains some optional lines of
header text followed by backtrace frames, each consisting of one
or more whole lines.
Letters in this mode do not insert themselves; instead they are
commands.
\\<backtrace-mode-map>
\\{backtrace-mode-map}
A mode which inherits from Backtrace mode, or a command which
creates a backtrace-mode buffer, should usually do the following:
- Set `backtrace-revert-hook', if the buffer contents need
to be specially recomputed prior to `revert-buffer'.
- Maybe set `backtrace-insert-header-function' to a function to create
header text for the buffer.
- Set `backtrace-frames' (see below).
- Maybe modify `backtrace-view' (see below).
- Maybe set `backtrace-print-function'.
A command which creates or switches to a Backtrace mode buffer,
such as `ert-results-pop-to-backtrace-for-test-at-point', should
initialize `backtrace-frames' to a list of `backtrace-frame'
objects (`backtrace-get-frames' is provided for that purpose, if
desired), and may optionally modify `backtrace-view', which is a
plist describing the appearance of the backtrace. Finally, it
should call `backtrace-print'.
`backtrace-print' calls `backtrace-insert-header-function'
followed by `backtrace-print-frame', once for each stack frame."
:syntax-table emacs-lisp-mode-syntax-table
(when backtrace-fontify
(setq font-lock-defaults
'((backtrace-font-lock-keywords
backtrace-font-lock-keywords-1
backtrace-font-lock-keywords-2)
nil nil nil nil
(font-lock-syntactic-face-function
. lisp-font-lock-syntactic-face-function))))
(setq truncate-lines t)
(buffer-disable-undo)
;; In debug.el, from 1998 to 2009 this was set to nil, reason stated
;; was because of bytecode. Since 2009 it's been set to t, but the
;; default is t so I think this isn't necessary.
;; (set-buffer-multibyte t)
(setq-local revert-buffer-function #'backtrace-revert)
(setq-local filter-buffer-substring-function #'backtrace--filter-visible)
(setq-local indent-line-function 'lisp-indent-line)
(setq-local indent-region-function 'lisp-indent-region)
(add-hook 'xref-backend-functions #'backtrace--xref-backend nil t))
(put 'backtrace-mode 'mode-class 'special)
;;; Backtrace printing
;;;###autoload
(defun backtrace ()
"Print a trace of Lisp function calls currently active.
Output stream used is value of `standard-output'."
(princ (backtrace-to-string (backtrace-get-frames 'backtrace)))
nil)
(defun backtrace-to-string(&optional frames)
"Format FRAMES, a list of `backtrace-frame' objects, for output.
Return the result as a string. If FRAMES is nil, use all
function calls currently active."
(unless frames (setq frames (backtrace-get-frames 'backtrace-to-string)))
(let ((backtrace-fontify nil))
(with-temp-buffer
(backtrace-mode)
(setq backtrace-view '(:show-flags t)
backtrace-frames frames
backtrace-print-function #'cl-prin1)
(backtrace-print)
(substring-no-properties (filter-buffer-substring (point-min)
(point-max))))))
(provide 'backtrace)
;;; backtrace.el ends here

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

@ -2083,10 +2083,7 @@ This is like `cl-flet', but for macros instead of functions.
\(fn ((NAME ARGLIST BODY...) ...) FORM...)"
(declare (indent 1)
(debug
((&rest (&define name (&rest arg) cl-declarations-or-string
def-body))
cl-declarations body)))
(debug (cl-macrolet-expr)))
(if (cdr bindings)
`(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body))
(if (null bindings) (macroexp-progn body)

301
lisp/emacs-lisp/cl-print.el
View file

@ -55,10 +55,19 @@ call other entry points instead, such as `cl-prin1'."
;; we should only use it for objects which don't have nesting.
(prin1 object stream))
(cl-defgeneric cl-print-object-contents (_object _start _stream)
"Dispatcher to print the contents of OBJECT on STREAM.
Print the contents starting with the item at START, without
delimiters."
;; Every cl-print-object method which can print an ellipsis should
;; have a matching cl-print-object-contents method to expand an
;; ellipsis.
(error "Missing cl-print-object-contents method"))
(cl-defmethod cl-print-object ((object cons) stream)
(if (and cl-print--depth (natnump print-level)
(> cl-print--depth print-level))
(princ "..." stream)
(cl-print-insert-ellipsis object 0 stream)
(let ((car (pop object))
(count 1))
(if (and print-quoted
@ -84,23 +93,60 @@ call other entry points instead, such as `cl-prin1'."
(princ " " stream)
(if (or (not (natnump print-length)) (> print-length count))
(cl-print-object (pop object) stream)
(princ "..." stream)
(cl-print-insert-ellipsis object print-length stream)
(setq object nil))
(cl-incf count))
(when object
(princ " . " stream) (cl-print-object object stream))
(princ ")" stream)))))
(cl-defmethod cl-print-object-contents ((object cons) _start stream)
(let ((count 0))
(while (and (consp object)
(not (cond
(cl-print--number-table
(numberp (gethash object cl-print--number-table)))
((memq object cl-print--currently-printing))
(t (push object cl-print--currently-printing)
nil))))
(unless (zerop count)
(princ " " stream))
(if (or (not (natnump print-length)) (> print-length count))
(cl-print-object (pop object) stream)
(cl-print-insert-ellipsis object print-length stream)
(setq object nil))
(cl-incf count))
(when object
(princ " . " stream) (cl-print-object object stream))))
(cl-defmethod cl-print-object ((object vector) stream)
(princ "[" stream)
(let ((count (length object)))
(dotimes (i (if (natnump print-length)
(min print-length count) count))
(unless (zerop i) (princ " " stream))
(cl-print-object (aref object i) stream))
(when (and (natnump print-length) (< print-length count))
(princ " ..." stream)))
(princ "]" stream))
(if (and cl-print--depth (natnump print-level)
(> cl-print--depth print-level))
(cl-print-insert-ellipsis object 0 stream)
(princ "[" stream)
(let* ((len (length object))
(limit (if (natnump print-length)
(min print-length len) len)))
(dotimes (i limit)
(unless (zerop i) (princ " " stream))
(cl-print-object (aref object i) stream))
(when (< limit len)
(princ " " stream)
(cl-print-insert-ellipsis object limit stream)))
(princ "]" stream)))
(cl-defmethod cl-print-object-contents ((object vector) start stream)
(let* ((len (length object))
(limit (if (natnump print-length)
(min (+ start print-length) len) len))
(i start))
(while (< i limit)
(unless (= i start) (princ " " stream))
(cl-print-object (aref object i) stream)
(cl-incf i))
(when (< limit len)
(princ " " stream)
(cl-print-insert-ellipsis object limit stream))))
(cl-defmethod cl-print-object ((object hash-table) stream)
(princ "#<hash-table " stream)
@ -109,7 +155,7 @@ call other entry points instead, such as `cl-prin1'."
(princ (hash-table-count object) stream)
(princ "/" stream)
(princ (hash-table-size object) stream)
(princ (format " 0x%x" (sxhash object)) stream)
(princ (format " %#x" (sxhash object)) stream)
(princ ">" stream))
(define-button-type 'help-byte-code
@ -166,7 +212,7 @@ into a button whose action shows the function's disassembly.")
(let ((button-start (and cl-print-compiled-button
(bufferp stream)
(with-current-buffer stream (point)))))
(princ (format "#<bytecode 0x%x>" (sxhash object)) stream)
(princ (format "#<bytecode %#x>" (sxhash object)) stream)
(when (eq cl-print-compiled 'static)
(princ " " stream)
(cl-print-object (aref object 2) stream))
@ -199,21 +245,135 @@ into a button whose action shows the function's disassembly.")
(princ ")" stream)))
(cl-defmethod cl-print-object ((object cl-structure-object) stream)
(princ "#s(" stream)
(if (and cl-print--depth (natnump print-level)
(> cl-print--depth print-level))
(cl-print-insert-ellipsis object 0 stream)
(princ "#s(" stream)
(let* ((class (cl-find-class (type-of object)))
(slots (cl--struct-class-slots class))
(len (length slots))
(limit (if (natnump print-length)
(min print-length len) len)))
(princ (cl--struct-class-name class) stream)
(dotimes (i limit)
(let ((slot (aref slots i)))
(princ " :" stream)
(princ (cl--slot-descriptor-name slot) stream)
(princ " " stream)
(cl-print-object (aref object (1+ i)) stream)))
(when (< limit len)
(princ " " stream)
(cl-print-insert-ellipsis object limit stream)))
(princ ")" stream)))
(cl-defmethod cl-print-object-contents ((object cl-structure-object) start stream)
(let* ((class (cl-find-class (type-of object)))
(slots (cl--struct-class-slots class))
(count (length slots)))
(princ (cl--struct-class-name class) stream)
(dotimes (i (if (natnump print-length)
(min print-length count) count))
(len (length slots))
(limit (if (natnump print-length)
(min (+ start print-length) len) len))
(i start))
(while (< i limit)
(let ((slot (aref slots i)))
(princ " :" stream)
(unless (= i start) (princ " " stream))
(princ ":" stream)
(princ (cl--slot-descriptor-name slot) stream)
(princ " " stream)
(cl-print-object (aref object (1+ i)) stream)))
(when (and (natnump print-length) (< print-length count))
(princ " ..." stream)))
(princ ")" stream))
(cl-print-object (aref object (1+ i)) stream))
(cl-incf i))
(when (< limit len)
(princ " " stream)
(cl-print-insert-ellipsis object limit stream))))
(cl-defmethod cl-print-object ((object string) stream)
(unless stream (setq stream standard-output))
(let* ((has-properties (or (text-properties-at 0 object)
(next-property-change 0 object)))
(len (length object))
(limit (if (natnump print-length) (min print-length len) len)))
(if (and has-properties
cl-print--depth
(natnump print-level)
(> cl-print--depth print-level))
(cl-print-insert-ellipsis object 0 stream)
;; Print all or part of the string
(when has-properties
(princ "#(" stream))
(if (= limit len)
(prin1 (if has-properties (substring-no-properties object) object)
stream)
(let ((part (concat (substring-no-properties object 0 limit) "...")))
(prin1 part stream)
(when (bufferp stream)
(with-current-buffer stream
(cl-print-propertize-ellipsis object limit
(- (point) 4)
(- (point) 1) stream)))))
;; Print the property list.
(when has-properties
(let* ((interval-limit (and (natnump print-length)
(max 1 (/ print-length 3))))
(interval-count 0)
(start-pos (if (text-properties-at 0 object)
0 (next-property-change 0 object)))
(end-pos (next-property-change start-pos object len)))
(while (and (or (null interval-limit)
(< interval-count interval-limit))
(< start-pos len))
(let ((props (text-properties-at start-pos object)))
(when props
(princ " " stream) (princ start-pos stream)
(princ " " stream) (princ end-pos stream)
(princ " " stream) (cl-print-object props stream)
(cl-incf interval-count))
(setq start-pos end-pos
end-pos (next-property-change start-pos object len))))
(when (< start-pos len)
(princ " " stream)
(cl-print-insert-ellipsis object (list start-pos) stream)))
(princ ")" stream)))))
(cl-defmethod cl-print-object-contents ((object string) start stream)
;; If START is an integer, it is an index into the string, and the
;; ellipsis that needs to be expanded is part of the string. If
;; START is a cons, its car is an index into the string, and the
;; ellipsis that needs to be expanded is in the property list.
(let* ((len (length object)))
(if (atom start)
;; Print part of the string.
(let* ((limit (if (natnump print-length)
(min (+ start print-length) len) len))
(substr (substring-no-properties object start limit))
(printed (prin1-to-string substr))
(trimmed (substring printed 1 (1- (length printed)))))
(princ trimmed)
(when (< limit len)
(cl-print-insert-ellipsis object limit stream)))
;; Print part of the property list.
(let* ((first t)
(interval-limit (and (natnump print-length)
(max 1 (/ print-length 3))))
(interval-count 0)
(start-pos (car start))
(end-pos (next-property-change start-pos object len)))
(while (and (or (null interval-limit)
(< interval-count interval-limit))
(< start-pos len))
(let ((props (text-properties-at start-pos object)))
(when props
(if first
(setq first nil)
(princ " " stream))
(princ start-pos stream)
(princ " " stream) (princ end-pos stream)
(princ " " stream) (cl-print-object props stream)
(cl-incf interval-count))
(setq start-pos end-pos
end-pos (next-property-change start-pos object len))))
(when (< start-pos len)
(princ " " stream)
(cl-print-insert-ellipsis object (list start-pos) stream))))))
;;; Circularity and sharing.
@ -275,8 +435,17 @@ into a button whose action shows the function's disassembly.")
(push cdr stack)
(push car stack))
((pred stringp)
;; We presumably won't print its text-properties.
nil)
(let* ((len (length object))
(start (if (text-properties-at 0 object)
0 (next-property-change 0 object)))
(end (and start
(next-property-change start object len))))
(while (and start (< start len))
(let ((props (text-properties-at start object)))
(when props
(push props stack))
(setq start end
end (next-property-change start object len))))))
((or (pred arrayp) (pred byte-code-function-p))
;; FIXME: Inefficient for char-tables!
(dotimes (i (length object))
@ -291,6 +460,48 @@ into a button whose action shows the function's disassembly.")
(cl-print--find-sharing object print-number-table)))
print-number-table))
(defun cl-print-insert-ellipsis (object start stream)
"Print \"...\" to STREAM with the `cl-print-ellipsis' text property.
Save state in the text property in order to print the elided part
of OBJECT later. START should be 0 if the whole OBJECT is being
elided, otherwise it should be an index or other pointer into the
internals of OBJECT which can be passed to
`cl-print-object-contents' at a future time."
(unless stream (setq stream standard-output))
(let ((ellipsis-start (and (bufferp stream)
(with-current-buffer stream (point)))))
(princ "..." stream)
(when ellipsis-start
(with-current-buffer stream
(cl-print-propertize-ellipsis object start ellipsis-start (point)
stream)))))
(defun cl-print-propertize-ellipsis (object start beg end stream)
"Add the `cl-print-ellipsis' property between BEG and END.
STREAM should be a buffer. OBJECT and START are as described in
`cl-print-insert-ellipsis'."
(let ((value (list object start cl-print--number-table
cl-print--currently-printing)))
(with-current-buffer stream
(put-text-property beg end 'cl-print-ellipsis value stream))))
;;;###autoload
(defun cl-print-expand-ellipsis (value stream)
"Print the expansion of an ellipsis to STREAM.
VALUE should be the value of the `cl-print-ellipsis' text property
which was attached to the ellipsis by `cl-prin1'."
(let ((cl-print--depth 1)
(object (nth 0 value))
(start (nth 1 value))
(cl-print--number-table (nth 2 value))
(print-number-table (nth 2 value))
(cl-print--currently-printing (nth 3 value)))
(when (eq object (car cl-print--currently-printing))
(pop cl-print--currently-printing))
(if (equal start 0)
(cl-print-object object stream)
(cl-print-object-contents object start stream))))
;;;###autoload
(defun cl-prin1 (object &optional stream)
"Print OBJECT on STREAM according to its type.
@ -313,5 +524,45 @@ node `(elisp)Output Variables'."
(cl-prin1 object (current-buffer))
(buffer-string)))
;;;###autoload
(defun cl-print-to-string-with-limit (print-function value limit)
"Return a string containing a printed representation of VALUE.
Attempt to get the length of the returned string under LIMIT
characters with appropriate settings of `print-level' and
`print-length.' Use PRINT-FUNCTION to print, which should take
the arguments VALUE and STREAM and which should respect
`print-length' and `print-level'. LIMIT may be nil or zero in
which case PRINT-FUNCTION will be called with `print-level' and
`print-length' bound to nil.
Use this function with `cl-prin1' to print an object,
abbreviating it with ellipses to fit within a size limit. Use
this function with `cl-prin1-expand-ellipsis' to expand an
ellipsis, abbreviating the expansion to stay within a size
limit."
(setq limit (and (natnump limit)
(not (zerop limit))
limit))
;; Since this is used by the debugger when stack space may be
;; limited, if you increase print-level here, add more depth in
;; call_debugger (bug#31919).
(let* ((print-length (when limit (min limit 50)))
(print-level (when limit (min 8 (truncate (log limit)))))
(delta (when limit
(max 1 (truncate (/ print-length print-level))))))
(with-temp-buffer
(catch 'done
(while t
(erase-buffer)
(funcall print-function value (current-buffer))
;; Stop when either print-level is too low or the value is
;; successfully printed in the space allowed.
(when (or (not limit)
(< (- (point-max) (point-min)) limit)
(= print-level 2))
(throw 'done (buffer-string)))
(cl-decf print-level)
(cl-decf print-length delta))))))
(provide 'cl-print)
;;; cl-print.el ends here

463
lisp/emacs-lisp/debug.el
View file

@ -28,6 +28,7 @@
;;; Code:
(require 'cl-lib)
(require 'backtrace)
(require 'button)
(defgroup debugger nil
@ -133,6 +134,25 @@ where CAUSE can be:
- exit: called because of exit of a flagged function.
- error: called because of `debug-on-error'.")
(cl-defstruct (debugger--buffer-state
(:constructor debugger--save-buffer-state
(&aux (mode major-mode)
(header backtrace-insert-header-function)
(frames backtrace-frames)
(content (buffer-string))
(pos (point)))))
mode header frames content pos)
(defun debugger--restore-buffer-state (state)
(unless (derived-mode-p (debugger--buffer-state-mode state))
(funcall (debugger--buffer-state-mode state)))
(setq backtrace-insert-header-function (debugger--buffer-state-header state)
backtrace-frames (debugger--buffer-state-frames state))
(let ((inhibit-read-only t))
(erase-buffer)
(insert (debugger--buffer-state-content state)))
(goto-char (debugger--buffer-state-pos state)))
;;;###autoload
(setq debugger 'debug)
;;;###autoload
@ -174,7 +194,7 @@ first will be printed into the backtrace buffer."
(debugger-previous-state
(if (get-buffer "*Backtrace*")
(with-current-buffer (get-buffer "*Backtrace*")
(list major-mode (buffer-string)))))
(debugger--save-buffer-state))))
(debugger-args args)
(debugger-buffer (get-buffer-create "*Backtrace*"))
(debugger-old-buffer (current-buffer))
@ -236,7 +256,8 @@ first will be printed into the backtrace buffer."
(window-total-height debugger-window)))
(error nil)))
(setq debugger-previous-window debugger-window))
(debugger-mode)
(unless (derived-mode-p 'debugger-mode)
(debugger-mode))
(debugger-setup-buffer debugger-args)
(when noninteractive
;; If the backtrace is long, save the beginning
@ -280,15 +301,14 @@ first will be printed into the backtrace buffer."
(setq debugger-previous-window nil))
;; Restore previous state of debugger-buffer in case we were
;; in a recursive invocation of the debugger, otherwise just
;; erase the buffer and put it into fundamental mode.
;; erase the buffer.
(when (buffer-live-p debugger-buffer)
(with-current-buffer debugger-buffer
(let ((inhibit-read-only t))
(erase-buffer)
(if (null debugger-previous-state)
(fundamental-mode)
(insert (nth 1 debugger-previous-state))
(funcall (nth 0 debugger-previous-state))))))
(if debugger-previous-state
(debugger--restore-buffer-state debugger-previous-state)
(setq backtrace-insert-header-function nil)
(setq backtrace-frames nil)
(backtrace-print))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
(setq debug-on-next-call debugger-step-after-exit)
@ -301,112 +321,80 @@ first will be printed into the backtrace buffer."
(message "Error in debug printer: %S" err)
(prin1 obj stream))))
(defun debugger-insert-backtrace (frames do-xrefs)
"Format and insert the backtrace FRAMES at point.
Make functions into cross-reference buttons if DO-XREFS is non-nil."
(let ((standard-output (current-buffer))
(eval-buffers eval-buffer-list))
(require 'help-mode) ; Define `help-function-def' button type.
(pcase-dolist (`(,evald ,fun ,args ,flags) frames)
(insert (if (plist-get flags :debug-on-exit)
"* " " "))
(let ((fun-file (and do-xrefs (symbol-file fun 'defun)))
(fun-pt (point)))
(cond
((and evald (not debugger-stack-frame-as-list))
(debugger--print fun)
(if args (debugger--print args) (princ "()")))
(t
(debugger--print (cons fun args))
(cl-incf fun-pt)))
(when fun-file
(make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
:type 'help-function-def
'help-args (list fun fun-file))))
;; After any frame that uses eval-buffer, insert a line that
;; states the buffer position it's reading at.
(when (and eval-buffers (memq fun '(eval-buffer eval-region)))
(insert (format " ; Reading at buffer position %d"
;; This will get the wrong result if there are
;; two nested eval-region calls for the same
;; buffer. That's not a very useful case.
(with-current-buffer (pop eval-buffers)
(point)))))
(insert "\n"))))
(defun debugger-setup-buffer (args)
"Initialize the `*Backtrace*' buffer for entry to the debugger.
That buffer should be current already."
(setq buffer-read-only nil)
(erase-buffer)
(set-buffer-multibyte t) ;Why was it nil ? -stef
(setq buffer-undo-list t)
That buffer should be current already and in debugger-mode."
(setq backtrace-frames (nthcdr
;; Remove debug--implement-debug-on-entry and the
;; advice's `apply' frame.
(if (eq (car args) 'debug) 3 1)
(backtrace-get-frames 'debug)))
(when (eq (car-safe args) 'exit)
(setq debugger-value (nth 1 args))
(setf (cl-getf (backtrace-frame-flags (car backtrace-frames))
:debug-on-exit)
nil))
(setq backtrace-view (plist-put backtrace-view :show-flags t)
backtrace-insert-header-function (lambda ()
(debugger--insert-header args))
backtrace-print-function debugger-print-function)
(backtrace-print)
;; Place point on "stack frame 0" (bug#15101).
(goto-char (point-min))
(search-forward ":" (line-end-position) t)
(when (and (< (point) (line-end-position))
(= (char-after) ?\s))
(forward-char)))
(defun debugger--insert-header (args)
"Insert the header for the debugger's Backtrace buffer.
Include the reason for debugger entry from ARGS."
(insert "Debugger entered")
(let ((frames (nthcdr
;; Remove debug--implement-debug-on-entry and the
;; advice's `apply' frame.
(if (eq (car args) 'debug) 3 1)
(backtrace-frames 'debug)))
(print-escape-newlines t)
(print-escape-control-characters t)
;; If you increase print-level, add more depth in call_debugger.
(print-level 8)
(print-length 50)
(pos (point)))
(pcase (car args)
;; lambda is for debug-on-call when a function call is next.
;; debug is for debug-on-entry function called.
((or `lambda `debug)
(insert "--entering a function:\n")
(setq pos (1- (point))))
;; Exiting a function.
(`exit
(insert "--returning value: ")
(setq pos (point))
(setq debugger-value (nth 1 args))
(debugger--print debugger-value (current-buffer))
(setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil)
(insert ?\n))
;; Watchpoint triggered.
((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
(insert
"--"
(pcase details
(`(makunbound nil) (format "making %s void" symbol))
(`(makunbound ,buffer) (format "killing local value of %s in buffer %s"
symbol buffer))
(`(defvaralias ,_) (format "aliasing %s to %s" symbol newval))
(`(let ,_) (format "let-binding %s to %S" symbol newval))
(`(unlet ,_) (format "ending let-binding of %s" symbol))
(`(set nil) (format "setting %s to %S" symbol newval))
(`(set ,buffer) (format "setting %s in buffer %s to %S"
symbol buffer newval))
(_ (error "unrecognized watchpoint triggered %S" (cdr args))))
": ")
(setq pos (point))
(insert ?\n))
;; Debugger entered for an error.
(`error
(insert "--Lisp error: ")
(setq pos (point))
(debugger--print (nth 1 args) (current-buffer))
(insert ?\n))
;; debug-on-call, when the next thing is an eval.
(`t
(insert "--beginning evaluation of function call form:\n")
(setq pos (1- (point))))
;; User calls debug directly.
(_
(insert ": ")
(setq pos (point))
(debugger--print
(if (eq (car args) 'nil)
(cdr args) args)
(current-buffer))
(insert ?\n)))
(debugger-insert-backtrace frames t)
;; Place point on "stack frame 0" (bug#15101).
(goto-char pos)))
(pcase (car args)
;; lambda is for debug-on-call when a function call is next.
;; debug is for debug-on-entry function called.
((or `lambda `debug)
(insert "--entering a function:\n"))
;; Exiting a function.
(`exit
(insert "--returning value: ")
(insert (backtrace-print-to-string debugger-value))
(insert ?\n))
;; Watchpoint triggered.
((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
(insert
"--"
(pcase details
(`(makunbound nil) (format "making %s void" symbol))
(`(makunbound ,buffer) (format "killing local value of %s in buffer %s"
symbol buffer))
(`(defvaralias ,_) (format "aliasing %s to %s" symbol newval))
(`(let ,_) (format "let-binding %s to %s" symbol
(backtrace-print-to-string newval)))
(`(unlet ,_) (format "ending let-binding of %s" symbol))
(`(set nil) (format "setting %s to %s" symbol
(backtrace-print-to-string newval)))
(`(set ,buffer) (format "setting %s in buffer %s to %s"
symbol buffer
(backtrace-print-to-string newval)))
(_ (error "unrecognized watchpoint triggered %S" (cdr args))))
": ")
(insert ?\n))
;; Debugger entered for an error.
(`error
(insert "--Lisp error: ")
(insert (backtrace-print-to-string (nth 1 args)))
(insert ?\n))
;; debug-on-call, when the next thing is an eval.
(`t
(insert "--beginning evaluation of function call form:\n"))
;; User calls debug directly.
(_
(insert ": ")
(insert (backtrace-print-to-string (if (eq (car args) 'nil)
(cdr args) args)))
(insert ?\n))))
(defun debugger-step-through ()
@ -426,12 +414,12 @@ Enter another debugger on next entry to eval, apply or funcall."
(unless debugger-may-continue
(error "Cannot continue"))
(message "Continuing.")
(save-excursion
;; Check to see if we've flagged some frame for debug-on-exit, in which
;; case we'll probably come back to the debugger soon.
(goto-char (point-min))
(if (re-search-forward "^\\* " nil t)
(setq debugger-will-be-back t)))
;; Check to see if we've flagged some frame for debug-on-exit, in which
;; case we'll probably come back to the debugger soon.
(dolist (frame backtrace-frames)
(when (plist-get (backtrace-frame-flags frame) :debug-on-exit)
(setq debugger-will-be-back t)))
(exit-recursive-edit))
(defun debugger-return-value (val)
@ -446,12 +434,11 @@ will be used, such as in a debug on exit from a frame."
(setq debugger-value val)
(princ "Returning " t)
(debugger--print debugger-value)
(save-excursion
;; Check to see if we've flagged some frame for debug-on-exit, in which
;; case we'll probably come back to the debugger soon.
(goto-char (point-min))
(if (re-search-forward "^\\* " nil t)
(setq debugger-will-be-back t)))
(dolist (frame backtrace-frames)
(when (plist-get (backtrace-frame-flags frame) :debug-on-exit)
(setq debugger-will-be-back t)))
(exit-recursive-edit))
(defun debugger-jump ()
@ -473,63 +460,40 @@ removes itself from that hook."
(defun debugger-frame-number (&optional skip-base)
"Return number of frames in backtrace before the one point points at."
(save-excursion
(beginning-of-line)
(if (looking-at " *;;;\\|[a-z]")
(error "This line is not a function call"))
(let ((opoint (point))
(count 0))
(unless skip-base
(let ((index (backtrace-get-index))
(count 0))
(unless index
(error "This line is not a function call"))
(unless skip-base
(while (not (eq (cadr (backtrace-frame count)) 'debug))
(setq count (1+ count)))
;; Skip debug--implement-debug-on-entry frame.
(when (eq 'debug--implement-debug-on-entry
(cadr (backtrace-frame (1+ count))))
(setq count (+ 2 count))))
(goto-char (point-min))
(when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
(goto-char (match-end 0))
(forward-sexp 1))
(forward-line 1)
(while (progn
(forward-char 2)
(cond ((debugger--locals-visible-p)
(goto-char (next-single-char-property-change
(point) 'locals-visible)))
((= (following-char) ?\()
(forward-sexp 1))
(t
(forward-sexp 2)))
(forward-line 1)
(<= (point) opoint))
(if (looking-at " *;;;")
(forward-line 1))
(setq count (1+ count)))
count)))
(+ count index)))
(defun debugger-frame ()
"Request entry to debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
(interactive)
(backtrace-debug (debugger-frame-number) t)
(beginning-of-line)
(if (= (following-char) ? )
(let ((inhibit-read-only t))
(delete-char 1)
(insert ?*)))
(beginning-of-line))
(setf
(cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames))
:debug-on-exit)
t)
(backtrace-update-flags))
(defun debugger-frame-clear ()
"Do not enter debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
(interactive)
(backtrace-debug (debugger-frame-number) nil)
(beginning-of-line)
(if (= (following-char) ?*)
(let ((inhibit-read-only t))
(delete-char 1)
(insert ? )))
(beginning-of-line))
(setf
(cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames))
:debug-on-exit)
nil)
(backtrace-update-flags))
(defmacro debugger-env-macro (&rest body)
"Run BODY in original environment."
@ -564,69 +528,10 @@ The environment used is the one when entering the activation frame at point."
(let ((str (eval-expression-print-format val)))
(if str (princ str t))))))))
(defun debugger--locals-visible-p ()
"Are the local variables of the current stack frame visible?"
(save-excursion
(move-to-column 2)
(get-text-property (point) 'locals-visible)))
(defun debugger--insert-locals (locals)
"Insert the local variables LOCALS at point."
(cond ((null locals)
(insert "\n [no locals]"))
(t
(let ((print-escape-newlines t))
(dolist (s+v locals)
(let ((symbol (car s+v))
(value (cdr s+v)))
(insert "\n ")
(prin1 symbol (current-buffer))
(insert " = ")
(debugger--print value (current-buffer))))))))
(defun debugger--show-locals ()
"For the frame at point, insert locals and add text properties."
(let* ((nframe (1+ (debugger-frame-number 'skip-base)))
(base (debugger--backtrace-base))
(locals (backtrace--locals nframe base))
(inhibit-read-only t))
(save-excursion
(let ((start (progn
(move-to-column 2)
(point))))
(end-of-line)
(debugger--insert-locals locals)
(add-text-properties start (point) '(locals-visible t))))))
(defun debugger--hide-locals ()
"Delete local variables and remove the text property."
(let* ((col (current-column))
(end (progn
(move-to-column 2)
(next-single-char-property-change (point) 'locals-visible)))
(start (previous-single-char-property-change end 'locals-visible))
(inhibit-read-only t))
(remove-text-properties start end '(locals-visible))
(goto-char start)
(end-of-line)
(delete-region (point) end)
(move-to-column col)))
(defun debugger-toggle-locals ()
"Show or hide local variables of the current stack frame."
(interactive)
(cond ((debugger--locals-visible-p)
(debugger--hide-locals))
(t
(debugger--show-locals))))
(defvar debugger-mode-map
(let ((map (make-keymap))
(menu-map (make-sparse-keymap)))
(set-keymap-parent map button-buffer-map)
(suppress-keymap map)
(define-key map "-" 'negative-argument)
(let ((map (make-keymap)))
(set-keymap-parent map backtrace-mode-map)
(define-key map "b" 'debugger-frame)
(define-key map "c" 'debugger-continue)
(define-key map "j" 'debugger-jump)
@ -634,63 +539,47 @@ The environment used is the one when entering the activation frame at point."
(define-key map "u" 'debugger-frame-clear)
(define-key map "d" 'debugger-step-through)
(define-key map "l" 'debugger-list-functions)
(define-key map "h" 'describe-mode)
(define-key map "q" 'top-level)
(define-key map "q" 'debugger-quit)
(define-key map "e" 'debugger-eval-expression)
(define-key map "v" 'debugger-toggle-locals) ; "v" is for "variables".
(define-key map " " 'next-line)
(define-key map "R" 'debugger-record-expression)
(define-key map "\C-m" 'debug-help-follow)
(define-key map [mouse-2] 'push-button)
(define-key map [menu-bar debugger] (cons "Debugger" menu-map))
(define-key menu-map [deb-top]
'(menu-item "Quit" top-level
:help "Quit debugging and return to top level"))
(define-key menu-map [deb-s0] '("--"))
(define-key menu-map [deb-descr]
'(menu-item "Describe Debugger Mode" describe-mode
:help "Display documentation for debugger-mode"))
(define-key menu-map [deb-hfol]
'(menu-item "Help Follow" debug-help-follow
:help "Follow cross-reference"))
(define-key menu-map [deb-nxt]
'(menu-item "Next Line" next-line
:help "Move cursor down"))
(define-key menu-map [deb-s1] '("--"))
(define-key menu-map [deb-lfunc]
'(menu-item "List debug on entry functions" debugger-list-functions
:help "Display a list of all the functions now set to debug on entry"))
(define-key menu-map [deb-fclear]
'(menu-item "Cancel debug frame" debugger-frame-clear
:help "Do not enter debugger when this frame exits"))
(define-key menu-map [deb-frame]
'(menu-item "Debug frame" debugger-frame
:help "Request entry to debugger when this frame exits"))
(define-key menu-map [deb-s2] '("--"))
(define-key menu-map [deb-ret]
'(menu-item "Return value..." debugger-return-value
:help "Continue, specifying value to return."))
(define-key menu-map [deb-rec]
'(menu-item "Display and Record Expression" debugger-record-expression
:help "Display a variable's value and record it in `*Backtrace-record*' buffer"))
(define-key menu-map [deb-eval]
'(menu-item "Eval Expression..." debugger-eval-expression
:help "Eval an expression, in an environment like that outside the debugger"))
(define-key menu-map [deb-jump]
'(menu-item "Jump" debugger-jump
:help "Continue to exit from this frame, with all debug-on-entry suspended"))
(define-key menu-map [deb-cont]
'(menu-item "Continue" debugger-continue
:help "Continue, evaluating this expression without stopping"))
(define-key menu-map [deb-step]
'(menu-item "Step through" debugger-step-through
:help "Proceed, stepping through subexpressions of this expression"))
(easy-menu-define nil map ""
'("Debugger"
["Step through" debugger-step-through
:help "Proceed, stepping through subexpressions of this expression"]
["Continue" debugger-continue
:help "Continue, evaluating this expression without stopping"]
["Jump" debugger-jump
:help "Continue to exit from this frame, with all debug-on-entry suspended"]
["Eval Expression..." debugger-eval-expression
:help "Eval an expression, in an environment like that outside the debugger"]
["Display and Record Expression" debugger-record-expression
:help "Display a variable's value and record it in `*Backtrace-record*' buffer"]
["Return value..." debugger-return-value
:help "Continue, specifying value to return."]
"--"
["Debug frame" debugger-frame
:help "Request entry to debugger when this frame exits"]
["Cancel debug frame" debugger-frame-clear
:help "Do not enter debugger when this frame exits"]
["List debug on entry functions" debugger-list-functions
:help "Display a list of all the functions now set to debug on entry"]
"--"
["Next Line" next-line
:help "Move cursor down"]
["Help for Symbol" backtrace-help-follow-symbol
:help "Show help for symbol at point"]
["Describe Debugger Mode" describe-mode
:help "Display documentation for debugger-mode"]
"--"
["Quit" debugger-quit
:help "Quit debugging and return to top level"]))
map))
(put 'debugger-mode 'mode-class 'special)
(define-derived-mode debugger-mode fundamental-mode "Debugger"
"Mode for backtrace buffers, selected in debugger.
(define-derived-mode debugger-mode backtrace-mode "Debugger"
"Mode for debugging Emacs Lisp using a backtrace.
\\<debugger-mode-map>
A line starts with `*' if exiting that frame will call the debugger.
Type \\[debugger-frame] or \\[debugger-frame-clear] to set or remove the `*'.
@ -704,8 +593,6 @@ which functions will enter the debugger when called.
Complete list of commands:
\\{debugger-mode-map}"
(setq truncate-lines t)
(set-syntax-table emacs-lisp-mode-syntax-table)
(add-hook 'kill-buffer-hook
(lambda () (if (> (recursion-depth) 0) (top-level)))
nil t)
@ -732,27 +619,6 @@ Complete list of commands:
(buffer-substring (line-beginning-position 0)
(line-end-position 0)))))
(defun debug-help-follow (&optional pos)
"Follow cross-reference at POS, defaulting to point.
For the cross-reference format, see `help-make-xrefs'."
(interactive "d")
;; Ideally we'd just do (call-interactively 'help-follow) except that this
;; assumes we're already in a *Help* buffer and reuses it, so it ends up
;; incorrectly "reusing" the *Backtrace* buffer to show the help info.
(unless pos
(setq pos (point)))
(unless (push-button pos)
;; check if the symbol under point is a function or variable
(let ((sym
(intern
(save-excursion
(goto-char pos) (skip-syntax-backward "w_")
(buffer-substring (point)
(progn (skip-syntax-forward "w_")
(point)))))))
(when (or (boundp sym) (fboundp sym) (facep sym))
(describe-symbol sym)))))
;; When you change this, you may also need to change the number of
;; frames that the debugger skips.
@ -853,6 +719,13 @@ To specify a nil argument interactively, exit with an empty minibuffer."
;;(princ "be set to debug on entry, even if it is in the list.")
)))))
(defun debugger-quit ()
"Quit debugging and return to the top level."
(interactive)
(if (= (recursion-depth) 0)
(quit-window)
(top-level)))
(defun debug--implement-debug-watch (symbol newval op where)
"Conditionally call the debugger.
This function is called when SYMBOL's value is modified."

28
lisp/emacs-lisp/easy-mmode.el
View file

@ -474,22 +474,26 @@ See `%s' for more information on %s."
;; The function that calls TURN-ON in each buffer.
(defun ,MODE-enable-in-buffers ()
(dolist (buf ,MODE-buffers)
(when (buffer-live-p buf)
(with-current-buffer buf
(unless ,MODE-set-explicitly
(unless (eq ,MODE-major-mode major-mode)
(if ,mode
(progn
(,mode -1)
(funcall #',turn-on))
(funcall #',turn-on))))
(setq ,MODE-major-mode major-mode)))))
(let ((buffers ,MODE-buffers))
;; Clear MODE-buffers to avoid scanning the same list of
;; buffers in recursive calls to MODE-enable-in-buffers.
;; Otherwise it could lead to infinite recursion.
(setq ,MODE-buffers nil)
(dolist (buf buffers)
(when (buffer-live-p buf)
(with-current-buffer buf
(unless ,MODE-set-explicitly
(unless (eq ,MODE-major-mode major-mode)
(if ,mode
(progn
(,mode -1)
(funcall #',turn-on))
(funcall #',turn-on))))
(setq ,MODE-major-mode major-mode))))))
(put ',MODE-enable-in-buffers 'definition-name ',global-mode)
(defun ,MODE-check-buffers ()
(,MODE-enable-in-buffers)
(setq ,MODE-buffers nil)
(remove-hook 'post-command-hook ',MODE-check-buffers))
(put ',MODE-check-buffers 'definition-name ',global-mode)

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

@ -52,6 +52,7 @@
;;; Code:
(require 'backtrace)
(require 'macroexp)
(require 'cl-lib)
(eval-when-compile (require 'pcase))
@ -206,8 +207,7 @@ Use this with caution since it is not debugged."
"Non-nil if Edebug should unwrap results of expressions.
That is, Edebug will try to remove its own instrumentation from the result.
This is useful when debugging macros where the results of expressions
are instrumented expressions. But don't do this when results might be
circular or an infinite loop will result."
are instrumented expressions."
:type 'boolean
:group 'edebug)
@ -1198,6 +1198,8 @@ purpose by adding an entry to this alist, and setting
(defvar edebug-inside-func) ;; whether code is inside function context.
;; Currently def-form sets this to nil; def-body sets it to t.
(defvar edebug--cl-macrolet-defs) ;; Fully defined below.
(defun edebug-interactive-p-name ()
;; Return a unique symbol for the variable used to store the
;; status of interactive-p for this function.
@ -1263,25 +1265,59 @@ purpose by adding an entry to this alist, and setting
(defun edebug-unwrap (sexp)
"Return the unwrapped SEXP or return it as is if it is not wrapped.
The SEXP might be the result of wrapping a body, which is a list of
expressions; a `progn' form will be returned enclosing these forms."
(if (consp sexp)
(cond
((eq 'edebug-after (car sexp))
(nth 3 sexp))
((eq 'edebug-enter (car sexp))
(macroexp-progn (nthcdr 2 (nth 1 (nth 3 sexp)))))
(t sexp);; otherwise it is not wrapped, so just return it.
)
sexp))
expressions; a `progn' form will be returned enclosing these forms.
Does not unwrap inside vectors, records, structures, or hash tables."
(pcase sexp
(`(edebug-after ,_before-form ,_after-index ,form)
form)
(`(lambda ,args (edebug-enter ',_sym ,_arglist
(function (lambda nil . ,body))))
`(lambda ,args ,@body))
(`(closure ,env ,args (edebug-enter ',_sym ,_arglist
(function (lambda nil . ,body))))
`(closure ,env ,args ,@body))
(`(edebug-enter ',_sym ,_args (function (lambda nil . ,body)))
(macroexp-progn body))
(_ sexp)))
(defun edebug-unwrap* (sexp)
"Return the SEXP recursively unwrapped."
(let ((ht (make-hash-table :test 'eq)))
(edebug--unwrap1 sexp ht)))
(defun edebug--unwrap1 (sexp hash-table)
"Unwrap SEXP using HASH-TABLE of things already unwrapped.
HASH-TABLE contains the results of unwrapping cons cells within
SEXP, which are reused to avoid infinite loops when SEXP is or
contains a circular object."
(let ((new-sexp (edebug-unwrap sexp)))
(while (not (eq sexp new-sexp))
(setq sexp new-sexp
new-sexp (edebug-unwrap sexp)))
(if (consp new-sexp)
(mapcar #'edebug-unwrap* new-sexp)
(let ((result (gethash new-sexp hash-table nil)))
(unless result
(let ((remainder new-sexp)
current)
(setq result (cons nil nil)
current result)
(while
(progn
(puthash remainder current hash-table)
(setf (car current)
(edebug--unwrap1 (car remainder) hash-table))
(setq remainder (cdr remainder))
(cond
((atom remainder)
(setf (cdr current)
(edebug--unwrap1 remainder hash-table))
nil)
((gethash remainder hash-table nil)
(setf (cdr current) (gethash remainder hash-table nil))
nil)
(t (setq current
(setf (cdr current) (cons nil nil)))))))))
result)
new-sexp)))
@ -1463,6 +1499,11 @@ expressions; a `progn' form will be returned enclosing these forms."
;; Helper for edebug-list-form
(let ((spec (get-edebug-spec head)))
(cond
;; Treat cl-macrolet bindings like macros with no spec.
((member head edebug--cl-macrolet-defs)
(if edebug-eval-macro-args
(edebug-forms cursor)
(edebug-sexps cursor)))
(spec
(cond
((consp spec)
@ -1651,6 +1692,9 @@ expressions; a `progn' form will be returned enclosing these forms."
;; (function . edebug-match-function)
(lambda-expr . edebug-match-lambda-expr)
(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)
(cl-macrolet-body . edebug-match-cl-macrolet-body)
(&not . edebug-match-&not)
(&key . edebug-match-&key)
(place . edebug-match-place)
@ -1954,6 +1998,43 @@ expressions; a `progn' form will be returned enclosing these forms."
(edebug-move-cursor cursor)
(list args)))
(defvar edebug--cl-macrolet-defs nil
"List of symbols found within the bindings of enclosing `cl-macrolet' forms.")
(defvar edebug--current-cl-macrolet-defs nil
"List of symbols found within the bindings of the current `cl-macrolet' form.")
(defun edebug-match-cl-macrolet-expr (cursor)
"Match a `cl-macrolet' form at CURSOR."
(let (edebug--current-cl-macrolet-defs)
(edebug-match cursor
'((&rest (&define cl-macrolet-name cl-macro-list
cl-declarations-or-string
def-body))
cl-declarations cl-macrolet-body))))
(defun edebug-match-cl-macrolet-name (cursor)
"Match the name in a `cl-macrolet' binding at CURSOR.
Collect the names in `edebug--cl-macrolet-defs' where they
will be checked by `edebug-list-form-args' and treated as
macros without a spec."
(let ((name (edebug-top-element-required cursor "Expected name")))
(when (not (symbolp name))
(edebug-no-match cursor "Bad name:" name))
;; Change edebug-def-name to avoid conflicts with
;; names at global scope.
(setq edebug-def-name (gensym "edebug-anon"))
(edebug-move-cursor cursor)
(push name edebug--current-cl-macrolet-defs)
(list name)))
(defun edebug-match-cl-macrolet-body (cursor)
"Match the body of a `cl-macrolet' expression at CURSOR.
Put the definitions collected in `edebug--current-cl-macrolet-defs'
into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
(let ((edebug--cl-macrolet-defs (nconc edebug--current-cl-macrolet-defs
edebug--cl-macrolet-defs)))
(edebug-match-body cursor)))
(defun edebug-match-arg (cursor)
;; set the def-args bound in edebug-defining-form
(let ((edebug-arg (edebug-top-element-required cursor "Expected arg")))
@ -3611,7 +3692,7 @@ be installed in `emacs-lisp-mode-map'.")
;; misc
(define-key map "?" 'edebug-help)
(define-key map "d" 'edebug-backtrace)
(define-key map "d" 'edebug-pop-to-backtrace)
(define-key map "-" 'negative-argument)
@ -3869,8 +3950,10 @@ Global commands prefixed by `global-edebug-prefix':
;; (setq debugger 'debug) ; use the standard debugger
;; Note that debug and its utilities must be byte-compiled to work,
;; since they depend on the backtrace looking a certain way. But
;; edebug is not dependent on this, yet.
;; since they depend on the backtrace looking a certain way. Edebug
;; will work if not byte-compiled, but it will not be able correctly
;; remove its instrumentation from backtraces unless it is
;; byte-compiled.
(defun edebug (&optional arg-mode &rest args)
"Replacement for `debug'.
@ -3900,49 +3983,136 @@ Otherwise call `debug' normally."
(apply #'debug arg-mode args)
))
;;; Backtrace buffer
(defun edebug-backtrace ()
"Display a non-working backtrace. Better than nothing..."
(defvar-local edebug-backtrace-frames nil
"Stack frames of the current Edebug Backtrace buffer without instrumentation.
This should be a list of `edebug---frame' objects.")
(defvar-local edebug-instrumented-backtrace-frames nil
"Stack frames of the current Edebug Backtrace buffer with instrumentation.
This should be a list of `edebug---frame' objects.")
;; Data structure for backtrace frames with information
;; from Edebug instrumentation found in the backtrace.
(cl-defstruct
(edebug--frame
(:constructor edebug--make-frame)
(:include backtrace-frame))
def-name before-index after-index)
(defun edebug-pop-to-backtrace ()
"Display the current backtrace in a `backtrace-mode' window."
(interactive)
(if (or (not edebug-backtrace-buffer)
(null (buffer-name edebug-backtrace-buffer)))
(setq edebug-backtrace-buffer
(generate-new-buffer "*Backtrace*"))
(generate-new-buffer "*Edebug Backtrace*"))
;; Else, could just display edebug-backtrace-buffer.
)
(with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer)
(setq edebug-backtrace-buffer standard-output)
(let ((print-escape-newlines t)
(print-length 50) ; FIXME cf edebug-safe-prin1-to-string
last-ok-point)
(backtrace)
(pop-to-buffer edebug-backtrace-buffer)
(unless (derived-mode-p 'backtrace-mode)
(backtrace-mode)
(add-hook 'backtrace-goto-source-functions 'edebug--backtrace-goto-source))
(setq edebug-instrumented-backtrace-frames
(backtrace-get-frames 'edebug-debugger
:constructor #'edebug--make-frame)
edebug-backtrace-frames (edebug--strip-instrumentation
edebug-instrumented-backtrace-frames)
backtrace-frames edebug-backtrace-frames)
(backtrace-print)
(goto-char (point-min)))
;; Clean up the backtrace.
;; Not quite right for current edebug scheme.
(set-buffer edebug-backtrace-buffer)
(setq truncate-lines t)
(goto-char (point-min))
(setq last-ok-point (point))
(if t (progn
(defun edebug--strip-instrumentation (frames)
"Return a new list of backtrace frames with instrumentation removed.
Remove frames for Edebug's functions and the lambdas in
`edebug-enter' wrappers. Fill in the def-name, before-index
and after-index fields in both FRAMES and the returned list
of deinstrumented frames, for those frames where the source
code location is known."
(let (skip-next-lambda def-name before-index after-index results
(index (length frames)))
(dolist (frame (reverse frames))
(let ((new-frame (copy-edebug--frame frame))
(fun (edebug--frame-fun frame))
(args (edebug--frame-args frame)))
(cl-decf index)
(pcase fun
('edebug-enter
(setq skip-next-lambda t
def-name (nth 0 args)))
('edebug-after
(setq before-index (if (consp (nth 0 args))
(nth 1 (nth 0 args))
(nth 0 args))
after-index (nth 1 args)))
((pred edebug--symbol-not-prefixed-p)
(edebug--unwrap-frame new-frame)
(edebug--add-source-info new-frame def-name before-index after-index)
(edebug--add-source-info frame def-name before-index after-index)
(push new-frame results)
(setq before-index nil
after-index nil))
(`(,(or 'lambda 'closure) . ,_)
(unless skip-next-lambda
(edebug--unwrap-frame new-frame)
(edebug--add-source-info frame def-name before-index after-index)
(edebug--add-source-info new-frame def-name before-index after-index)
(push new-frame results))
(setq before-index nil
after-index nil
skip-next-lambda nil)))))
results))
;; Delete interspersed edebug internals.
(while (re-search-forward "^ (?edebug" nil t)
(beginning-of-line)
(cond
((looking-at "^ (edebug-after")
;; Previous lines may contain code, so just delete this line.
(setq last-ok-point (point))
(forward-line 1)
(delete-region last-ok-point (point)))
(defun edebug--symbol-not-prefixed-p (sym)
"Return non-nil if SYM is a symbol not prefixed by \"edebug-\"."
(and (symbolp sym)
(not (string-prefix-p "edebug-" (symbol-name sym)))))
((looking-at (if debugger-stack-frame-as-list
"^ (edebug"
"^ edebug"))
(forward-line 1)
(delete-region last-ok-point (point))
)))
)))))
(defun edebug--unwrap-frame (frame)
"Remove Edebug's instrumentation from FRAME.
Strip it from the function and any unevaluated arguments."
(setf (edebug--frame-fun frame) (edebug-unwrap* (edebug--frame-fun frame)))
(unless (edebug--frame-evald frame)
(let (results)
(dolist (arg (edebug--frame-args frame))
(push (edebug-unwrap* arg) results))
(setf (edebug--frame-args frame) (nreverse results)))))
(defun edebug--add-source-info (frame def-name before-index after-index)
"Update FRAME with the additional info needed by an edebug--frame.
Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME."
(when (and before-index def-name)
(setf (edebug--frame-flags frame)
(plist-put (copy-sequence (edebug--frame-flags frame))
:source-available t)))
(setf (edebug--frame-def-name frame) (and before-index def-name))
(setf (edebug--frame-before-index frame) before-index)
(setf (edebug--frame-after-index frame) after-index))
(defun edebug--backtrace-goto-source ()
(let* ((index (backtrace-get-index))
(frame (nth index backtrace-frames)))
(when (edebug--frame-def-name frame)
(let* ((data (get (edebug--frame-def-name frame) 'edebug))
(marker (nth 0 data))
(offsets (nth 2 data)))
(pop-to-buffer (marker-buffer marker))
(goto-char (+ (marker-position marker)
(aref offsets (edebug--frame-before-index frame))))))))
(defun edebug-backtrace-show-instrumentation ()
"Show Edebug's instrumentation in an Edebug Backtrace buffer."
(interactive)
(unless (eq backtrace-frames edebug-instrumented-backtrace-frames)
(setq backtrace-frames edebug-instrumented-backtrace-frames)
(revert-buffer)))
(defun edebug-backtrace-hide-instrumentation ()
"Hide Edebug's instrumentation in an Edebug Backtrace buffer."
(interactive)
(unless (eq backtrace-frames edebug-backtrace-frames)
(setq backtrace-frames edebug-backtrace-frames)
(revert-buffer)))
;;; Trace display
@ -4116,7 +4286,7 @@ It is removed when you hit any char."
["Bounce to Current Point" edebug-bounce-point t]
["View Outside Windows" edebug-view-outside t]
["Previous Result" edebug-previous-result t]
["Show Backtrace" edebug-backtrace t]
["Show Backtrace" edebug-pop-to-backtrace t]
["Display Freq Count" edebug-display-freq-count t])
("Eval"

41
lisp/emacs-lisp/ert.el
View file

@ -60,6 +60,7 @@
(require 'cl-lib)
(require 'button)
(require 'debug)
(require 'backtrace)
(require 'easymenu)
(require 'ewoc)
(require 'find-func)
@ -677,13 +678,6 @@ and is displayed in front of the value of MESSAGE-FORM."
(cl-defstruct (ert-test-aborted-with-non-local-exit
(:include ert-test-result)))
(defun ert--print-backtrace (backtrace do-xrefs)
"Format the backtrace BACKTRACE to the current buffer."
(let ((print-escape-newlines t)
(print-level 8)
(print-length 50))
(debugger-insert-backtrace backtrace do-xrefs)))
;; A container for the state of the execution of a single test and
;; environment data needed during its execution.
(cl-defstruct ert--test-execution-info
@ -732,7 +726,7 @@ run. ARGS are the arguments to `debugger'."
;; use.
;;
;; Grab the frames above the debugger.
(backtrace (cdr (backtrace-frames debugger)))
(backtrace (cdr (backtrace-get-frames debugger)))
(infos (reverse ert--infos)))
(setf (ert--test-execution-info-result info)
(cl-ecase type
@ -1406,9 +1400,8 @@ Returns the stats object."
(ert-test-result-with-condition
(message "Test %S backtrace:" (ert-test-name test))
(with-temp-buffer
(ert--print-backtrace
(ert-test-result-with-condition-backtrace result)
nil)
(insert (backtrace-to-string
(ert-test-result-with-condition-backtrace result)))
(if (not ert-batch-backtrace-right-margin)
(message "%s"
(buffer-substring-no-properties (point-min)
@ -2450,20 +2443,20 @@ To be used in the ERT results buffer."
(cl-etypecase result
(ert-test-passed (error "Test passed, no backtrace available"))
(ert-test-result-with-condition
(let ((backtrace (ert-test-result-with-condition-backtrace result))
(buffer (get-buffer-create "*ERT Backtrace*")))
(let ((buffer (get-buffer-create "*ERT Backtrace*")))
(pop-to-buffer buffer)
(let ((inhibit-read-only t))
(buffer-disable-undo)
(erase-buffer)
(ert-simple-view-mode)
(set-buffer-multibyte t) ; mimic debugger-setup-buffer
(setq truncate-lines t)
(ert--print-backtrace backtrace t)
(goto-char (point-min))
(insert (substitute-command-keys "Backtrace for test `"))
(ert-insert-test-name-button (ert-test-name test))
(insert (substitute-command-keys "':\n"))))))))
(unless (derived-mode-p 'backtrace-mode)
(backtrace-mode))
(setq backtrace-insert-header-function
(lambda () (ert--insert-backtrace-header (ert-test-name test)))
backtrace-frames (ert-test-result-with-condition-backtrace result))
(backtrace-print)
(goto-char (point-min)))))))
(defun ert--insert-backtrace-header (name)
(insert (substitute-command-keys "Backtrace for test `"))
(ert-insert-test-name-button name)
(insert (substitute-command-keys "':\n")))
(defun ert-results-pop-to-messages-for-test-at-point ()
"Display the part of the *Messages* buffer generated during the test at point.

26
lisp/emacs-lisp/lisp-mode.el
View file

@ -517,6 +517,16 @@ This will generate compile-time constants from BINDINGS."
(defvar lisp-cl-font-lock-keywords lisp-cl-font-lock-keywords-1
"Default expressions to highlight in Lisp modes.")
;; Support backtrace mode.
(defconst lisp-el-font-lock-keywords-for-backtraces lisp-el-font-lock-keywords
"Default highlighting from Emacs Lisp mod used in Backtrace mode.")
(defconst lisp-el-font-lock-keywords-for-backtraces-1 lisp-el-font-lock-keywords-1
"Subdued highlighting from Emacs Lisp mode used in Backtrace mode.")
(defconst lisp-el-font-lock-keywords-for-backtraces-2
(remove (assoc 'lisp--match-hidden-arg lisp-el-font-lock-keywords-2)
lisp-el-font-lock-keywords-2)
"Gaudy highlighting from Emacs Lisp mode used in Backtrace mode.")
(defun lisp-string-in-doc-position-p (listbeg startpos)
"Return true if a doc string may occur at STARTPOS inside a list.
LISTBEG is the position of the start of the innermost list
@ -1196,7 +1206,21 @@ ENDPOS is encountered."
(if endpos endpos
;; Get error now if we don't have a complete sexp
;; after point.
(save-excursion (forward-sexp 1) (point)))))
(save-excursion
(let ((eol (line-end-position)))
(forward-sexp 1)
;; We actually look for a sexp which ends
;; after the current line so that we properly
;; indent things like #s(...). This might not
;; be needed if Bug#15998 is fixed.
(condition-case ()
(while (and (< (point) eol) (not (eobp)))
(forward-sexp 1))
;; But don't signal an error for incomplete
;; sexps following the first complete sexp
;; after point.
(scan-error nil)))
(point)))))
(save-excursion
(while (let ((indent (lisp-indent-calc-next parse-state))
(ppss (lisp-indent-state-ppss parse-state)))

18
lisp/emacs-lisp/map-ynp.el
View file

@ -257,10 +257,15 @@ C-g to quit (cancel the whole command);
;; either long or short answers.
;; For backward compatibility check if short y/n answers are preferred.
(defcustom read-answer-short (eq (symbol-function 'yes-or-no-p) 'y-or-n-p)
"If non-nil, accept short answers to the question."
:type 'boolean
:version "27.1"
(defcustom read-answer-short 'auto
"If non-nil, `read-answer' accepts single-character answers.
If t, accept short (single key-press) answers to the question.
If nil, require long answers. If `auto', accept short answers if
the function cell of `yes-or-no-p' is set to `y-or-on-p'."
:type '(choice (const :tag "Accept short answers" t)
(const :tag "Require long answer" nil)
(const :tag "Guess preference" auto))
:version "26.2"
:group 'minibuffer)
(defconst read-answer-map--memoize (make-hash-table :weakness 'key :test 'equal))
@ -290,8 +295,9 @@ When `read-answer-short' is non-nil, accept short answers.
Return a long answer even in case of accepting short ones.
When `use-dialog-box' is t, pop up a dialog window to get user input."
(custom-reevaluate-setting 'read-answer-short)
(let* ((short read-answer-short)
(let* ((short (if (eq read-answer-short 'auto)
(eq (symbol-function 'yes-or-no-p) 'y-or-n-p)
read-answer-short))
(answers-with-help
(if (assoc "help" answers)
answers

30
lisp/emacs-lisp/rx.el
View file

@ -1183,24 +1183,28 @@ enclosed in `(and ...)'.
(pcase-defmacro rx (&rest regexps)
"Build a `pcase' pattern matching `rx' regexps.
The REGEXPS are interpreted as by `rx'. The pattern matches if
the regular expression so constructed matches EXPVAL, as if
by `string-match'.
"Build a `pcase' pattern matching `rx' REGEXPS in sexp form.
The REGEXPS are interpreted as in `rx'. The pattern matches any
string that is a match for the regular expression so constructed,
as if by `string-match'.
In addition to the usual `rx' constructs, REGEXPS can contain the
following constructs:
(let VAR FORM...) creates a new explicitly numbered submatch
that matches FORM and binds the match to
VAR.
(backref VAR) creates a backreference to the submatch
introduced by a previous (let VAR ...)
construct.
(let REF SEXP...) creates a new explicitly named reference to
a submatch that matches regular expressions
SEXP, and binds the match to REF.
(backref REF) creates a backreference to the submatch
introduced by a previous (let REF ...)
construct. REF can be the same symbol
in the first argument of the corresponding
(let REF ...) construct, or it can be a
submatch number. It matches the referenced
submatch.
The VARs are associated with explicitly numbered submatches
starting from 1. Multiple occurrences of the same VAR refer to
the same submatch.
The REFs are associated with explicitly named submatches starting
from 1. Multiple occurrences of the same REF refer to the same
submatch.
If a case matches, the match data is modified as usual so you can
use it in the case body, but you still have to pass the correct

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

@ -211,7 +211,7 @@ The variable list SPEC is the same as in `if-let'."
(defsubst string-join (strings &optional separator)
"Join all STRINGS using SEPARATOR."
(mapconcat 'identity strings separator))
(mapconcat #'identity strings separator))
(define-obsolete-function-alias 'string-reverse 'reverse "25.1")
@ -219,17 +219,17 @@ The variable list SPEC is the same as in `if-let'."
"Trim STRING of leading string matching REGEXP.
REGEXP defaults to \"[ \\t\\n\\r]+\"."
(if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+")"\\)") string)
(replace-match "" t t string)
(if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
(substring string (match-end 0))
string))
(defsubst string-trim-right (string &optional regexp)
"Trim STRING of trailing string matching REGEXP.
REGEXP defaults to \"[ \\t\\n\\r]+\"."
(if (string-match (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") string)
(replace-match "" t t string)
string))
(let ((i (string-match-p (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
string)))
(if i (substring string 0 i) string)))
(defsubst string-trim (string &optional trim-left trim-right)
"Trim STRING of leading and trailing strings matching TRIM-LEFT and TRIM-RIGHT.

6
lisp/env.el
View file

@ -113,11 +113,11 @@ Changes ENV by side-effect, and returns its new value."
(not keep-empty)
env
(stringp (car env))
(string-match pattern (car env)))
(string-match-p pattern (car env)))
(cdr env)
;; Try to find existing entry for VARIABLE in ENV.
(while (and scan (stringp (car scan)))
(when (string-match pattern (car scan))
(when (string-match-p pattern (car scan))
(if value
(setcar scan (concat variable "=" value))
(if keep-empty
@ -184,7 +184,7 @@ a side-effect."
(setq variable (encode-coding-string variable locale-coding-system)))
(if (and value (multibyte-string-p value))
(setq value (encode-coding-string value locale-coding-system)))
(if (string-match "=" variable)
(if (string-match-p "=" variable)
(error "Environment variable name `%s' contains `='" variable))
(if (string-equal "TZ" variable)
(set-time-zone-rule value))

27
lisp/epg-config.el
View file

@ -98,11 +98,14 @@ Note that the buffer name starts with a space."
:type 'boolean)
(defconst epg-gpg-minimum-version "1.4.3")
(defconst epg-gpg2-minimum-version "2.1.6")
(defconst epg-config--program-alist
`((OpenPGP
epg-gpg-program
("gpg2" . "2.1.6") ("gpg" . ,epg-gpg-minimum-version))
("gpg2" . ,epg-gpg2-minimum-version)
("gpg" . ((,epg-gpg-minimum-version . "2.0")
,epg-gpg2-minimum-version)))
(CMS
epg-gpgsm-program
("gpgsm" . "2.0.4")))
@ -228,14 +231,26 @@ version requirement is met."
(epg-config--make-gpg-configuration epg-gpg-program))
;;;###autoload
(defun epg-check-configuration (config &optional minimum-version)
"Verify that a sufficient version of GnuPG is installed."
(defun epg-check-configuration (config &optional req-versions)
"Verify that a sufficient version of GnuPG is installed.
CONFIG should be a `epg-configuration' object (a plist).
REQ-VERSIONS should be a list with elements of the form (MIN
. MAX) where MIN and MAX are version strings indicating a
semi-open range of acceptable versions. REQ-VERSIONS may also be
a single minimum version string."
(let ((version (alist-get 'version config)))
(unless (stringp version)
(error "Undetermined version: %S" version))
(unless (version<= (or minimum-version
epg-gpg-minimum-version)
version)
(catch 'version-ok
(pcase-dolist ((or `(,min . ,max)
(and min (let max nil)))
(if (listp req-versions) req-versions
(list req-versions)))
(when (and (version<= (or min epg-gpg-minimum-version)
version)
(or (null max)
(version< version max)))
(throw 'version-ok t)))
(error "Unsupported version: %s" version))))
;;;###autoload

3
lisp/eshell/em-dirs.el
View file

@ -407,6 +407,7 @@ in the minibuffer:
nil))))
(put 'eshell/cd 'eshell-no-numeric-conversions t)
(put 'eshell/cd 'eshell-filename-arguments t)
(defun eshell-add-to-dir-ring (path)
"Add PATH to the last-dir-ring, if applicable."
@ -470,6 +471,7 @@ in the minibuffer:
nil)
(put 'eshell/pushd 'eshell-no-numeric-conversions t)
(put 'eshell/pushd 'eshell-filename-arguments t)
;;; popd [+n]
(defun eshell/popd (&rest args)
@ -500,6 +502,7 @@ in the minibuffer:
nil)
(put 'eshell/popd 'eshell-no-numeric-conversions t)
(put 'eshell/pop 'eshell-filename-arguments t)
(defun eshell/dirs (&optional if-verbose)
"Implementation of dirs in Lisp."

1
lisp/eshell/em-ls.el
View file

@ -334,6 +334,7 @@ instead."
(apply 'eshell-do-ls args)))
(put 'eshell/ls 'eshell-no-numeric-conversions t)
(put 'eshell/ls 'eshell-filename-arguments t)
(declare-function eshell-glob-regexp "em-glob" (pattern))

10
lisp/eshell/em-unix.el
View file

@ -307,6 +307,7 @@ Remove (unlink) the FILE(s).")
nil))
(put 'eshell/rm 'eshell-no-numeric-conversions t)
(put 'eshell/rm 'eshell-filename-arguments t)
(defun eshell/mkdir (&rest args)
"Implementation of mkdir in Lisp."
@ -324,6 +325,7 @@ Create the DIRECTORY(ies), if they do not already exist.")
nil))
(put 'eshell/mkdir 'eshell-no-numeric-conversions t)
(put 'eshell/mkdir 'eshell-filename-arguments t)
(defun eshell/rmdir (&rest args)
"Implementation of rmdir in Lisp."
@ -340,6 +342,7 @@ Remove the DIRECTORY(ies), if they are empty.")
nil))
(put 'eshell/rmdir 'eshell-no-numeric-conversions t)
(put 'eshell/rmdir 'eshell-filename-arguments t)
(defvar no-dereference)
@ -524,6 +527,7 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY.
eshell-mv-overwrite-files))))
(put 'eshell/mv 'eshell-no-numeric-conversions t)
(put 'eshell/mv 'eshell-filename-arguments t)
(defun eshell/cp (&rest args)
"Implementation of cp in Lisp."
@ -561,6 +565,7 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.")
eshell-cp-overwrite-files preserve)))
(put 'eshell/cp 'eshell-no-numeric-conversions t)
(put 'eshell/cp 'eshell-filename-arguments t)
(defun eshell/ln (&rest args)
"Implementation of ln in Lisp."
@ -593,6 +598,7 @@ with `--symbolic'. When creating hard links, each TARGET must exist.")
eshell-ln-overwrite-files))))
(put 'eshell/ln 'eshell-no-numeric-conversions t)
(put 'eshell/ln 'eshell-filename-arguments t)
(defun eshell/cat (&rest args)
"Implementation of cat in Lisp.
@ -645,6 +651,7 @@ Concatenate FILE(s), or standard input, to standard output.")
(setq eshell-ensure-newline-p nil))))
(put 'eshell/cat 'eshell-no-numeric-conversions t)
(put 'eshell/cat 'eshell-filename-arguments t)
;; special front-end functions for compilation-mode buffers
@ -927,6 +934,8 @@ Summarize disk usage of each FILE, recursively for directories.")
(eshell-print (concat (eshell-du-size-string size)
"total\n"))))))))
(put 'eshell/du 'eshell-filename-arguments t)
(defvar eshell-time-start nil)
(defun eshell-show-elapsed-time ()
@ -1029,6 +1038,7 @@ Show wall-clock time elapsed during execution of COMMAND.")
nil)
(put 'eshell/diff 'eshell-no-numeric-conversions t)
(put 'eshell/diff 'eshell-filename-arguments t)
(defvar locate-history-list)

51
lisp/eshell/esh-cmd.el
View file

@ -1304,27 +1304,36 @@ messages, and errors."
"Insert Lisp OBJECT, using ARGS if a function."
(catch 'eshell-external ; deferred to an external command
(let* ((eshell-ensure-newline-p (eshell-interactive-output-p))
(result
(if (functionp object)
(progn
(setq eshell-last-arguments args
eshell-last-command-name
(concat "#<function " (symbol-name object) ">"))
;; if any of the arguments are flagged as numbers
;; waiting for conversion, convert them now
(unless (get object 'eshell-no-numeric-conversions)
(while args
(let ((arg (car args)))
(if (and (stringp arg)
(> (length arg) 0)
(not (text-property-not-all
0 (length arg) 'number t arg)))
(setcar args (string-to-number arg))))
(setq args (cdr args))))
(eshell-apply object eshell-last-arguments))
(setq eshell-last-arguments args
eshell-last-command-name "#<Lisp object>")
(eshell-eval object))))
(result
(if (functionp object)
(progn
(setq eshell-last-arguments args
eshell-last-command-name
(concat "#<function " (symbol-name object) ">"))
(let ((numeric (not (get object
'eshell-no-numeric-conversions)))
(fname-args (get object 'eshell-filename-arguments)))
(when (or numeric fname-args)
(while args
(let ((arg (car args)))
(cond ((and numeric (stringp arg) (> (length arg) 0)
(text-property-any 0 (length arg)
'number t arg))
;; If any of the arguments are
;; flagged as numbers waiting for
;; conversion, convert them now.
(setcar args (string-to-number arg)))
((and fname-args (stringp arg)
(string-equal arg "~"))
;; If any of the arguments match "~",
;; prepend "./" to treat it as a
;; regular file name.
(setcar args (concat "./" arg)))))
(setq args (cdr args)))))
(eshell-apply object eshell-last-arguments))
(setq eshell-last-arguments args
eshell-last-command-name "#<Lisp object>")
(eshell-eval object))))
(if (and eshell-ensure-newline-p
(save-excursion
(goto-char eshell-last-output-end)

1
lisp/eshell/esh-ext.el
View file

@ -259,6 +259,7 @@ Adds the given PATH to $PATH.")
(eshell-printn dir)))))
(put 'eshell/addpath 'eshell-no-numeric-conversions t)
(put 'eshell/addpath 'eshell-filename-arguments t)
(defun eshell-script-interpreter (file)
"Extract the script to run from FILE, if it has #!<interp> in it.

22
lisp/files.el
View file

@ -1830,7 +1830,7 @@ killed."
;; Don't use `find-file' because it may end up using another window
;; in some corner cases, e.g. when the selected window is
;; softly-dedicated.
(let ((newbuf (find-file-noselect filename wildcards)))
(let ((newbuf (find-file-noselect filename nil nil wildcards)))
(switch-to-buffer newbuf)))
(when (eq obuf (current-buffer))
;; This executes if find-file gets an error
@ -1954,7 +1954,7 @@ started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)."
(save-match-data
(string-match "^[a-zA-`]:/$" filename))))
(equal (get 'abbreviated-home-dir 'home)
(expand-file-name "~")))
(save-match-data (expand-file-name "~"))))
(setq filename
(concat "~"
(match-string 1 filename)
@ -5091,6 +5091,9 @@ Before and after saving the buffer, this function runs
(make-directory dir t)
(error "Canceled")))
(setq setmodes (basic-save-buffer-1)))))
;; We are hunting a nasty error, which happens on hydra.
;; Adding traces might help.
(if (getenv "BUG_32226") (message "BUG_32226"))
;; Now we have saved the current buffer. Let's make sure
;; that buffer-file-coding-system is fixed to what
;; actually used for saving by binding it locally.
@ -5519,6 +5522,21 @@ raised."
(dolist (dir create-list)
(files--ensure-directory dir)))))))
(defun make-empty-file (filename &optional parents)
"Create an empty file FILENAME.
Optional arg PARENTS, if non-nil then creates parent dirs as needed.
If called interactively, then PARENTS is non-nil."
(interactive
(let ((filename (read-file-name "Create empty file: ")))
(list filename t)))
(when (and (file-exists-p filename) (null parents))
(signal 'file-already-exists `("File exists" ,filename)))
(let ((paren-dir (file-name-directory filename)))
(when (and paren-dir (not (file-exists-p paren-dir)))
(make-directory paren-dir parents)))
(write-region "" nil filename nil 0))
(defconst directory-files-no-dot-files-regexp
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
"Regexp matching any file name except \".\" and \"..\".")

2
lisp/format.el
View file

@ -539,6 +539,8 @@ Compare using `equal'."
(setq tail next)))
(cons acopy bcopy)))
(define-obsolete-function-alias 'format-proper-list-p 'proper-list-p "27.1")
(defun format-reorder (items order)
"Arrange ITEMS to follow partial ORDER.
Elements of ITEMS equal to elements of ORDER will be rearranged

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

@ -1626,6 +1626,12 @@ resources when reading email groups (and therefore stops
tracking), but allows loading external resources when reading
from NNTP newsgroups and the like.
People controlling these external resources won't be able to tell
that any one person in particular has read the message (since
it's in a public venue, many people will end up loading that
resource), but they'll be able to tell that somebody from your IP
address has accessed the resource.
This can also be a function to be evaluated. If so, it will be
called with the group name as the parameter, and should return a
regexp."

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

@ -4310,10 +4310,10 @@ If SELECT-ARTICLES, only select those articles from GROUP."
If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even
if it was already present.
If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs
will not be entered in the DEPENDENCIES table. Otherwise duplicate
Message-IDs will be renamed to a unique Message-ID before being
entered.
If `gnus-summary-ignore-duplicates' is non-nil then duplicate
Message-IDs will not be entered in the DEPENDENCIES table.
Otherwise duplicate Message-IDs will be renamed to a unique
Message-ID before being entered.
Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
(let* ((id (mail-header-id header))

14
lisp/ielm.el
View file

@ -612,17 +612,19 @@ Customized bindings may be defined in `ielm-map', which currently contains:
;;; User command
;;;###autoload
(defun ielm nil
(defun ielm (&optional buf-name)
"Interactively evaluate Emacs Lisp expressions.
Switches to the buffer `*ielm*', or creates it if it does not exist.
Switches to the buffer named BUF-NAME if provided (`*ielm*' by default),
or creates it if it does not exist.
See `inferior-emacs-lisp-mode' for details."
(interactive)
(let (old-point)
(unless (comint-check-proc "*ielm*")
(with-current-buffer (get-buffer-create "*ielm*")
(let (old-point
(buf-name (or buf-name "*ielm*")))
(unless (comint-check-proc buf-name)
(with-current-buffer (get-buffer-create buf-name)
(unless (zerop (buffer-size)) (setq old-point (point)))
(inferior-emacs-lisp-mode)))
(pop-to-buffer-same-window "*ielm*")
(pop-to-buffer-same-window buf-name)
(when old-point (push-mark old-point))))
(provide 'ielm)

13
lisp/imenu.el
View file

@ -832,15 +832,14 @@ depending on PATTERNS."
(dolist (item index-alist)
(when (listp item)
(setcdr item (sort (cdr item) 'imenu--sort-by-position))))
(let ((main-element (assq nil index-alist)))
(nconc (delq main-element (delq 'dummy index-alist))
(cdr main-element)))
;; Remove any empty menus. That can happen because of skipping
;; things inside comments or strings.
(when (consp (car index-alist))
(setq index-alist (cl-delete-if-not
(lambda (it) (cdr it))
index-alist)))))
(setq index-alist (cl-delete-if
(lambda (it) (and (consp it) (null (cdr it))))
index-alist))
(let ((main-element (assq nil index-alist)))
(nconc (delq main-element (delq 'dummy index-alist))
(cdr main-element)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;

9
lisp/indent.el
View file

@ -292,7 +292,8 @@ indentation by specifying a large negative ARG."
"Indent current line to COLUMN.
This function removes or adds spaces and tabs at beginning of line
only if necessary. It leaves point at end of indentation."
(back-to-indentation)
(beginning-of-line 1)
(skip-chars-forward " \t")
(let ((cur-col (current-column)))
(cond ((< cur-col column)
(if (>= (- column (* (/ cur-col tab-width) tab-width)) tab-width)
@ -303,8 +304,10 @@ only if necessary. It leaves point at end of indentation."
(delete-region (progn (move-to-column column t) (point))
;; The `move-to-column' call may replace
;; tabs with spaces, so we can't reuse the
;; previous `back-to-indentation' point.
(progn (back-to-indentation) (point)))))))
;; previous start point.
(progn (beginning-of-line 1)
(skip-chars-forward " \t")
(point)))))))
(defun current-left-margin ()
"Return the left margin to use for this line.

9
lisp/international/fontset.el
View file

@ -79,7 +79,7 @@
("cns11643.92p7-0" . chinese-cns11643-7)
("big5" . big5)
("viscii" . viscii)
("tis620" . tis620-2533)
("tis620" . thai-iso8859-11)
("microsoft-cp1251" . windows-1251)
("koi8-r" . koi8-r)
("jisx0213.2000-1" . japanese-jisx0213-1)
@ -139,7 +139,7 @@
(cyrillic-iso8859-5 . iso-8859-5)
(greek-iso8859-7 . iso-8859-7)
(arabic-iso8859-6 . iso-8859-6)
(thai-tis620 . tis620-2533)
(thai-tis620 . thai-iso8859-11)
(latin-jisx0201 . jisx0201)
(katakana-jisx0201 . jisx0201)
(chinese-big5-1 . big5)
@ -1233,11 +1233,12 @@ Done when `mouse-set-font' is called."
(latin-iso8859-15 . latin)
(latin-iso8859-16 . latin)
(latin-jisx0201 . latin)
(thai-iso8859-11 . thai)
(thai-tis620 . thai)
(cyrillic-iso8859-5 . cyrillic)
(arabic-iso8859-6 . arabic)
(greek-iso8859-7 . latin)
(hebrew-iso8859-8 . latin)
(greek-iso8859-7 . greek)
(hebrew-iso8859-8 . hebrew)
(katakana-jisx0201 . kana)
(chinese-gb2312 . han)
(chinese-gbk . han)

9
lisp/international/mule-cmds.el
View file

@ -300,8 +300,7 @@ wrong, use this command again to toggle back to the right mode."
(cmd (key-binding keyseq))
prefix)
;; read-key-sequence ignores quit, so make an explicit check.
;; Like many places, this assumes quit == C-g, but it need not be.
(if (equal last-input-event ?\C-g)
(if (equal last-input-event (nth 3 (current-input-mode)))
(keyboard-quit))
(when (memq cmd '(universal-argument digit-argument))
(call-interactively cmd)
@ -314,16 +313,16 @@ wrong, use this command again to toggle back to the right mode."
(let ((current-prefix-arg prefix-arg)
;; Have to bind `last-command-event' here so that
;; `digit-argument', for instance, can compute the
;; prefix arg.
;; `prefix-arg'.
(last-command-event (aref keyseq 0)))
(call-interactively cmd)))
;; This is the final call to `universal-argument-other-key', which
;; set's the final `prefix-arg.
;; sets the final `prefix-arg'.
(let ((current-prefix-arg prefix-arg))
(call-interactively cmd))
;; Read the command to execute with the given prefix arg.
;; Read the command to execute with the given `prefix-arg'.
(setq prefix prefix-arg
keyseq (read-key-sequence nil t)
cmd (key-binding keyseq)))

9
lisp/international/mule-conf.el
View file

@ -201,6 +201,7 @@
;; plus nbsp
(define-iso-single-byte-charset 'iso-8859-11 'thai-iso8859-11
"ISO/IEC 8859/11" "Latin/Thai" 166 ?T nil "8859-11")
(define-charset-alias 'tis620-2533 'thai-iso8859-11)
;; 8859-12 doesn't (yet?) exist.
@ -229,14 +230,6 @@
:code-space [32 127]
:code-offset #x0E00)
;; Fixme: doc for this, c.f. above
(define-charset 'tis620-2533
"TIS620.2533"
:short-name "TIS620.2533"
:ascii-compatible-p t
:code-space [0 255]
:superset '(ascii eight-bit-control (thai-tis620 . 128)))
(define-charset 'jisx0201
"JISX0201"
:short-name "JISX0201"

3
lisp/international/mule-diag.el
View file

@ -355,7 +355,8 @@ meanings of these arguments."
(:iso-revision-number "ISO revision number: "
number-to-string)
(:supplementary-p
"Used only as a parent of some other charset." nil)))
"Used only as a parent or a subset of some other charset,
or provided just for backward compatibility." nil)))
(let ((val (get-charset-property charset (car elt))))
(when val
(if (cadr elt) (insert (cadr elt)))

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