[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 6e2c092 7/7: Merge branch 'master' of git.sv.gnu.or
|
From: |
Michael Mauger |
|
Subject: |
[Emacs-diffs] master 6e2c092 7/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs |
|
Date: |
Sun, 6 Aug 2017 20:59:23 -0400 (EDT) |
branch: master
commit 6e2c0929bac8d3896d0472222cd3e6b77cb24c35
Merge: df1a712 c2f1830
Author: Michael R. Mauger <address@hidden>
Commit: Michael R. Mauger <address@hidden>
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
---
.gitlab-ci.yml | 2 +-
INSTALL | 17 +-
Makefile.in | 4 +-
admin/merge-gnulib | 3 +-
configure.ac | 110 ++------
doc/emacs/dired.texi | 28 +-
doc/emacs/help.texi | 9 +
doc/emacs/regs.texi | 5 +-
doc/emacs/rmail.texi | 2 +-
doc/emacs/search.texi | 4 +
doc/lispref/display.texi | 4 +-
doc/lispref/loading.texi | 40 +++
etc/NEWS | 30 ++-
etc/tutorials/TUTORIAL | 16 +-
etc/tutorials/TUTORIAL.he | 12 +-
lib/gnulib.mk.in | 4 +-
lib/tempname.c | 2 +-
lisp/apropos.el | 42 +++
lisp/auth-source.el | 36 ++-
lisp/calendar/todo-mode.el | 92 ++-----
lisp/cedet/semantic/symref/grep.el | 33 ++-
lisp/dired-aux.el | 10 +-
lisp/dired-x.el | 9 +-
lisp/dired.el | 230 ++++++++++++-----
lisp/display-line-numbers.el | 1 -
lisp/emacs-lisp/autoload.el | 10 +-
lisp/emacs-lisp/avl-tree.el | 17 +-
lisp/emacs-lisp/bytecomp.el | 40 +--
lisp/emacs-lisp/cl-generic.el | 55 ++--
lisp/emacs-lisp/edebug.el | 4 +-
lisp/emacs-lisp/eieio-compat.el | 3 +-
lisp/emacs-lisp/elp.el | 5 +
lisp/emacs-lisp/ert.el | 14 +-
lisp/emacs-lisp/pcase.el | 4 +-
lisp/emacs-lisp/re-builder.el | 4 +-
lisp/emacs-lisp/tabulated-list.el | 4 +
lisp/eshell/em-ls.el | 78 +++++-
lisp/faces.el | 6 +-
lisp/files.el | 159 +++++++-----
lisp/find-dired.el | 2 +-
lisp/find-lisp.el | 2 +-
lisp/frame.el | 4 +-
lisp/gnus/mm-uu.el | 2 +-
lisp/help-mode.el | 4 +-
lisp/ido.el | 2 +-
lisp/info.el | 6 +-
lisp/international/mule-conf.el | 4 +-
lisp/kmacro.el | 2 +-
lisp/ldefs-boot.el | 425 ++++++++++++++++++++++---------
lisp/loadhist.el | 10 +-
lisp/ls-lisp.el | 39 ++-
lisp/menu-bar.el | 1 +
lisp/newcomment.el | 5 +-
lisp/password-cache.el | 30 +--
lisp/progmodes/cc-fonts.el | 26 +-
lisp/progmodes/cc-mode.el | 27 +-
lisp/progmodes/grep.el | 90 +++----
lisp/progmodes/sh-script.el | 1 +
lisp/progmodes/xref.el | 2 +-
lisp/register.el | 4 +
lisp/replace.el | 5 +
lisp/ruler-mode.el | 21 +-
lisp/shell.el | 4 +-
lisp/simple.el | 30 ++-
lisp/subr.el | 76 +++---
lisp/term.el | 6 +-
lisp/term/ns-win.el | 2 +-
lisp/term/x-win.el | 2 +-
lisp/textmodes/artist.el | 2 +-
lisp/textmodes/css-mode.el | 2 +-
lisp/url/url-cookie.el | 41 ++-
lisp/vc/smerge-mode.el | 66 +++--
lisp/whitespace.el | 2 +-
m4/d-type.m4 | 32 +++
m4/gnulib-comp.m4 | 3 +
m4/manywarnings.m4 | 19 +-
src/buffer.c | 3 +-
src/cmds.c | 11 +-
src/dired.c | 71 +++---
src/eval.c | 128 +++++-----
src/fileio.c | 154 ++++++-----
src/filelock.c | 3 +
src/gnutls.c | 370 +++++++++++++--------------
src/gnutls.h | 5 +-
src/keyboard.c | 3 +-
src/lisp.h | 6 +-
src/minibuf.c | 7 +
src/regex.c | 8 +-
src/regex.h | 2 +-
src/sysdep.c | 20 ++
test/lisp/auth-source-tests.el | 2 +-
test/lisp/dired-tests.el | 273 ++++++++++++++++----
test/lisp/emacs-lisp/cl-generic-tests.el | 24 ++
test/lisp/emacs-lisp/ert-tests.el | 2 +-
test/lisp/emacs-lisp/map-tests.el | 16 +-
test/lisp/eshell/em-ls-tests.el | 98 +++++++
test/lisp/files-tests.el | 27 +-
test/lisp/ls-lisp-tests.el | 94 +++++++
test/lisp/net/tramp-tests.el | 159 ++++++++++--
test/lisp/register-tests.el | 43 ++++
test/lisp/subr-tests.el | 25 --
test/lisp/vc/ediff-ptch-tests.el | 48 ++--
test/src/buffer-tests.el | 5 +
test/src/eval-tests.el | 20 ++
104 files changed, 2502 insertions(+), 1274 deletions(-)
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 5fcd54f..0b1e8b5 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -24,7 +24,7 @@
# Maintainer: address@hidden
# URL: https://gitlab.com/emacs-ci/emacs
-image: debian:unstable
+image: debian:stretch
before_script:
- apt update -qq
diff --git a/INSTALL b/INSTALL
index ea96890..33084b9 100644
--- a/INSTALL
+++ b/INSTALL
@@ -261,10 +261,10 @@ Emacs with the options '--without-dbus --without-gconf
--without-gsettings'.
To read email via a network protocol like IMAP or POP, you can
configure Emacs with the option '--with-mailutils', so that it always
-uses the GNU Mailutils 'movemail' program to retrieve mail. Otherwise
-the Emacs build procedure builds and installs an auxiliary 'movemail'
-program, a limited and insecure substitute that Emacs can use when
-Mailutils is not installed; when this happens, there are several
+uses the GNU Mailutils 'movemail' program to retrieve mail; this is
+the default if GNU Mailutils is installed. Otherwise the Emacs build
+procedure builds and installs an auxiliary 'movemail' program, a
+limited and insecure substitute; when this happens, there are several
configure options such as --without-pop that provide fine-grained
control over Emacs 'movemail' construction.
@@ -272,10 +272,9 @@ The Emacs mail reader RMAIL is configured to be able to
read mail from
a POP3 server by default. Versions of the POP protocol older than
POP3 are not supported. While POP3 support is typically enabled,
whether Emacs actually uses POP3 is controlled by individual users;
-see the Rmail chapter of the Emacs manual. Unless you configure
---with-mailutils, it is a good idea to configure --without-pop so that
-users are less likely to inadvertently read email via insecure
-channels.
+see the Rmail chapter of the Emacs manual. Unless --with-mailutils is
+in effect, it is a good idea to configure --without-pop so that users
+are less likely to inadvertently read email via insecure channels.
For image support you may have to download, build, and install the
appropriate image support libraries for image types other than XBM and
@@ -550,7 +549,7 @@ information on this.
Emacs info files.
8) If your system uses lock files to interlock access to mailer inbox files,
-and if you did not configure --with-mailutils, then you might need to
+and if --with-mailutils is not in effect, then you might need to
make the Emacs-specific 'movemail' program setuid or setgid in order
to enable it to write the lock files. We believe this is safe.
diff --git a/Makefile.in b/Makefile.in
index a31d416..8a08465 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -448,7 +448,7 @@ config.status: ${srcdir}/configure
fi
$(srcdir)/configure: $(srcdir)/configure.ac $(srcdir)/m4/*.m4
- cd $(srcdir) && ./autogen.sh
+ cd $(srcdir) && ./autogen.sh autoconf
# ==================== Installation ====================
@@ -1094,7 +1094,7 @@ check-info: info
# * Rebuild Makefile, to update the build procedure itself.
# * Do the actual build.
bootstrap: bootstrap-clean
- cd $(srcdir) && ./autogen.sh
+ cd $(srcdir) && ./autogen.sh autoconf
$(MAKE) MAKEFILE_NAME=force-Makefile force-Makefile
$(MAKE) all
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index 18c9ee8..c23e8a4 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -30,7 +30,8 @@ GNULIB_MODULES='
careadlinkat close-stream
count-leading-zeros count-one-bits count-trailing-zeros
crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512
- diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat
+ d-type diffseq dtoastr dtotimespec dup2
+ environ execinfo explicit_bzero faccessat
fcntl fcntl-h fdatasync fdopendir
filemode filevercmp flexmember fstatat fsync
getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog
diff --git a/configure.ac b/configure.ac
index e4647c6..9f80620 100644
--- a/configure.ac
+++ b/configure.ac
@@ -175,6 +175,7 @@ esac
canonical=$host
configuration=${host_alias-${build_alias-$host}}
+emacs_uname_r=`uname -r`
dnl Support for --program-prefix, --program-suffix and
dnl --program-transform-name options
@@ -233,9 +234,16 @@ AC_DEFUN([OPTION_DEFAULT_ON], [dnl
# in a movemail implementation that supports only unencrypted POP3
# connections. Encrypted connections should be the default.
-OPTION_DEFAULT_OFF([mailutils],
- [rely on GNU Mailutils, so that the --without-pop through --with-mailhost
- options are irrelevant])
+AC_ARG_WITH([mailutils],
+ [AS_HELP_STRING([--with-mailutils],
+ [rely on GNU Mailutils, so that the --without-pop through --with-mailhost
+ options are irrelevant; this is the default if GNU Mailutils is
+ installed])],
+ [],
+ [with_mailutils=$with_features
+ if test "$with_mailutils" = yes; then
+ (movemail --version) >/dev/null 2>&1 || with_mailutils=no
+ fi])
if test "$with_mailutils" = no; then
with_mailutils=
fi
@@ -1222,8 +1230,8 @@ if test $opsys = gnu-linux; then
AC_SUBST([SETFATTR])
fi
fi
-case $opsys,$PAXCTL_notdumped in
- gnu-linux, | netbsd,)
+case $opsys,$PAXCTL_notdumped,$emacs_uname_r in
+ gnu-linux,,* | netbsd,,[0-7].*)
AC_PATH_PROG([PAXCTL], [paxctl], [],
[$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin])
if test -n "$PAXCTL"; then
@@ -2832,89 +2840,6 @@ if test "${with_gnutls}" = "yes" ; then
[HAVE_GNUTLS=yes], [HAVE_GNUTLS=no])
if test "${HAVE_GNUTLS}" = "yes"; then
AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
- EMACS_CHECK_MODULES([LIBGNUTLS3], [gnutls >= 3.0.0],
- [AC_DEFINE(HAVE_GNUTLS3, 1, [Define if using GnuTLS v3.])], [])
-
- AC_CACHE_CHECK([for GnuTLS v3 with HMAC], [emacs_cv_gnutls3_hmac],
- [AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([[
- #include <gnutls/gnutls.h>
- #include <gnutls/crypto.h>
- ]], [[
- int
- main (void)
- {
- gnutls_hmac_hd_t handle;
- gnutls_hmac_deinit (handle, NULL);
- }
- ]])],
- [emacs_cv_gnutls3_hmac=yes],
- [emacs_cv_gnutls3_hmac=no])])
- if test "$emacs_cv_gnutls3_hmac" = yes; then
- AC_DEFINE([HAVE_GNUTLS3_HMAC], [1],
- [Define if using GnuTLS v3 with HMAC support.])
- fi
-
- AC_CACHE_CHECK([for GnuTLS v3 with AEAD], [emacs_cv_gnutls3_aead],
- [AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([[
- #include <gnutls/gnutls.h>
- #include <gnutls/crypto.h>
- ]], [[
- int
- main (void)
- {
- gnutls_aead_cipher_hd_t handle;
- gnutls_aead_cipher_deinit (handle);
- }
- ]])],
- [emacs_cv_gnutls3_aead=yes],
- [emacs_cv_gnutls3_aead=no])])
- if test "$emacs_cv_gnutls3_aead" = yes; then
- AC_DEFINE([HAVE_GNUTLS3_AEAD], [1],
- [Define if using GnuTLS v3 with AEAD support.])
- fi
-
- AC_CACHE_CHECK([for GnuTLS v3 with cipher], [emacs_cv_gnutls3_cipher],
- [AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([[
- #include <gnutls/gnutls.h>
- #include <gnutls/crypto.h>
- ]], [[
- int
- main (void)
- {
- gnutls_cipher_hd_t handle;
- gnutls_cipher_encrypt2 (handle, NULL, 0, NULL, 0);
- gnutls_cipher_deinit (handle);
- }
- ]])],
- [emacs_cv_gnutls3_cipher=yes],
- [emacs_cv_gnutls3_cipher=no])])
- if test "$emacs_cv_gnutls3_cipher" = yes; then
- AC_DEFINE([HAVE_GNUTLS3_CIPHER], [1],
- [Define if using GnuTLS v3 with cipher support.])
- fi
-
- AC_CACHE_CHECK([for GnuTLS v3 with digest], [emacs_cv_gnutls3_digest],
- [AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([[
- #include <gnutls/gnutls.h>
- #include <gnutls/crypto.h>
- ]], [[
- int
- main (void)
- {
- gnutls_hash_hd_t handle;
- gnutls_hash_deinit (handle, NULL);
- }
- ]])],
- [emacs_cv_gnutls3_digest=yes],
- [emacs_cv_gnutls3_digest=no])])
- if test "$emacs_cv_gnutls3_digest" = yes; then
- AC_DEFINE([HAVE_GNUTLS3_DIGEST], [1],
- [Define if using GnuTLS v3 with digest support.])
- fi
fi
# Windows loads GnuTLS dynamically
@@ -5509,13 +5434,12 @@ to run if these resources are not installed."])
echo
fi
-if test "${opsys}" = "cygwin"; then
- case `uname -r` in
- 1.5.*) AC_MSG_WARN([[building Emacs on Cygwin 1.5 is not supported.]])
+case $opsys,$emacs_uname_r in
+ cygwin,1.5.*)
+ AC_MSG_WARN([[building Emacs on Cygwin 1.5 is not supported.]])
echo
;;
- esac
-fi
+esac
# Remove any trailing slashes in these variables.
case $prefix in
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index ddd7229..c1cc2f8 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -64,10 +64,22 @@ you to operate on the listed files. @xref{Directories}.
directory name using the minibuffer, and opens a @dfn{Dired buffer}
listing the files in that directory. You can also supply a wildcard
file name pattern as the minibuffer argument, in which case the Dired
-buffer lists all files matching that pattern. The usual history and
-completion commands can be used in the minibuffer; in particular,
address@hidden puts the name of the visited file (if any) in the minibuffer
-(@pxref{Minibuffer History}).
+buffer lists all files matching that pattern. A wildcard may appear
+in the directory part as well.
+For instance,
+
address@hidden
+C-x d ~/foo/*.el @key{RET}
+C-x d ~/foo/*/*.el @key{RET}
address@hidden example
+
+The former lists all the files with extension @samp{.el} in directory
address@hidden The latter lists the files with extension @samp{.el}
+in subdirectories 2 levels of depth below @samp{foo}.
+
+The usual history and completion commands can be used in the minibuffer;
+in particular, @kbd{M-n} puts the name of the visited file (if any) in
+the minibuffer (@pxref{Minibuffer History}).
You can also invoke Dired by giving @kbd{C-x C-f} (@code{find-file})
a directory name.
@@ -224,6 +236,14 @@ Dired cannot delete directories that are nonempty. If the
variable
@code{dired-recursive-deletes} is address@hidden, then Dired can
delete nonempty directories including all their contents. That can
be somewhat risky.
+Even if you have set @code{dired-recursive-deletes} to @code{nil},
+you might want sometimes to delete recursively directories
+without being asked for confirmation for all of them. This is handy
+when you have marked many directories for deletion and you are very
+sure that all of them can safely being deleted. For every nonempty
+directory you are asked for confirmation; if you answer @code{all},
+then all the remaining directories will be deleted without more
+questions.
@vindex delete-by-moving-to-trash
If you change the variable @code{delete-by-moving-to-trash} to
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index fd6df1c..460ced0 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -320,12 +320,21 @@ search for non-customizable variables too.
Search for variables. With a prefix argument, search for
customizable variables only.
address@hidden M-x apropos-local-variable
address@hidden apropos-local-variable
+Search for buffer-local variables.
+
@item M-x apropos-value
@findex apropos-value
Search for variables whose values match the specified pattern. With a
prefix argument, search also for functions with definitions matching
the pattern, and Lisp symbols with properties matching the pattern.
address@hidden M-x apropos-local-value
address@hidden apropos-local-value
+Search for buffer-local variables whose values match the specified
+pattern.
+
@item C-h d
@kindex C-h d
@findex apropos-documentation
diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi
index 7369f6b..40e3e2c 100644
--- a/doc/emacs/regs.texi
+++ b/doc/emacs/regs.texi
@@ -15,7 +15,10 @@ jump back to that position once, or many times.
Each register has a name that consists of a single character, which
we will denote by @var{r}; @var{r} can be a letter (such as @samp{a})
or a number (such as @samp{1}); case matters, so register @samp{a} is
-not the same as register @samp{A}.
+not the same as register @samp{A}. You can also set a register in
+non-alphanumeric characters, for instance @samp{*} or @samp{C-d}.
+Note, it's not possible to set a register in @samp{C-g} or @samp{ESC},
+because these keys are reserved to terminate interactive commands.
@findex view-register
A register can store a position, a piece of text, a rectangle, a
diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi
index 046087e..f2416a0 100644
--- a/doc/emacs/rmail.texi
+++ b/doc/emacs/rmail.texi
@@ -1382,7 +1382,7 @@ Rmail attempts to locate the @command{movemail} program
and determine its
version. There are two versions of the @command{movemail} program: the
GNU Mailutils version (@pxref{movemail,,,mailutils,GNU mailutils}),
and an Emacs-specific version that is built and installed unless Emacs
-was configured using the @option{--with-mailutils} option.
+was configured @option{--with-mailutils} in effect.
The two @command{mailtool} versions support the same
command line syntax and the same basic subset of options. However, the
Mailutils version offers additional features.
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index c9e83da..9f7e9a1 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -1747,6 +1747,10 @@ at the first match after such line.
You can also run @kbd{M-s o} when an incremental search is active;
this uses the current search string.
+Note that matches for the regexp you type are extended to include
+complete lines, and a match that starts before the previous match ends
+is not considered a match.
+
@kindex RET @r{(Occur mode)}
@kindex o @r{(Occur mode)}
@kindex C-o @r{(Occur mode)}
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index f5c73e5..2ed848a 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -2423,7 +2423,9 @@ the values of the @code{:family}, @code{:foundry},
@code{:width},
The name of a face from which to inherit attributes, or a list of face
names. Attributes from inherited faces are merged into the face like
an underlying face would be, with higher priority than underlying
-faces (@pxref{Displaying Faces}). If a list of faces is used,
+faces (@pxref{Displaying Faces}). If the face to inherit from is
address@hidden, it is treated the same as @code{nil}, since Emacs
+never merges @code{:inherit} attributes. If a list of faces is used,
attributes from faces earlier in the list override those from later
faces.
@end table
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index d925c8c..80dcb48 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -468,6 +468,10 @@ runs the real definition as if it had been loaded all
along.
Autoloading can also be triggered by looking up the documentation of
the function or macro (@pxref{Documentation Basics}).
address@hidden
+* When to Autoload:: When to Use Autoload.
address@hidden menu
+
There are two ways to set up an autoloaded function: by calling
@code{autoload}, and by writing a ``magic'' comment in the
source before the real definition. @code{autoload} is the low-level
@@ -699,6 +703,42 @@ symbol's new function value. If the value of the optional
argument
function, only a macro.
@end defun
address@hidden When to Autoload
address@hidden When to Use Autoload
address@hidden autoload, when to use
+
+Do not add an autoload comment unless it is really necessary.
+Autoloading code means it is always globally visible. Once an item is
+autoloaded, there is no compatible way to transition back to it not
+being autoloaded (after people become accustomed to being able to use it
+without an explicit load).
+
address@hidden
address@hidden
+The most common items to autoload are the interactive entry points to a
+library. For example, if @file{python.el} is a library defining a
+major-mode for editing Python code, autoload the definition of the
address@hidden function, so that people can simply use @kbd{M-x
+python-mode} to load the library.
+
address@hidden
+Variables usually don't need to be autoloaded. An exception is if the
+variable on its own is generally useful without the whole defining
+library being loaded. (An example of this might be something like
address@hidden)
+
address@hidden
+Don't autoload a user option just so that a user can set it.
+
address@hidden
+Never add an autoload @emph{comment} to silence a compiler warning in
+another file. In the file that produces the warning, use
address@hidden(defvar foo)} to silence an undefined variable warning, and
address@hidden (@pxref{Declaring Functions}) to silence an
+undefined function warning; or require the relevant library; or use an
+explicit autoload @emph{statement}.
address@hidden itemize
+
@node Repeated Loading
@section Repeated Loading
@cindex repeated loading
diff --git a/etc/NEWS b/etc/NEWS
index f43491b..b47bf95 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -31,10 +31,12 @@ Use 'configure --with-gnutls=no' to build even when GnuTLS
is missing.
version 2.6.6 or later.
** The new option 'configure --with-mailutils' causes Emacs to rely on
-GNU Mailutils 'movemail' to retrieve email. By default, the Emacs
-build procedure continues to build and install a limited and insecure
-'movemail' substitute. Although --with-mailutils is recommended, it
-is not yet the default due to backward-compatibility concerns.
+GNU Mailutils to retrieve email. It is recommended, and is the
+default if GNU Mailutils is installed. When --with-mailutils is not
+in effect, the Emacs build procedure by default continues to build and
+install a limited 'movemail' substitute that retrieves POP3 email only
+via insecure channels; to avoid this problem, use either
+--with-mailutils or --without-pop when configuring.
** The new option 'configure --enable-gcc-warnings=warn-only' causes
GCC to issue warnings without stopping the build. This behavior is
@@ -590,6 +592,12 @@ different buffer while keeping point, mark, markers, and
text
properties as intact as possible.
+++
+** New commands 'apropos-local-variable' and 'apropos-local-value.
+These are buffer-local versions of 'apropos-variable' and
+'apropos-value', respectively. They show buffer-local variables whose
+names and values, respectively, match a given pattern.
+
++++
** More user control of reordering bidirectional text for display.
The two new variables, 'bidi-paragraph-start-re' and
'bidi-paragraph-separate-re', allow customization of what exactly are
@@ -598,9 +606,18 @@ paragraphs, for the purposes of bidirectional display.
* Changes in Specialized Modes and Packages in Emacs 26.1
+** New function `cl-generic-p'.
+
** Dired
+++
+*** You can answer 'all' in 'dired-do-delete' to delete recursively all
+remaining directories without more prompts.
+
++++
+*** Dired supports wildcards in the directory part of the file names.
+
++++
*** You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets
replaced
by the current file name.
@@ -1076,6 +1093,9 @@ fontification, and commenting for embedded JavaScript and
CSS.
* Incompatible Lisp Changes in Emacs 26.1
+*** password-data is now a hash-table
+so that `password-read' can use any object for the `key' argument.
+
+++
*** Command 'dired-mark-extension' now automatically prepends a '.' to the
extension when not present. The new command 'dired-mark-suffix' behaves
@@ -1167,6 +1187,8 @@ break.
* Lisp Changes in Emacs 26.1
+** New function `define-symbol-prop'.
+
+++
** New optional argument TESTFN in 'alist-get', 'map-elt' and 'map-put'.
diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL
index 3419c63..a41e7b0 100644
--- a/etc/tutorials/TUTORIAL
+++ b/etc/tutorials/TUTORIAL
@@ -17,15 +17,19 @@ The characters ">>" at the left margin indicate directions
for you to
try using a command. For instance:
<<Blank lines inserted around following line by help-with-tutorial>>
[Middle of page left blank for didactic purposes. Text continues below]
->> Now type C-v (View next screen) to move to the next screen.
+>> Now type C-v (View next screen) to scroll down in the tutorial.
(go ahead, do it by holding down the CONTROL key while typing v).
- From now on, you should do this again whenever you finish
- reading the screen.
+ From now on, please do this whenever you reach the end of the screen.
-Note that there is an overlap of two lines when you move from screen
-to screen; this provides some continuity so you can continue reading
+Note that there is an overlap of two lines when you scroll a whole
+screenful; this provides some continuity so you can continue reading
the text.
+This is a copy of the Emacs tutorial text, customized slightly for
+you. Later on we will instruct you to try various commands to alter
+this text. Don't worry if you change this text before we tell you to;
+that is called "editing" and that's what Emacs is for.
+
The first thing that you need to know is how to move around from place
to place in the text. You already know how to move forward one screen,
with C-v. To move backwards one screen, type M-v (hold down the META key
@@ -33,6 +37,7 @@ and type v, or type <ESC>v if you do not have a META, EDIT,
or ALT key).
>> Try typing M-v and then C-v, a few times.
+It is ok to scroll this text in other ways, if you know how.
* SUMMARY
---------
@@ -56,7 +61,6 @@ You can also use the PageUp and PageDn keys to move by
screenfuls, if
your terminal has them, but you can edit more efficiently if you use
C-v and M-v.
-
* BASIC CURSOR CONTROL
----------------------
diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he
index 4999716..beac4b7 100644
--- a/etc/tutorials/TUTORIAL.he
+++ b/etc/tutorials/TUTORIAL.he
@@ -17,13 +17,18 @@
לדוגמה:
<<שורות ריקות תתווספנה סביב השורה הבאה ע״י help-with-tutorial>>
[אמצע העמוד הושאר ריק למטרות לימודיות. הטקסט ממשיך להלן]
->> הקישו עתה C-v (הצג העמוד הבא) על־מנת להתקדם לעמוד הבא. (קדימה, נסו
- זאת ע״י לחיצה והחזקה של מקש CONTROL והקשה על v.)
+>> הקישו עתה C-v (הצג העמוד הבא) על־מנת לגלול תצוגה לעמוד הבא. (קדימה,
+ נסו זאת ע״י לחיצה והחזקה של מקש CONTROL והקשה על v.)
מעתה והלאה, עליכם לעשות זאת בכל פעם שתסיימו לקרוא את המוצג על המסך.
-שימו לב לחפיפה של שתי שורות כאשר אתם עוברים ממסך למשך, מה שמבטיח רציפות
+שימו לב לחפיפה של שתי שורות כאשר אתם עוברים ממסך למסך, מה שמבטיח רציפות
מסוימת בעת קריאת הטקסט.
+הטקסט שלפניכם הינו עותק של שיעור בשימוש ב־Emacs שהותאם קלות עבורכם.
+בהמשך תקבלו הוראות לנסות פקודות שונות כדי לבצע שינויים בטקסט הזה. אם
+במקרה תשנו את הטקסט לפני שנבקש, אל דאגה: זוהי "עריכה" שהיא יעודו של
+Emacs.
+
דבר ראשון שעליכם ללמוד הוא כיצד לנוע ממקום אחד למשנהו בתוך הטקסט. אתם
כבר יודעים כיצד להתקדם לעמוד הבא, עם C-v. לחזרה לעמוד הקודם הקישו M-v
(החזיקו מקש META והקישו v או הקישו <ESC>v אם אין במקלדת מקש META
@@ -31,6 +36,7 @@
>> נסו עתה כמה פעמים להקיש M-v ואחר־כך C-v.
+אפשר לגלול טקסט גם באמצעים אחרים, אם אתם יודעים כיצד לעשות זאת.
* סיכום עד כאן
--------------
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 3e57391..a385c8c 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -21,7 +21,7 @@
# 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=open --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 --avo [...]
+# 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=open --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 --avo [...]
MOSTLYCLEANFILES += core *.stackdump
@@ -546,8 +546,6 @@ LD_SWITCH_SYSTEM_TEMACS = @LD_SWITCH_SYSTEM_TEMACS@
LD_SWITCH_X_SITE = @LD_SWITCH_X_SITE@
LD_SWITCH_X_SITE_RPATH = @LD_SWITCH_X_SITE_RPATH@
LIBGIF = @LIBGIF@
-LIBGNUTLS3_CFLAGS = @LIBGNUTLS3_CFLAGS@
-LIBGNUTLS3_LIBS = @LIBGNUTLS3_LIBS@
LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@
LIBGNU_LIBDEPS = @LIBGNU_LIBDEPS@
diff --git a/lib/tempname.c b/lib/tempname.c
index 2cd9032..9c4a3c2 100644
--- a/lib/tempname.c
+++ b/lib/tempname.c
@@ -279,7 +279,7 @@ try_nocreate (char *tmpl, void *flags _GL_UNUSED)
{
struct_stat64 st;
- if (__lxstat64 (_STAT_VER, tmpl, &st) == 0)
+ if (__lxstat64 (_STAT_VER, tmpl, &st) == 0 || errno == EOVERFLOW)
__set_errno (EEXIST);
return errno == ENOENT ? 0 : -1;
}
diff --git a/lisp/apropos.el b/lisp/apropos.el
index cbd9c71..86d9b51 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -514,6 +514,19 @@ options only, i.e. behave like `apropos-user-option'."
(let ((apropos-do-all (if do-not-all nil t)))
(apropos-user-option pattern)))
+;;;###autoload
+(defun apropos-local-variable (pattern &optional buffer)
+ "Show buffer-local variables that match PATTERN.
+Optional arg BUFFER (default: current buffer) is the buffer to check.
+
+The output includes variables that are not yet set in BUFFER, but that
+will be buffer-local when set."
+ (interactive (list (apropos-read-pattern "buffer-local variable")))
+ (unless buffer (setq buffer (current-buffer)))
+ (apropos-command pattern nil (lambda (symbol)
+ (and (local-variable-if-set-p symbol)
+ (get symbol 'variable-documentation)))))
+
;; For auld lang syne:
;;;###autoload
(defalias 'command-apropos 'apropos-command)
@@ -795,6 +808,35 @@ Returns list of symbols and values found."
(let ((apropos-multi-type do-all))
(apropos-print nil "\n----------------\n")))
+;;;###autoload
+(defun apropos-local-value (pattern &optional buffer)
+ "Show buffer-local variables whose values match PATTERN.
+This is like `apropos-value', but only for buffer-local variables.
+Optional arg BUFFER (default: current buffer) is the buffer to check."
+ (interactive (list (apropos-read-pattern "value of buffer-local variable")))
+ (unless buffer (setq buffer (current-buffer)))
+ (apropos-parse-pattern pattern)
+ (setq apropos-accumulator ())
+ (let ((var nil))
+ (mapatoms
+ (lambda (symb)
+ (unless (memq symb '(apropos-regexp apropos-pattern
apropos-all-words-regexp
+ apropos-words apropos-all-words
apropos-accumulator symb var))
+ (setq var (apropos-value-internal 'local-variable-if-set-p symb
'symbol-value)))
+ (when (and (fboundp 'apropos-false-hit-str) (apropos-false-hit-str
var))
+ (setq var nil))
+ (when var
+ (setq apropos-accumulator (cons (list symb (apropos-score-str var)
nil var)
+ apropos-accumulator))))))
+ (let ((apropos-multi-type nil))
+ (if (> emacs-major-version 20)
+ (apropos-print
+ nil "\n----------------\n"
+ (format "Buffer `%s' has the following local variables\nmatching
%s`%s':"
+ (buffer-name buffer)
+ (if (consp pattern) "keywords " "")
+ pattern))
+ (apropos-print nil "\n----------------\n"))))
;;;###autoload
(defun apropos-documentation (pattern &optional do-all)
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index d1747bd..d4b44a5 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -200,8 +200,6 @@ Note that if EPA/EPG is not available, this should NOT be
used."
(const :tag "Save GPG-encrypted password tokens"
gpg)
(const :tag "Don't encrypt tokens" never))))))
-(defvar auth-source-magic "auth-source-magic ")
-
(defcustom auth-source-do-cache t
"Whether auth-source should cache information with `password-cache'."
:group 'auth-source
@@ -782,16 +780,16 @@ Returns the deleted entries."
(defun auth-source-forget-all-cached ()
"Forget all cached auth-source data."
(interactive)
- (cl-do-symbols (sym password-data)
- ;; when the symbol name starts with auth-source-magic
- (when (string-match (concat "^" auth-source-magic) (symbol-name sym))
- ;; remove that key
- (password-cache-remove (symbol-name sym))))
+ (maphash (lambda (key _password)
+ (when (eq 'auth-source (car-safe key))
+ ;; remove that key
+ (password-cache-remove key)))
+ password-data)
(setq auth-source-netrc-cache nil))
(defun auth-source-format-cache-entry (spec)
"Format SPEC entry to put it in the password cache."
- (concat auth-source-magic (format "%S" spec)))
+ `(auth-source . ,spec))
(defun auth-source-remember (spec found)
"Remember FOUND search results for SPEC."
@@ -822,18 +820,16 @@ This is not a full `auth-source-search' spec but works
similarly.
For instance, \(:host \"myhost\" \"yourhost\") would find all the
cached data that was found with a search for those two hosts,
while \(:host t) would find all host entries."
- (let ((count 0)
- sname)
- (cl-do-symbols (sym password-data)
- ;; when the symbol name matches with auth-source-magic
- (when (and (setq sname (symbol-name sym))
- (string-match (concat "^" auth-source-magic "\\(.+\\)")
- sname)
- ;; and the spec matches what was stored in the cache
- (auth-source-specmatchp spec (read (match-string 1 sname))))
- ;; remove that key
- (password-cache-remove sname)
- (cl-incf count)))
+ (let ((count 0))
+ (maphash
+ (lambda (key _password)
+ (when (and (eq 'auth-source (car-safe key))
+ ;; and the spec matches what was stored in the cache
+ (auth-source-specmatchp spec (cdr key)))
+ ;; remove that key
+ (password-cache-remove key)
+ (cl-incf count)))
+ password-data)
count))
(defun auth-source-specmatchp (spec stored)
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index b89c1c2..e39fee5 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -701,7 +701,8 @@ and done items are always shown on visiting a category."
;; We just initialized the first todo file, so make it the default.
(setq todo-default-todo-file (todo-short-file-name file)
first-file t)
- (todo-reevaluate-default-file-defcustom))
+ (put 'todo-default-todo-file 'custom-type
+ `(radio ,@(todo--files-type-list))))
(unless (member file todo-visited)
;; Can't setq t-c-t-f here, otherwise wrong file shown when
;; todo-show is called from todo-show-categories-table.
@@ -780,7 +781,8 @@ and done items are always shown on visiting a category."
(when first-file
(setq todo-default-todo-file nil
todo-current-todo-file nil)
- (todo-reevaluate-default-file-defcustom))
+ (put 'todo-default-todo-file 'custom-type
+ `(radio ,@(todo--files-type-list))))
(kill-buffer)
(keyboard-quit)))))
(save-excursion (todo-category-select))
@@ -1102,7 +1104,7 @@ Noninteractively, return the name of the new file."
(write-region (point-min) (point-max) file nil 'nomessage nil t)
(kill-buffer file))
(setq todo-files (funcall todo-files-function))
- (todo-reevaluate-filelist-defcustoms)
+ (todo-update-filelist-defcustoms)
(if (called-interactively-p 'any)
(progn
(set-window-buffer (selected-window)
@@ -1156,7 +1158,7 @@ these files, also rename them accordingly."
(setq todo-default-todo-file snname))
(when (string= todo-global-current-todo-file oname)
(setq todo-global-current-todo-file nname))
- (todo-reevaluate-filelist-defcustoms)))
+ (todo-update-filelist-defcustoms)))
(defun todo-delete-file ()
"Delete the current todo, archive or filtered items file.
@@ -1217,7 +1219,7 @@ visiting the deleted files."
(when (or (string= file1 todo-global-current-todo-file)
(and delete2 (string= file2 todo-global-current-todo-file)))
(setq todo-global-current-todo-file nil))
- (todo-reevaluate-filelist-defcustoms)
+ (todo-update-filelist-defcustoms)
(message (concat (cond (todo "Todo") (archive "Archive")) " file \"%s\" "
(when delete2
(concat "and its "
@@ -1387,7 +1389,7 @@ todo or done items."
(if (= (length todo-categories) 1)
;; If deleted category was the only one, delete the file.
(progn
- (todo-reevaluate-filelist-defcustoms)
+ (todo-update-filelist-defcustoms)
;; Skip confirming killing the archive buffer if it has been
;; modified and not saved.
(set-buffer-modified-p nil)
@@ -1430,7 +1432,7 @@ the archive of the file moved to, creating it if it does
not exist."
(write-region (point-min) (point-max) nfile nil 'nomessage nil t)
(kill-buffer nfile))
(setq todo-files (funcall todo-files-function))
- (todo-reevaluate-filelist-defcustoms))
+ (todo-update-filelist-defcustoms))
(dolist (buf buffers)
;; Make sure archive file is in Todo Archive mode so that
;; todo-categories has correct value.
@@ -1524,7 +1526,7 @@ the archive of the file moved to, creating it if it does
not exist."
(delete-file todo-current-todo-file)
(kill-buffer)
(when (member todo-current-todo-file todo-files)
- (todo-reevaluate-filelist-defcustoms)))
+ (todo-update-filelist-defcustoms)))
(setq todo-categories (delete (assoc cat todo-categories)
todo-categories))
(todo-update-categories-sexp)
@@ -4527,11 +4529,9 @@ If the file already exists, overwrite it only on
confirmation."
(defcustom todo-print-buffer-function #'ps-print-buffer-with-faces
"Function called by `todo-print-buffer' to print Todo mode buffers.
-The function should take an optional argument whose non-nil value
-is a string naming a file to save the print image to; calling
-`todo-print-buffer-to-file' prompts for the file name, which is
-passed to this function. Calling this function with no or a nil
-argument sends the image to the printer."
+Called with one argument which can either be:
+- a string, naming a file to save the print image to.
+- nil, to send the image to the printer."
:type 'symbol
:group 'todo)
@@ -4801,7 +4801,7 @@ name in `todo-directory'. See also the documentation
string of
(prin1 sexp (current-buffer)))
(write-region (point-min) (point-max) file nil 'nomessage))
(setq todo-archives (funcall todo-files-function t)))
- (todo-reevaluate-filelist-defcustoms)
+ (todo-update-filelist-defcustoms)
(when (y-or-n-p (concat "Format conversion done; do you want to "
"visit the converted file now? "))
(setq todo-current-todo-file file)
@@ -4865,7 +4865,7 @@ buffer, clean up the state and return nil."
(member todo-default-todo-file files))
(setq todo-default-todo-file (todo-short-file-name
(car todo-files))))
- (todo-reevaluate-filelist-defcustoms)
+ (todo-update-filelist-defcustoms)
(when buf (kill-buffer buf))
nil)))))
@@ -5751,7 +5751,8 @@ have been removed."
" been deleted and removed from\n"
"the list of category completion files")
names))
- (todo-reevaluate-category-completions-files-defcustom)
+ (put 'todo-category-completions-files 'custom-type
+ `(set ,@(todo--files-type-list)))
(custom-set-default 'todo-category-completions-files
(symbol-value 'todo-category-completions-files))
(sleep-for 1.5)))
@@ -6251,59 +6252,12 @@ the empty string (i.e., no time string)."
(hl-line-mode 1)
(hl-line-mode -1)))))))))
-(defun todo-reevaluate-filelist-defcustoms ()
- "Reevaluate defcustoms that provide choice list of todo files."
- ;; FIXME: This is hideous! I don't know enough about Custom to
- ;; offer something better, but please ask on emacs-devel!
- (custom-set-default 'todo-default-todo-file
- (symbol-value 'todo-default-todo-file))
- (todo-reevaluate-default-file-defcustom)
- (custom-set-default 'todo-filter-files (symbol-value 'todo-filter-files))
- (todo-reevaluate-filter-files-defcustom)
- (custom-set-default 'todo-category-completions-files
- (symbol-value 'todo-category-completions-files))
- (todo-reevaluate-category-completions-files-defcustom))
-
-(defun todo-reevaluate-default-file-defcustom ()
- "Reevaluate defcustom of `todo-default-todo-file'.
-Called after adding or deleting a todo file. If the value of
-`todo-default-todo-file' before calling this function was
-associated with an existing file, keep that value."
- ;; FIXME: This is hideous! I don't know enough about Custom to
- ;; offer something better, but please ask on emacs-devel!
- ;; (let ((curval todo-default-todo-file))
- (eval
- (defcustom todo-default-todo-file (todo-short-file-name
- (car (funcall todo-files-function)))
- "Todo file visited by first session invocation of `todo-show'."
- :type (when todo-files
- `(radio ,@(todo--files-type-list)))
- :group 'todo))
- ;; (when (and curval (file-exists-p (todo-absolute-file-name curval)))
- ;; (custom-set-default 'todo-default-todo-file curval)
- ;; ;; (custom-reevaluate-setting 'todo-default-todo-file)
- ;; )))
- )
-
-(defun todo-reevaluate-category-completions-files-defcustom ()
- "Reevaluate defcustom of `todo-category-completions-files'.
-Called after adding or deleting a todo file."
- ;; FIXME: This is hideous! I don't know enough about Custom to
- ;; offer something better, but please ask on emacs-devel!
- (eval (defcustom todo-category-completions-files nil
- "List of files for building `todo-read-category' completions."
- :type `(set ,@(todo--files-type-list))
- :group 'todo)))
-
-(defun todo-reevaluate-filter-files-defcustom ()
- "Reevaluate defcustom of `todo-filter-files'.
-Called after adding or deleting a todo file."
- ;; FIXME: This is hideous! I don't know enough about Custom to
- ;; offer something better, but please ask on emacs-devel!
- (eval (defcustom todo-filter-files nil
- "List of files for multifile item filtering."
- :type `(set ,@(todo--files-type-list))
- :group 'todo)))
+(defun todo-update-filelist-defcustoms ()
+ "Update defcustoms that provide choice list of todo files."
+ (put 'todo-default-todo-file 'custom-type `(radio ,@(todo--files-type-list)))
+ (put 'todo-category-completions-files 'custom-type
+ `(set ,@(todo--files-type-list)))
+ (put 'todo-filter-files 'custom-type `(set ,@(todo--files-type-list))))
;;
-----------------------------------------------------------------------------
;;; Font locking
diff --git a/lisp/cedet/semantic/symref/grep.el
b/lisp/cedet/semantic/symref/grep.el
index 42dc40c..f7c72bf 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -189,26 +189,25 @@ This shell should support pipe redirect syntax."
;; Return the answer
ans))
-(defconst semantic-symref-grep--line-re
- "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):")
-
(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool
semantic-symref-tool-grep))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
- (cond ((eq (oref tool :resulttype) 'file)
- ;; Search for files
- (when (re-search-forward "^\\([^\n]+\\)$" nil t)
- (match-string 1)))
- ((eq (oref tool :resulttype) 'line-and-text)
- (when (re-search-forward semantic-symref-grep--line-re nil t)
- (list (string-to-number (match-string 2))
- (match-string 1)
- (buffer-substring-no-properties (point)
(line-end-position)))))
- (t
- (when (re-search-forward semantic-symref-grep--line-re nil t)
- (cons (string-to-number (match-string 2))
- (match-string 1))
- ))))
+ (pcase-let
+ ((`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist)))
+ (cond ((eq (oref tool :resulttype) 'file)
+ ;; Search for files
+ (when (re-search-forward "^\\([^\n]+\\)$" nil t)
+ (match-string 1)))
+ ((eq (oref tool :resulttype) 'line-and-text)
+ (when (re-search-forward grep-re nil t)
+ (list (string-to-number (match-string line-group))
+ (match-string file-group)
+ (buffer-substring-no-properties (point)
(line-end-position)))))
+ (t
+ (when (re-search-forward grep-re nil t)
+ (cons (string-to-number (match-string line-group))
+ (match-string file-group))
+ )))))
(provide 'semantic/symref/grep)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 17dae60..2b89e52 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1,4 +1,4 @@
-;;; dired-aux.el --- less commonly used parts of dired
+;;; dired-aux.el --- less commonly used parts of dired -*- lexical-binding: t
-*-
;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2017 Free Software
;; Foundation, Inc.
@@ -619,8 +619,9 @@ with a prefix argument."
This function is used to add all related commands retrieved by `mailcap'
to the end of the list of defaults just after the default value."
(interactive)
- (let ((commands (and (boundp 'files) (require 'mailcap nil t)
- (mailcap-file-default-commands files))))
+ (let* ((files minibuffer-completion-table)
+ (commands (and (require 'mailcap nil t)
+ (mailcap-file-default-commands files))))
(if (listp minibuffer-default)
(append minibuffer-default commands)
(cons minibuffer-default commands))))
@@ -638,6 +639,7 @@ This normally reads using `read-shell-command', but if the
offer a smarter default choice of shell command."
(minibuffer-with-setup-hook
(lambda ()
+ (set (make-local-variable 'minibuffer-completion-table) files)
(set (make-local-variable 'minibuffer-default-add-function)
'minibuffer-default-add-dired-shell-commands))
(setq prompt (format prompt (dired-mark-prompt arg files)))
@@ -742,8 +744,6 @@ can be produced by `dired-get-marked-files', for example."
(string-match regexp res))))
(let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep)))
(no-subst (not (dired--star-or-qmark-p command "?" 'keep)))
- (star (string-match "\\*" command))
- (qmark (string-match "\\?" command))
;; Get confirmation for wildcards that may have been meant
;; to control substitution of a file name or the file name list.
(ok (cond ((not (or on-each no-subst))
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 9155509..1425278 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -1629,10 +1629,11 @@ Binding direction based on `dired-x-hands-off-my-keys'."
(if (called-interactively-p 'interactive)
(setq dired-x-hands-off-my-keys
(not (y-or-n-p "Bind dired-x-find-file over find-file? "))))
- (define-key (current-global-map) [remap find-file]
- (if (not dired-x-hands-off-my-keys) 'dired-x-find-file))
- (define-key (current-global-map) [remap find-file-other-window]
- (if (not dired-x-hands-off-my-keys) 'dired-x-find-file-other-window)))
+ (unless dired-x-hands-off-my-keys
+ (define-key (current-global-map) [remap find-file]
+ 'dired-x-find-file)
+ (define-key (current-global-map) [remap find-file-other-window]
+ 'dired-x-find-file-other-window)))
;; Now call it so binding is correct. This could go in the :initialize
;; slot, but then dired-x-bind-find-file has to be defined before the
diff --git a/lisp/dired.el b/lisp/dired.el
index 9d500a9..54bc621 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -34,6 +34,7 @@
;;; Code:
+(eval-when-compile (require 'subr-x))
;; When bootstrapping dired-loaddefs has not been generated.
(require 'dired-loaddefs nil t)
@@ -133,7 +134,7 @@ always set this variable to t."
:type 'boolean
:group 'dired-mark)
-(defcustom dired-trivial-filenames (purecopy "^\\.\\.?$\\|^#")
+(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`#")
"Regexp of files to skip when finding first file of a directory.
A value of nil means move to the subdir line.
A value of t means move to first file."
@@ -871,6 +872,46 @@ periodically reverts at specified time intervals."
:group 'dired
:version "23.2")
+(defun dired--need-align-p ()
+ "Return non-nil if some file names are misaligned.
+The return value is the target column for the file names."
+ (save-excursion
+ (goto-char (point-min))
+ (dired-goto-next-file)
+ ;; Use point difference instead of `current-column', because
+ ;; the former works when `dired-hide-details-mode' is enabled.
+ (let* ((first (- (point) (point-at-bol)))
+ (target first))
+ (while (and (not (eobp))
+ (progn
+ (forward-line)
+ (dired-move-to-filename)))
+ (when-let* ((distance (- (point) (point-at-bol)))
+ (higher (> distance target)))
+ (setq target distance)))
+ (and (/= first target) target))))
+
+(defun dired--align-all-files ()
+ "Align all files adding spaces in front of the size column."
+ (let ((target (dired--need-align-p))
+ (regexp directory-listing-before-filename-regexp))
+ (when target
+ (save-excursion
+ (goto-char (point-min))
+ (dired-goto-next-file)
+ (while (dired-move-to-filename)
+ ;; Use point difference instead of `current-column', because
+ ;; the former works when `dired-hide-details-mode' is enabled.
+ (let ((distance (- target (- (point) (point-at-bol))))
+ (inhibit-read-only t))
+ (unless (zerop distance)
+ (re-search-backward regexp nil t)
+ (goto-char (match-beginning 0))
+ (search-backward-regexp "[[:space:]]" nil t)
+ (skip-chars-forward "[:space:]")
+ (insert-char ?\s distance 'inherit))
+ (forward-line)))))))
+
(defun dired-internal-noselect (dir-or-list &optional switches mode)
;; If DIR-OR-LIST is a string and there is an existing dired buffer
;; for it, just leave buffer as it is (don't even call dired-revert).
@@ -920,11 +961,12 @@ periodically reverts at specified time intervals."
"Directory has changed on disk; type
\\[revert-buffer] to update Dired")))))
;; Else a new buffer
(setq default-directory
- ;; We can do this unconditionally
- ;; because dired-noselect ensures that the name
- ;; is passed in directory name syntax
- ;; if it was the name of a directory at all.
- (file-name-directory dirname))
+ (or (car-safe (insert-directory-wildcard-in-dir-p dirname))
+ ;; We can do this unconditionally
+ ;; because dired-noselect ensures that the name
+ ;; is passed in directory name syntax
+ ;; if it was the name of a directory at all.
+ (file-name-directory dirname)))
(or switches (setq switches dired-listing-switches))
(if mode (funcall mode)
(dired-mode dir-or-list switches))
@@ -939,6 +981,8 @@ periodically reverts at specified time intervals."
(if failed (kill-buffer buffer))))
(goto-char (point-min))
(dired-initial-position dirname))
+ (when (consp dired-directory)
+ (dired--align-all-files))
(set-buffer old-buf)
buffer))
@@ -1056,13 +1100,14 @@ wildcards, erases the buffer, and builds the
subdir-alist anew
(not file-list))
;; If we are reading a whole single directory...
(dired-insert-directory dir dired-actual-switches nil nil t)
- (if (not (file-readable-p
- (directory-file-name (file-name-directory dir))))
- (error "Directory %s inaccessible or nonexistent" dir)
- ;; Else treat it as a wildcard spec
- ;; unless we have an explicit list of files.
- (dired-insert-directory dir dired-actual-switches
- file-list (not file-list) t)))))
+ (if (and (not (insert-directory-wildcard-in-dir-p dir))
+ (not (file-readable-p
+ (directory-file-name (file-name-directory dir)))))
+ (error "Directory %s inaccessible or nonexistent" dir))
+ ;; Else treat it as a wildcard spec
+ ;; unless we have an explicit list of files.
+ (dired-insert-directory dir dired-actual-switches
+ file-list (not file-list) t))))
(defun dired-align-file (beg end)
"Align the fields of a file to the ones of surrounding lines.
@@ -1160,7 +1205,7 @@ BEG..END is the line where the file info is located."
(setq file-col (+ spaces file-col))
(if (> file-col other-col)
(setq spaces (- spaces (- file-col other-col))))
- (insert-char ?\s spaces)
+ (insert-char ?\s spaces 'inherit)
;; Let's just make really sure we did not mess up.
(unless (save-excursion
(eq (dired-move-to-filename) (marker-position file)))
@@ -1207,29 +1252,56 @@ If HDR is non-nil, insert a header line with the
directory name."
;; as indicated by `ls-lisp-use-insert-directory-program'.
(not (and (featurep 'ls-lisp)
(null ls-lisp-use-insert-directory-program)))
- (or (if (eq dired-use-ls-dired 'unspecified)
+ (not (and (featurep 'eshell)
+ (bound-and-true-p eshell-ls-use-in-dired)))
+ (or (file-remote-p dir)
+ (if (eq dired-use-ls-dired 'unspecified)
;; Check whether "ls --dired" gives exit code 0, and
;; save the answer in `dired-use-ls-dired'.
(or (setq dired-use-ls-dired
(eq 0 (call-process insert-directory-program
- nil nil nil "--dired")))
+ nil nil nil "--dired")))
(progn
(message "ls does not support --dired; \
see `dired-use-ls-dired' for more details.")
nil))
- dired-use-ls-dired)
- (file-remote-p dir)))
+ dired-use-ls-dired)))
(setq switches (concat "--dired " switches)))
- ;; We used to specify the C locale here, to force English month names;
- ;; but this should not be necessary any more,
- ;; with the new value of `directory-listing-before-filename-regexp'.
- (if file-list
- (dolist (f file-list)
- (let ((beg (point)))
- (insert-directory f switches nil nil)
- ;; Re-align fields, if necessary.
- (dired-align-file beg (point))))
- (insert-directory dir switches wildcard (not wildcard)))
+ ;; Expand directory wildcards and fill file-list.
+ (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir)))
+ (cond (dir-wildcard
+ (setq switches (concat "-d " switches))
+ ;; We don't know whether the remote ls supports
+ ;; "--dired", so we cannot add it to the `process-file'
+ ;; call for wildcards.
+ (when (file-remote-p dir)
+ (setq switches (dired-replace-in-string "--dired" "" switches)))
+ (let* ((default-directory (car dir-wildcard))
+ (script (format "ls %s %s" switches (cdr dir-wildcard)))
+ (remotep (file-remote-p dir))
+ (sh (or (and remotep "/bin/sh")
+ (and (bound-and-true-p explicit-shell-file-name)
+ (executable-find explicit-shell-file-name))
+ (executable-find "sh")))
+ (switch (if remotep "-c" shell-command-switch)))
+ (unless
+ (zerop
+ (process-file sh nil (current-buffer) nil switch script))
+ (user-error
+ "%s: No files matching wildcard" (cdr dir-wildcard)))
+ (insert-directory-clean (point) switches)))
+ (t
+ ;; We used to specify the C locale here, to force English
+ ;; month names; but this should not be necessary any
+ ;; more, with the new value of
+ ;; `directory-listing-before-filename-regexp'.
+ (if file-list
+ (dolist (f file-list)
+ (let ((beg (point)))
+ (insert-directory f switches nil nil)
+ ;; Re-align fields, if necessary.
+ (dired-align-file beg (point))))
+ (insert-directory dir switches wildcard (not wildcard))))))
;; Quote certain characters, unless ls quoted them for us.
(if (not (dired-switches-escape-p dired-actual-switches))
(save-excursion
@@ -1279,11 +1351,14 @@ see `dired-use-ls-dired' for more details.")
;; Note that dired-build-subdir-alist will replace the name
;; by its expansion, so it does not matter whether what we insert
;; here is fully expanded, but it should be absolute.
- (insert " " (directory-file-name (file-name-directory dir)) ":\n")
+ (insert " " (or (car-safe (insert-directory-wildcard-in-dir-p dir))
+ (directory-file-name (file-name-directory dir)))
":\n")
(setq content-point (point)))
(when wildcard
;; Insert "wildcard" line where "total" line would be for a full dir.
- (insert " wildcard " (file-name-nondirectory dir) "\n")))
+ (insert " wildcard " (or (cdr-safe
(insert-directory-wildcard-in-dir-p dir))
+ (file-name-nondirectory dir))
+ "\n")))
(dired-insert-set-properties content-point (point)))))
(defun dired-insert-set-properties (beg end)
@@ -1369,18 +1444,22 @@ ARG and NOCONFIRM, passed from `revert-buffer', are
ignored."
The positions have the form (BUFFER-POSITION WINDOW-POSITIONS).
BUFFER-POSITION is the point position in the current Dired buffer.
-It has the form (BUFFER DIRED-FILENAME BUFFER-POINT).
+It has the form (BUFFER DIRED-FILENAME BUFFER-LINE-NUMBER).
WINDOW-POSITIONS are current positions in all windows displaying
this dired buffer. The window positions have the form (WINDOW
-DIRED-FILENAME WINDOW-POINT)."
+DIRED-FILENAME WINDOW-LINE-NUMBER).
+
+We store line numbers instead of point positions because the header
+lines might change as well: when this happen the line number doesn't
+change; the point does."
(list
- (list (current-buffer) (dired-get-filename nil t) (point))
+ (list (current-buffer) (dired-get-filename nil t) (line-number-at-pos))
(mapcar (lambda (w)
- (list w
- (with-selected-window w
- (dired-get-filename nil t))
- (window-point w)))
+ (with-selected-window w
+ (list w
+ (dired-get-filename nil t)
+ (line-number-at-pos (window-point w)))))
(get-buffer-window-list nil 0 t))))
(defun dired-restore-positions (positions)
@@ -1389,7 +1468,8 @@ DIRED-FILENAME WINDOW-POINT)."
(buffer (nth 0 buf-file-pos)))
(unless (and (nth 1 buf-file-pos)
(dired-goto-file (nth 1 buf-file-pos)))
- (goto-char (nth 2 buf-file-pos))
+ (goto-char (point-min))
+ (forward-line (1- (nth 2 buf-file-pos)))
(dired-move-to-filename))
(dolist (win-file-pos (nth 1 positions))
;; Ensure that window still displays the original buffer.
@@ -1397,7 +1477,8 @@ DIRED-FILENAME WINDOW-POINT)."
(with-selected-window (nth 0 win-file-pos)
(unless (and (nth 1 win-file-pos)
(dired-goto-file (nth 1 win-file-pos)))
- (goto-char (nth 2 win-file-pos))
+ (goto-char (point-min))
+ (forward-line (1- (nth 2 win-file-pos)))
(dired-move-to-filename)))))))
(defun dired-remember-marks (beg end)
@@ -2900,6 +2981,14 @@ Any other value means to ask for each directory."
;; Match anything but `.' and `..'.
(defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")
+(defconst dired-delete-help
+ "Type:
+`yes' to delete recursively the current directory,
+`no' to skip to next,
+`all' to delete all remaining directories with no more questions,
+`quit' to exit,
+`help' to show this help message.")
+
;; Delete file, possibly delete a directory and all its files.
;; This function is useful outside of dired. One could change its name
;; to e.g. recursive-delete-file and put it somewhere else.
@@ -2915,23 +3004,45 @@ its possible values is:
TRASH non-nil means to trash the file instead of deleting, provided
`delete-by-moving-to-trash' (which see) is non-nil."
- ;; This test is equivalent to
- ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
- ;; but more efficient
- (if (not (eq t (car (file-attributes file))))
- (delete-file file trash)
- (if (and recursive
- (directory-files file t dired-re-no-dot) ; Not empty.
- (or (eq recursive 'always)
- (yes-or-no-p (format "Recursively %s %s? "
- (if (and trash
- delete-by-moving-to-trash)
- "trash"
- "delete")
- (dired-make-relative file)))))
- (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
- (setq recursive nil))
- (delete-directory file recursive trash)))
+ ;; This test is equivalent to
+ ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
+ ;; but more efficient
+ (if (not (eq t (car (file-attributes file))))
+ (delete-file file trash)
+ (let* ((valid-answers (list "yes" "no" "all" "quit" "help"))
+ (answer "")
+ (input-fn
+ (lambda ()
+ (setq answer
+ (read-string
+ (format "Recursively %s %s? [yes, no, all, quit,
help] "
+ (if (and trash
+ delete-by-moving-to-trash)
+ "trash"
+ "delete")
+ (dired-make-relative file))))
+ (when (string= answer "help")
+ (with-help-window "*Help*"
+ (with-current-buffer "*Help*" (insert
dired-delete-help))))
+ answer)))
+ (if (and recursive
+ (directory-files file t dired-re-no-dot) ; Not empty.
+ (eq recursive 'always))
+ (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask
again.
+ ;; Otherwise prompt user:
+ (funcall input-fn)
+ (while (not (member answer valid-answers))
+ (unless (string= answer "help")
+ (beep)
+ (message "Please answer `yes' or `no' or `all' or `quit'")
+ (sleep-for 2))
+ (funcall input-fn))
+ (pcase answer
+ ('"all" (setq recursive 'always dired-recursive-deletes
recursive))
+ ('"yes" (if (eq recursive 'top) (setq recursive 'always)))
+ ('"no" (setq recursive nil))
+ ('"quit" (keyboard-quit))))
+ (delete-directory file recursive trash))))
(defun dired-do-flagged-delete (&optional nomessage)
"In Dired, delete the files flagged for deletion.
@@ -2980,6 +3091,9 @@ non-empty directories is allowed."
(let* ((files (mapcar #'car l))
(count (length l))
(succ 0)
+ ;; Bind `dired-recursive-deletes' so that we can change it
+ ;; locally according with the user answer within `dired-delete-file'.
+ (dired-recursive-deletes dired-recursive-deletes)
(trashing (and trash delete-by-moving-to-trash)))
;; canonicalize file list for pop up
(setq files (nreverse (mapcar #'dired-make-relative files)))
@@ -2989,6 +3103,7 @@ non-empty directories is allowed."
(if trashing "Trash" "Delete")
(dired-mark-prompt arg files)))
(save-excursion
+ (catch '--delete-cancel
(let ((progress-reporter
(make-progress-reporter
(if trashing "Trashing..." "Deleting...")
@@ -3006,6 +3121,7 @@ non-empty directories is allowed."
(dired-fun-in-all-buffers
(file-name-directory fn) (file-name-nondirectory fn)
#'dired-delete-entry fn))
+ (quit (throw '--delete-cancel (message "OK, canceled")))
(error ;; catch errors from failed deletions
(dired-log "%s\n" err)
(setq failures (cons (car (car l)) failures)))))
@@ -3016,7 +3132,7 @@ non-empty directories is allowed."
(format "%d of %d deletion%s failed"
(length failures) count
(dired-plural-s count))
- failures))))
+ failures)))))
(message "(No deletions performed)")))
(dired-move-to-filename))
diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el
index a994745..c9dd28a 100644
--- a/lisp/display-line-numbers.el
+++ b/lisp/display-line-numbers.el
@@ -38,7 +38,6 @@
"Display line numbers in the buffer."
:group 'display)
-;;;###autoload
(defcustom display-line-numbers-type t
"The default type of line numbers to use in `display-line-numbers-mode'.
See `display-line-numbers' for value options."
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 8fe9401..4a9bd6d 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -875,16 +875,16 @@ FILE's modification time."
"Save current buffer to its file, atomically."
;; Copied from byte-compile-file.
(let* ((version-control 'never)
- (tempfile (make-temp-name buffer-file-name))
+ (tempfile (make-temp-file buffer-file-name))
(kill-emacs-hook
(cons (lambda () (ignore-errors (delete-file tempfile)))
kill-emacs-hook)))
(write-region (point-min) (point-max) tempfile nil 1)
(backup-buffer)
- (rename-file tempfile buffer-file-name t)
- (set-buffer-modified-p nil)
- (set-visited-file-modtime)
- (or noninteractive (message "Wrote %s" buffer-file-name))))
+ (rename-file tempfile buffer-file-name t))
+ (set-buffer-modified-p nil)
+ (set-visited-file-modtime)
+ (or noninteractive (message "Wrote %s" buffer-file-name)))
(defun autoload-save-buffers ()
(while autoload-modified-buffers
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el
index 17f1ffa..32f7d2c 100644
--- a/lisp/emacs-lisp/avl-tree.el
+++ b/lisp/emacs-lisp/avl-tree.el
@@ -52,7 +52,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-
+(require 'generator)
;; ================================================================
@@ -670,6 +670,21 @@ a null element stored in the AVL tree.)"
(null (avl-tree--stack-store avl-tree-stack)))
+(iter-defun avl-tree-iter (tree &optional reverse)
+ "Return an AVL tree iterator object.
+
+Calling `iter-next' on this object will retrieve the next element
+from TREE. If REVERSE is non-nil, elements are returned in
+reverse order.
+
+Note that any modification to TREE *immediately* invalidates all
+iterators created from TREE before the modification (in
+particular, calling `iter-next' will give unpredictable results)."
+ (let ((stack (avl-tree-stack tree reverse)))
+ (while (not (avl-tree-stack-empty-p stack))
+ (iter-yield (avl-tree-stack-pop stack)))))
+
+
(provide 'avl-tree)
;;; avl-tree.el ends here
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index fdd4276..5fa7389 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1888,25 +1888,27 @@ The value is non-nil if there were no errors, nil if
errors."
(insert "\n") ; aaah, unix.
(if (file-writable-p target-file)
;; We must disable any code conversion here.
- (let* ((coding-system-for-write 'no-conversion)
- ;; Write to a tempfile so that if another Emacs
- ;; process is trying to load target-file (eg in a
- ;; parallel bootstrap), it does not risk getting a
- ;; half-finished file. (Bug#4196)
- (tempfile (make-temp-name target-file))
- (kill-emacs-hook
- (cons (lambda () (ignore-errors (delete-file tempfile)))
- kill-emacs-hook)))
- (write-region (point-min) (point-max) tempfile nil 1)
- ;; This has the intentional side effect that any
- ;; hard-links to target-file continue to
- ;; point to the old file (this makes it possible
- ;; for installed files to share disk space with
- ;; the build tree, without causing problems when
- ;; emacs-lisp files in the build tree are
- ;; recompiled). Previously this was accomplished by
- ;; deleting target-file before writing it.
- (rename-file tempfile target-file t)
+ (progn
+ (let* ((coding-system-for-write 'no-conversion)
+ ;; Write to a tempfile so that if another Emacs
+ ;; process is trying to load target-file (eg in a
+ ;; parallel bootstrap), it does not risk getting a
+ ;; half-finished file. (Bug#4196)
+ (tempfile (make-temp-file target-file))
+ (kill-emacs-hook
+ (cons (lambda () (ignore-errors
+ (delete-file tempfile)))
+ kill-emacs-hook)))
+ (write-region (point-min) (point-max) tempfile nil 1)
+ ;; This has the intentional side effect that any
+ ;; hard-links to target-file continue to
+ ;; point to the old file (this makes it possible
+ ;; for installed files to share disk space with
+ ;; the build tree, without causing problems when
+ ;; emacs-lisp files in the build tree are
+ ;; recompiled). Previously this was accomplished by
+ ;; deleting target-file before writing it.
+ (rename-file tempfile target-file t))
(or noninteractive (message "Wrote %s" target-file)))
;; This is just to give a better error message than write-region
(let ((exists (file-exists-p target-file)))
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 6a4ee47..1a3f8e1 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -166,6 +166,10 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value
TAG
(defmacro cl--generic (name)
`(get ,name 'cl--generic))
+(defun cl-generic-p (f)
+ "Return non-nil if F is a generic function."
+ (and (symbolp f) (cl--generic f)))
+
(defun cl-generic-ensure-function (name &optional noerror)
(let (generic
(origname name))
@@ -409,7 +413,7 @@ The set of acceptable TYPEs (also called \"specializers\")
is defined
\(and can be extended) by the various methods of `cl-generic-generalizers'.
\(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)"
- (declare (doc-string 3) (indent 2)
+ (declare (doc-string 3) (indent defun)
(debug
(&define ; this means we are defining something
[&or name ("setf" name :name setf)]
@@ -500,25 +504,26 @@ The set of acceptable TYPEs (also called
\"specializers\") is defined
(cons method mt)
;; Keep the ordering; important for methods with :extra qualifiers.
(mapcar (lambda (x) (if (eq x (car me)) method x)) mt)))
- (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format
- (cl--generic-name generic)
- qualifiers specializers))
- current-load-list :test #'equal)
- ;; FIXME: Try to avoid re-constructing a new function if the old one
- ;; is still valid (e.g. still empty method cache)?
- (let ((gfun (cl--generic-make-function generic))
- ;; Prevent `defalias' from recording this as the definition site of
- ;; the generic function.
- current-load-list)
- ;; For aliases, cl--generic-name gives us the actual name.
- (let ((purify-flag
- ;; BEWARE! Don't purify this function definition, since that
leads
- ;; to memory corruption if the hash-tables it holds are modified
- ;; (the GC doesn't trace those pointers).
- nil))
+ (let ((sym (cl--generic-name generic))) ; Actual name (for aliases).
+ (unless (symbol-function sym)
+ (defalias sym 'dummy)) ;Record definition into load-history.
+ (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format
+ (cl--generic-name generic)
+ qualifiers specializers))
+ current-load-list :test #'equal)
+ ;; FIXME: Try to avoid re-constructing a new function if the old one
+ ;; is still valid (e.g. still empty method cache)?
+ (let ((gfun (cl--generic-make-function generic))
+ ;; Prevent `defalias' from recording this as the definition site of
+ ;; the generic function.
+ current-load-list
+ ;; BEWARE! Don't purify this function definition, since that leads
+ ;; to memory corruption if the hash-tables it holds are modified
+ ;; (the GC doesn't trace those pointers).
+ (purify-flag nil))
;; But do use `defalias', so that it interacts properly with nadvice,
;; e.g. for tracing/debug-on-entry.
- (defalias (cl--generic-name generic) gfun)))))
+ (defalias sym gfun)))))
(defmacro cl--generic-with-memoization (place &rest code)
(declare (indent 1) (debug t))
@@ -1022,6 +1027,20 @@ The value returned is a list of elements of the form
(push (cl--generic-method-info method) docs))))
docs))
+(defun cl--generic-method-files (method)
+ "Return a list of files where METHOD is defined by `cl-defmethod'.
+The list will have entries of the form (FILE . (METHOD ...))
+where (METHOD ...) contains the qualifiers and specializers of
+the method and is a suitable argument for
+`find-function-search-for-symbol'. Filenames are absolute."
+ (let (result)
+ (pcase-dolist (`(,file . ,defs) load-history)
+ (dolist (def defs)
+ (when (and (eq (car-safe def) 'cl-defmethod)
+ (eq (cadr def) method))
+ (push (cons file (cdr def)) result))))
+ result))
+
;;; Support for (head <val>) specializers.
;; For both the `eql' and the `head' specializers, the dispatch
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 1494ed1..c6ef8d7 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -3213,8 +3213,8 @@ instrument cannot be found, signal an error."
((consp func-marker)
(message "%s is already instrumented." func)
(list func))
- ((get func 'cl--generic)
- (let ((method-defs (method-files func))
+ ((cl-generic-p func)
+ (let ((method-defs (cl--generic-method-files func))
symbols)
(unless method-defs
(error "Could not find any method definitions for %s" func))
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index e6e6d11..8403a8a 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -165,7 +165,8 @@ Summary:
(if (memq method '(no-next-method no-applicable-method))
(symbol-function method)
(let ((generic (cl-generic-ensure-function method)))
- (symbol-function (cl--generic-name generic)))))
+ (or (symbol-function (cl--generic-name generic))
+ (cl--generic-make-function generic)))))
;;;###autoload
(defun eieio--defmethod (method kind argclass code)
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index d4500f1..7bdd749 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -583,6 +583,11 @@ displayed."
(elp-restore-all)
;; continue standard unloading
nil)
+
+(cl-defmethod loadhist-unload-element :before :extra "elp" ((x (head defun)))
+ "Un-instrument before unloading a function."
+ (elp-restore-function (cdr x)))
+
(provide 'elp)
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 5c88b07..d7bd331 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -135,16 +135,9 @@ Emacs bug 6581 at URL
`http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
;; Note that nil is still a valid value for the `name' slot in
;; ert-test objects. It designates an anonymous test.
(error "Attempt to define a test named nil"))
- (put symbol 'ert--test definition)
- ;; Register in load-history, so `symbol-file' can find us, and so
- ;; unload-feature can unload our tests.
- (cl-pushnew `(ert-deftest . ,symbol) current-load-list :test #'equal)
+ (define-symbol-prop symbol 'ert--test definition)
definition)
-(cl-defmethod loadhist-unload-element ((x (head ert-deftest)))
- (let ((name (cdr x)))
- (put name 'ert--test nil)))
-
(defun ert-make-test-unbound (symbol)
"Make SYMBOL name no test. Return SYMBOL."
(cl-remprop symbol 'ert--test)
@@ -2406,8 +2399,7 @@ To be used in the ERT results buffer."
(buffer-disable-undo)
(erase-buffer)
(ert-simple-view-mode)
- ;; Use unibyte because `debugger-setup-buffer' also does so.
- (set-buffer-multibyte nil)
+ (set-buffer-multibyte t) ; mimic debugger-setup-buffer
(setq truncate-lines t)
(ert--print-backtrace backtrace t)
(goto-char (point-min))
@@ -2540,7 +2532,7 @@ To be used in the ERT results buffer."
(insert (if test-name (format "%S" test-name) "<anonymous test>"))
(insert " is a test")
(let ((file-name (and test-name
- (symbol-file test-name 'ert-deftest))))
+ (symbol-file test-name 'ert--test))))
(when file-name
(insert (format-message " defined in `%s'"
(file-name-nondirectory file-name)))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index b401611..253b60e 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -418,8 +418,8 @@ to this macro."
(when decl (setq body (remove decl body)))
`(progn
(defun ,fsym ,args ,@body)
- (put ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl)))
- (put ',name 'pcase-macroexpander #',fsym))))
+ (define-symbol-prop ',fsym 'edebug-form-spec ',(cadr (assq 'debug
decl)))
+ (define-symbol-prop ',name 'pcase-macroexpander #',fsym))))
(defun pcase--match (val upat)
"Build a MATCH structure, hoisting all `or's and `and's outside."
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index f60d723..2eff1d1 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -64,8 +64,8 @@
;; syntax and string syntax are both delimited by `"'s and behave
;; according to their name. With the `string' syntax there's no need
;; to escape the backslashes and double quotes simplifying the editing
-;; somewhat. The other three allow editing of symbolic regular
-;; expressions supported by the packages of the same name.
+;; somewhat. The `rx' syntax allows editing of symbolic regular
+;; expressions supported by the package of the same name.
;; Editing symbolic expressions is done through a major mode derived
;; from `emacs-lisp-mode' so you'll get all the good stuff like
diff --git a/lisp/emacs-lisp/tabulated-list.el
b/lisp/emacs-lisp/tabulated-list.el
index b6b49b1..8ff5cdf 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -194,6 +194,8 @@ Populated by `tabulated-list-init-header'.")
mouse-face highlight
keymap ,tabulated-list-sort-button-map))
(cols nil))
+ (if display-line-numbers
+ (setq x (+ x (line-number-display-width) 2)))
(push (propertize " " 'display `(space :align-to ,x)) cols)
(dotimes (n (length tabulated-list-format))
(let* ((col (aref tabulated-list-format n))
@@ -410,6 +412,8 @@ of column descriptors."
(x (max tabulated-list-padding 0))
(ncols (length tabulated-list-format))
(inhibit-read-only t))
+ (if display-line-numbers
+ (setq x (+ x (line-number-display-width) 2)))
(if (> tabulated-list-padding 0)
(insert (make-string x ?\s)))
(let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506).
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 79799db..38e3813 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -65,17 +65,19 @@ This is useful for enabling human-readable format (-h), for
example."
"If non-nil, use `eshell-ls' to read directories in Dired.
Changing this without using customize has no effect."
:set (lambda (symbol value)
- (if value
- (advice-add 'insert-directory :around
- #'eshell-ls--insert-directory)
- (advice-remove 'insert-directory
- #'eshell-ls--insert-directory))
+ (cond (value
+ (require 'dired)
+ (advice-add 'insert-directory :around
+ #'eshell-ls--insert-directory)
+ (advice-add 'dired :around #'eshell-ls--dired))
+ (t
+ (advice-remove 'insert-directory
+ #'eshell-ls--insert-directory)
+ (advice-remove 'dired #'eshell-ls--dired)))
(set symbol value))
:type 'boolean
:require 'em-ls)
-(add-hook 'eshell-ls-unload-hook
- (lambda () (advice-remove 'insert-directory
- #'eshell-ls--insert-directory)))
+(add-hook 'eshell-ls-unload-hook #'eshell-ls-unload-function)
(defcustom eshell-ls-default-blocksize 1024
@@ -241,6 +243,9 @@ scope during the evaluation of TEST-SEXP."
;;; Functions:
+(declare-function eshell-extended-glob "em-glob" (glob))
+(defvar eshell-error-if-no-glob)
+
(defun eshell-ls--insert-directory
(orig-fun file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
@@ -273,11 +278,53 @@ instead."
(set 'font-lock-buffers
(delq (current-buffer)
(symbol-value 'font-lock-buffers)))))
- (let ((insert-func 'insert)
- (error-func 'insert)
- (flush-func 'ignore)
- eshell-ls-dired-initial-args)
- (eshell-do-ls (append switches (list file)))))))))
+ (require 'em-glob)
+ (let* ((insert-func 'insert)
+ (error-func 'insert)
+ (flush-func 'ignore)
+ (eshell-error-if-no-glob t)
+ (target ; Expand the shell wildcards if any.
+ (if (and (atom file)
+ (string-match "[[?*]" file)
+ (not (file-exists-p file)))
+ (mapcar #'file-relative-name (eshell-extended-glob file))
+ (file-relative-name file)))
+ (switches
+ (append eshell-ls-dired-initial-args
+ (and (or (consp dired-directory) wildcard) (list
"-d"))
+ switches)))
+ (eshell-do-ls (nconc switches (list target)))))))))
+
+
+(declare-function eshell-extended-glob "em-glob" (glob))
+(declare-function dired-read-dir-and-switches "dired" (str))
+(declare-function dired-goto-next-file "dired" ())
+
+(defun eshell-ls--dired (orig-fun dir-or-list &optional switches)
+ (interactive (dired-read-dir-and-switches ""))
+ (require 'em-glob)
+ (if (consp dir-or-list)
+ (funcall orig-fun dir-or-list switches)
+ (let ((dir-wildcard (insert-directory-wildcard-in-dir-p
+ (expand-file-name dir-or-list))))
+ (if (not dir-wildcard)
+ (funcall orig-fun dir-or-list switches)
+ (let* ((default-directory (car dir-wildcard))
+ (files (eshell-extended-glob (cdr dir-wildcard)))
+ (dir (car dir-wildcard)))
+ (if files
+ (let ((inhibit-read-only t)
+ (buf
+ (apply orig-fun
+ (nconc (list dir) files)
+ (and switches (list switches)))))
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (point-min))
+ (dired-goto-next-file)
+ (forward-line 0)
+ (insert " wildcard " (cdr dir-wildcard) "\n"))))
+ (user-error "No files matching regexp")))))))
(defsubst eshell/ls (&rest args)
"An alias version of `eshell-do-ls'."
@@ -909,6 +956,11 @@ to use, and each member of which is the width of that
column
(car file)))))
(car file))
+(defun eshell-ls-unload-function ()
+ (advice-remove 'insert-directory #'eshell-ls--insert-directory)
+ (advice-remove 'dired #'eshell-ls--dired)
+ nil)
+
(provide 'em-ls)
;; Local Variables:
diff --git a/lisp/faces.el b/lisp/faces.el
index 97c3216..5ed11d1 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -104,7 +104,9 @@ a font height that isn't optimal."
;; when combined with Monospaced and with other standard fonts.
;; One of its uses is for 'tex-verbatim' and 'Info-quoted' faces,
;; so the result must be different from the default face's font,
- ;; and must be monospaced.
+ ;; and must be monospaced. For 'tex-verbatim', it is desirable
+ ;; that the font really is a Serif font, so as to look like
+ ;; TeX's 'verbatim'.
("Monospace Serif"
;; This looks good on GNU/Linux.
@@ -1452,7 +1454,7 @@ If FRAME is omitted or nil, use the selected frame."
(setq face (list face)))
(with-help-window (help-buffer)
(with-current-buffer standard-output
- (dolist (f face)
+ (dolist (f face (buffer-string))
(if (stringp f) (setq f (intern f)))
;; We may get called for anonymous faces (i.e., faces
;; expressed using prop-value plists). Those can't be
diff --git a/lisp/files.el b/lisp/files.el
index 321a35b..c9114be 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -978,12 +978,15 @@ or mount points potentially requiring authentication as a
different user.")
;; nil)))
(defun locate-dominating-file (file name)
- "Look up the directory hierarchy from FILE for a directory containing NAME.
+ "Starting from FILE, look up directory hierarchy for directory containing
NAME.
+FILE can be a file or a directory. If it's a file, its directory will
+serve as the starting point for searching the hierarchy of directories.
Stop at the first parent directory containing a file NAME,
and return the directory. Return nil if not found.
Instead of a string, NAME can also be a predicate taking one argument
\(a directory) and returning a non-nil value if that directory is the one for
-which we're looking."
+which we're looking. The predicate will be called with every file/directory
+the function needs to examine, starting with FILE."
;; We used to use the above locate-dominating-files code, but the
;; directory-files call is very costly, so we're much better off doing
;; multiple calls using the code in here.
@@ -1596,8 +1599,8 @@ automatically choosing a major mode, use
\\[find-file-literally]."
(confirm-nonexistent-file-or-buffer)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
- (mapcar 'switch-to-buffer (nreverse value))
- (switch-to-buffer value))))
+ (mapcar 'pop-to-buffer-same-window (nreverse value))
+ (pop-to-buffer-same-window value))))
(defun find-file-other-window (filename &optional wildcards)
"Edit file FILENAME, in another window.
@@ -6552,6 +6555,75 @@ regardless of the language.")
(defvar insert-directory-ls-version 'unknown)
+(defun insert-directory-wildcard-in-dir-p (dir)
+ "Return non-nil if DIR contents a shell wildcard in the directory part.
+The return value is a cons (DIR . WILDCARDS); DIR is the
+`default-directory' in the Dired buffer, and WILDCARDS are the wildcards.
+
+Valid wildcards are '*', '?', '[abc]' and '[a-z]'."
+ (let ((wildcards "[?*"))
+ (when (and (or (not (featurep 'ls-lisp))
+ ls-lisp-support-shell-wildcards)
+ (string-match (concat "[" wildcards "]") (file-name-directory
dir))
+ (not (file-exists-p dir))) ; Prefer an existing file to
wildcards.
+ (let ((regexp (format "\\`\\([^%s]*/\\)\\([^%s]*[%s].*\\)"
+ wildcards wildcards wildcards)))
+ (string-match regexp dir)
+ (cons (match-string 1 dir) (match-string 2 dir))))))
+
+(defun insert-directory-clean (beg switches)
+ (when (if (stringp switches)
+ (string-match "--dired\\>" switches)
+ (member "--dired" switches))
+ ;; The following overshoots by one line for an empty
+ ;; directory listed with "--dired", but without "-a"
+ ;; switch, where the ls output contains a
+ ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
+ ;; We take care of that case later.
+ (forward-line -2)
+ (when (looking-at "//SUBDIRED//")
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (forward-line -1))
+ (if (looking-at "//DIRED//")
+ (let ((end (line-end-position))
+ (linebeg (point))
+ error-lines)
+ ;; Find all the lines that are error messages,
+ ;; and record the bounds of each one.
+ (goto-char beg)
+ (while (< (point) linebeg)
+ (or (eql (following-char) ?\s)
+ (push (list (point) (line-end-position)) error-lines))
+ (forward-line 1))
+ (setq error-lines (nreverse error-lines))
+ ;; Now read the numeric positions of file names.
+ (goto-char linebeg)
+ (forward-word-strictly 1)
+ (forward-char 3)
+ (while (< (point) end)
+ (let ((start (insert-directory-adj-pos
+ (+ beg (read (current-buffer)))
+ error-lines))
+ (end (insert-directory-adj-pos
+ (+ beg (read (current-buffer)))
+ error-lines)))
+ (if (memq (char-after end) '(?\n ?\s))
+ ;; End is followed by \n or by " -> ".
+ (put-text-property start end 'dired-filename t)
+ ;; It seems that we can't trust ls's output as to
+ ;; byte positions of filenames.
+ (put-text-property beg (point) 'dired-filename nil)
+ (end-of-line))))
+ (goto-char end)
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ;; Take care of the case where the ls output contains a
+ ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
+ ;; and we went one line too far back (see above).
+ (forward-line 1))
+ (if (looking-at "//DIRED-OPTIONS//")
+ (delete-region (point) (progn (forward-line 1) (point))))))
+
;; insert-directory
;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
;; FULL-DIRECTORY-P is nil.
@@ -6611,19 +6683,25 @@ normally equivalent short `-D' option is just passed on
to
default-file-name-coding-system))))
(setq result
(if wildcard
- ;; Run ls in the directory part of the file pattern
- ;; using the last component as argument.
- (let ((default-directory
- (if (file-name-absolute-p file)
- (file-name-directory file)
- (file-name-directory (expand-file-name file))))
- (pattern (file-name-nondirectory file)))
+ ;; If the wildcard is just in the file part, then run ls
in
+ ;; the directory part of the file pattern using the last
+ ;; component as argument. Otherwise, run ls in the
longest
+ ;; subdirectory of the directory part free of wildcards;
use
+ ;; the remaining of the file pattern as argument.
+ (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p
file))
+ (default-directory
+ (cond (dir-wildcard (car dir-wildcard))
+ (t
+ (if (file-name-absolute-p file)
+ (file-name-directory file)
+ (file-name-directory (expand-file-name
file))))))
+ (pattern (if dir-wildcard (cdr dir-wildcard)
(file-name-nondirectory file))))
;; NB since switches is passed to the shell, be
;; careful of malicious values, eg "-l;reboot".
;; See eg dired-safe-switches-p.
(call-process
shell-file-name nil t nil
- "-c"
+ shell-command-switch
(concat (if (memq system-type '(ms-dos windows-nt))
""
"\\") ; Disregard Unix shell aliases!
@@ -6665,7 +6743,8 @@ normally equivalent short `-D' option is just passed on to
(setq file (expand-file-name file)))
(list
(if full-directory-p
- (concat (file-name-as-directory file) ".")
+ ;; (concat (file-name-as-directory file) ".")
+ file
file))))))))
;; If we got "//DIRED//" in the output, it means we got a real
@@ -6736,59 +6815,7 @@ normally equivalent short `-D' option is just passed on
to
;; Unix. Access the file to get a suitable error.
(access-file file "Reading directory")
(error "Listing directory failed but `access-file' worked")))
-
- (when (if (stringp switches)
- (string-match "--dired\\>" switches)
- (member "--dired" switches))
- ;; The following overshoots by one line for an empty
- ;; directory listed with "--dired", but without "-a"
- ;; switch, where the ls output contains a
- ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
- ;; We take care of that case later.
- (forward-line -2)
- (when (looking-at "//SUBDIRED//")
- (delete-region (point) (progn (forward-line 1) (point)))
- (forward-line -1))
- (if (looking-at "//DIRED//")
- (let ((end (line-end-position))
- (linebeg (point))
- error-lines)
- ;; Find all the lines that are error messages,
- ;; and record the bounds of each one.
- (goto-char beg)
- (while (< (point) linebeg)
- (or (eql (following-char) ?\s)
- (push (list (point) (line-end-position)) error-lines))
- (forward-line 1))
- (setq error-lines (nreverse error-lines))
- ;; Now read the numeric positions of file names.
- (goto-char linebeg)
- (forward-word-strictly 1)
- (forward-char 3)
- (while (< (point) end)
- (let ((start (insert-directory-adj-pos
- (+ beg (read (current-buffer)))
- error-lines))
- (end (insert-directory-adj-pos
- (+ beg (read (current-buffer)))
- error-lines)))
- (if (memq (char-after end) '(?\n ?\s))
- ;; End is followed by \n or by " -> ".
- (put-text-property start end 'dired-filename t)
- ;; It seems that we can't trust ls's output as to
- ;; byte positions of filenames.
- (put-text-property beg (point) 'dired-filename nil)
- (end-of-line))))
- (goto-char end)
- (beginning-of-line)
- (delete-region (point) (progn (forward-line 1) (point))))
- ;; Take care of the case where the ls output contains a
- ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
- ;; and we went one line too far back (see above).
- (forward-line 1))
- (if (looking-at "//DIRED-OPTIONS//")
- (delete-region (point) (progn (forward-line 1) (point)))))
-
+ (insert-directory-clean beg switches)
;; Now decode what read if necessary.
(let ((coding (or coding-system-for-read
file-name-coding-system
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index a92d477..2292b5f 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -1,4 +1,4 @@
-;;; find-dired.el --- run a `find' command and dired the output
+;;; find-dired.el --- run a `find' command and dired the output -*-
lexical-binding: t -*-
;; Copyright (C) 1992, 1994-1995, 2000-2017 Free Software Foundation,
;; Inc.
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el
index e9f8444..a795211 100644
--- a/lisp/find-lisp.el
+++ b/lisp/find-lisp.el
@@ -1,4 +1,4 @@
-;;; find-lisp.el --- emulation of find in Emacs Lisp
+;;; find-lisp.el --- emulation of find in Emacs Lisp -*- lexical-binding: t
-*-
;; Author: Peter Breton
;; Created: Fri Mar 26 1999
diff --git a/lisp/frame.el b/lisp/frame.el
index 634367e..2a14302 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -2158,7 +2158,7 @@ To adjust bottom dividers for frames individually, use
the frame
parameter `bottom-divider-width'."
:type '(restricted-sexp
:tag "Default width of bottom dividers"
- :match-alternatives (frame-window-divider-width-valid-p))
+ :match-alternatives (window-divider-width-valid-p))
:initialize 'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
@@ -2175,7 +2175,7 @@ To adjust right dividers for frames individually, use the
frame
parameter `right-divider-width'."
:type '(restricted-sexp
:tag "Default width of right dividers"
- :match-alternatives (frame-window-divider-width-valid-p))
+ :match-alternatives (window-divider-width-valid-p))
:initialize 'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 10cdeed..177589c 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -393,7 +393,7 @@ apply the face `mm-uu-extract'."
(defun mm-uu-org-src-code-block-extract ()
(mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
- '("text/x-org")))
+ '("text/x-org" (charset . gnus-decoded))))
(defvar gnus-newsgroup-name)
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 3fb793e..24dfb91 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -393,12 +393,12 @@ it does not already exist."
(defvar describe-symbol-backends
`((nil ,#'fboundp ,(lambda (s _b _f) (describe-function s)))
- ("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))
(nil
,(lambda (symbol)
(or (and (boundp symbol) (not (keywordp symbol)))
(get symbol 'variable-documentation)))
- ,#'describe-variable)))
+ ,#'describe-variable)
+ ("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))))
;;;###autoload
(defun help-make-xrefs (&optional buffer)
diff --git a/lisp/ido.el b/lisp/ido.el
index 07a5bcf..defb744 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1,4 +1,4 @@
-;;; ido.el --- interactively do things with buffers and files
+;;; ido.el --- interactively do things with buffers and files -*-
lexical-binding: t -*-
;; Copyright (C) 1996-2017 Free Software Foundation, Inc.
diff --git a/lisp/info.el b/lisp/info.el
index a207153..c7f0bbf 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -171,7 +171,11 @@ A header-line does not scroll with the rest of the buffer."
;; defvar and explicitly give it a standard-value property, and
;; call custom-initialize-delay on it.
;; The progn forces the autoloader to include the whole thing, not
-;; just an abbreviated version.
+;; just an abbreviated version. The value is initialized at startup
+;; time, when command-line calls custom-reevaluate-setting on all
+;; the defcustoms in custom-delayed-init-variables. This is
+;; somewhat sub-optimal, as ideally this should be done when Info
+;; mode is first invoked.
;;;###autoload
(progn
(defcustom Info-default-directory-list
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index 68a412f..a7764b6 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1175,7 +1175,8 @@
:short-name "CNS11643-15"
:long-name "CNS11643-15 (Chinese traditional)"
:code-space [33 126 33 126]
- :code-offset #x27A000)
+ :code-offset #x27A000
+ :unify-map "CNS-F")
(unify-charset 'chinese-gb2312)
(unify-charset 'chinese-gbk)
@@ -1186,6 +1187,7 @@
(unify-charset 'chinese-cns11643-5)
(unify-charset 'chinese-cns11643-6)
(unify-charset 'chinese-cns11643-7)
+(unify-charset 'chinese-cns11643-15)
(unify-charset 'big5)
(unify-charset 'chinese-big5-1)
(unify-charset 'chinese-big5-2)
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 472972e..2db8061 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -1,4 +1,4 @@
-;;; kmacro.el --- enhanced keyboard macros
+;;; kmacro.el --- enhanced keyboard macros -*- lexical-binding: t -*-
;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index dababdb..0cb2eb4 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -1102,6 +1102,15 @@ options only, i.e. behave like `apropos-user-option'.
\(fn PATTERN &optional DO-NOT-ALL)" t nil)
+(autoload 'apropos-local-variable "apropos" "\
+Show buffer-local variables that match PATTERN.
+Optional arg BUFFER (default: current buffer) is the buffer to check.
+
+The output includes variables that are not yet set in BUFFER, but that
+will be buffer-local when set.
+
+\(fn PATTERN &optional BUFFER)" t nil)
+
(defalias 'command-apropos 'apropos-command)
(autoload 'apropos-command "apropos" "\
@@ -1167,6 +1176,13 @@ Returns list of symbols and values found.
\(fn PATTERN &optional DO-ALL)" t nil)
+(autoload 'apropos-local-value "apropos" "\
+Show buffer-local variables whose values match PATTERN.
+This is like `apropos-value', but only for buffer-local variables.
+Optional arg BUFFER (default: current buffer) is the buffer to check.
+
+\(fn PATTERN &optional BUFFER)" t nil)
+
(autoload 'apropos-documentation "apropos" "\
Show symbols whose documentation contains matches for PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
@@ -2878,6 +2894,8 @@ columns on its right towards the left.
(put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp
s) (and (symbolp s) (get s 'bug-reference-url-format)))))
+(put 'bug-reference-bug-regexp 'safe-local-variable 'stringp)
+
(autoload 'bug-reference-mode "bug-reference" "\
Toggle hyperlinking bug references in the buffer (Bug Reference mode).
With a prefix argument ARG, enable Bug Reference mode if ARG is
@@ -7684,6 +7702,46 @@ in `.emacs'.
;;;***
+;;;### (autoloads nil "display-line-numbers" "display-line-numbers.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from display-line-numbers.el
+
+(autoload 'display-line-numbers-mode "display-line-numbers" "\
+Toggle display of line numbers in the buffer.
+This uses `display-line-numbers' internally.
+
+To change the type of line numbers displayed by default,
+customize `display-line-numbers-type'. To change the type while
+the mode is on, set `display-line-numbers' directly.
+
+\(fn &optional ARG)" t nil)
+
+(defvar global-display-line-numbers-mode nil "\
+Non-nil if Global Display-Line-Numbers mode is enabled.
+See the `global-display-line-numbers-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `global-display-line-numbers-mode'.")
+
+(custom-autoload 'global-display-line-numbers-mode "display-line-numbers" nil)
+
+(autoload 'global-display-line-numbers-mode "display-line-numbers" "\
+Toggle Display-Line-Numbers mode in all buffers.
+With prefix ARG, enable Global Display-Line-Numbers mode if ARG is positive;
+otherwise, disable it. If called from Lisp, enable the mode if
+ARG is omitted or nil.
+
+Display-Line-Numbers mode is enabled in all buffers where
+`display-line-numbers--turn-on' would do it.
+See `display-line-numbers-mode' for more information on Display-Line-Numbers
mode.
+
+\(fn &optional ARG)" t nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"display-line-numbers" '("display-line-numbers-")))
+
+;;;***
+
;;;### (autoloads nil "dissociate" "play/dissociate.el" (0 0 0 0))
;;; Generated autoloads from play/dissociate.el
@@ -11892,9 +11950,12 @@ Render FILE using EWW.
(autoload 'eww-search-words "eww" "\
Search the web for the text between BEG and END.
-See the `eww-search-prefix' variable for the search engine used.
+If region is active (and not whitespace), search the web for
+the text between BEG and END. Else, prompt the user for a search
+string. See the `eww-search-prefix' variable for the search
+engine used.
-\(fn &optional BEG END)" t nil)
+\(fn)" t nil)
(autoload 'eww-mode "eww" "\
Mode for browsing the web.
@@ -11935,7 +11996,7 @@ command to find the next error. The buffer is also in
`comint-mode' and
(autoload 'executable-set-magic "executable" "\
Set this buffer's interpreter to INTERPRETER with optional ARGUMENT.
-The variables `executable-magicless-file-regexp', `executable-prefix',
+The variables `executable-magicless-file-regexp', `executable-prefix-env',
`executable-insert', `executable-query' and `executable-chmod' control
when and how magic numbers are inserted or replaced and scripts made
executable.
@@ -12316,7 +12377,8 @@ If `ffap-url-regexp' is not nil, the FILENAME may also
be an URL.
With a prefix, this command behaves exactly like `ffap-file-finder'.
If `ffap-require-prefix' is set, the prefix meaning is reversed.
See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
-and the functions `ffap-file-at-point' and `ffap-url-at-point'.
+`ffap-url-unwrap-local', `ffap-url-unwrap-remote', and the functions
+`ffap-file-at-point' and `ffap-url-at-point'.
\(fn &optional FILENAME)" t nil)
@@ -14998,8 +15060,12 @@ List of hook functions run by `grep-process-setup'
(see `run-hooks').")
(custom-autoload 'grep-setup-hook "grep" t)
-(defconst grep-regexp-alist '(("^\\(.*?[^/\n]\\):[ ]*\\([1-9][0-9]*\\)[
]*:" 1 2 ((lambda nil (when grep-highlight-matches (let* ((beg (match-end 0))
(end (save-excursion (goto-char beg) (line-end-position))) (mbeg
(text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (-
mbeg beg))))) lambda nil (when grep-highlight-matches (let* ((beg (match-end
0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg
(text-property-any beg end 'font-lock-face grep-match [...]
-Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
+(autoload 'grep-regexp-alist "grep" "\
+Return a regexp alist to match grep hits.
+The regexp used depends on `grep-use-null-filename-separator'.
+See `compilation-error-regexp-alist' for format details.
+
+\(fn)" nil nil)
(defvar grep-program (purecopy "grep") "\
The default grep program for `grep-command' and `grep-find-command'.
@@ -19147,7 +19213,8 @@ Use \\[kmacro-insert-counter] to insert (and increment)
the macro counter.
The counter value can be set or modified via \\[kmacro-set-counter] and
\\[kmacro-add-counter].
The format of the counter can be modified via \\[kmacro-set-format].
-Use \\[kmacro-name-last-macro] to give it a permanent name.
+Use \\[kmacro-name-last-macro] to give it a name that will remain valid even
+after another macro is defined.
Use \\[kmacro-bind-to-key] to bind it to a key sequence.
\(fn ARG)" t nil)
@@ -19175,8 +19242,8 @@ just the last key in the key sequence that you used to
call this
command. See `kmacro-call-repeat-key' and `kmacro-call-repeat-with-arg'
for details on how to adjust or disable this behavior.
-To make a macro permanent so you can call it even after defining
-others, use \\[kmacro-name-last-macro].
+To give a macro a name so you can call it even after defining others,
+use \\[kmacro-name-last-macro].
\(fn ARG &optional NO-REPEAT END-MACRO MACRO)" t nil)
@@ -19211,8 +19278,8 @@ Call last keyboard macro, ending it first if currently
being defined.
With numeric prefix ARG, repeat macro that many times.
Zero argument means repeat until there is an error.
-To give a macro a permanent name, so you can call it
-even after defining other macros, use \\[kmacro-name-last-macro].
+To give a macro a name, so you can call it even after defining other
+macros, use \\[kmacro-name-last-macro].
\(fn ARG &optional NO-REPEAT)" t nil)
@@ -19522,7 +19589,7 @@ something strange, such as redefining an Emacs function.
\(fn FEATURE &optional FORCE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"loadhist" '("unload-" "loadhist-hook-functions" "read-feature" "feature-"
"file-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"loadhist" '("loadhist-" "unload-" "read-feature" "feature-" "file-")))
;;;***
@@ -20360,7 +20427,7 @@ Default bookmark handler for Man buffers.
;;;### (autoloads nil "map" "emacs-lisp/map.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/map.el
-(push (purecopy '(map 1 1)) package--builtin-versions)
+(push (purecopy '(map 1 2)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"map" '("map")))
@@ -22710,10 +22777,25 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-J" "org/ob-J.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-J.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-J" '("obj-" "org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-R" "org/ob-R.el" (0 0 0 0))
;;; Generated autoloads from org/ob-R.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-R" '("org-babel-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-R" '("ob-R-" "org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-abc" "org/ob-abc.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-abc.el
+(push (purecopy '(ob-abc 0 1)) package--builtin-versions)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-abc" '("org-babel-")))
;;;***
@@ -22753,6 +22835,13 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-coq" "org/ob-coq.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-coq.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-coq" '("org-babel-" "coq-program-name")))
+
+;;;***
+
;;;### (autoloads "actual autoloads are elsewhere" "ob-core" "org/ob-core.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ob-core.el
@@ -22782,6 +22871,14 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-ebnf" "org/ob-ebnf.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-ebnf.el
+(push (purecopy '(ob-ebnf 1 0)) package--builtin-versions)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-ebnf" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-emacs-lisp" "org/ob-emacs-lisp.el" (0 0
;;;;;; 0 0))
;;; Generated autoloads from org/ob-emacs-lisp.el
@@ -22804,6 +22901,13 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-forth" "org/ob-forth.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-forth.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-forth" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-fortran" "org/ob-fortran.el" (0 0 0 0))
;;; Generated autoloads from org/ob-fortran.el
@@ -22818,6 +22922,13 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-groovy" "org/ob-groovy.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-groovy.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-groovy" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-haskell" "org/ob-haskell.el" (0 0 0 0))
;;; Generated autoloads from org/ob-haskell.el
@@ -22857,7 +22968,7 @@ Many aspects this mode can be customized using
;;;### (autoloads nil "ob-latex" "org/ob-latex.el" (0 0 0 0))
;;; Generated autoloads from org/ob-latex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-latex" '("org-babel-" "convert-pdf")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-latex" '("org-babel-")))
;;;***
@@ -22890,6 +23001,13 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-lua" "org/ob-lua.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-lua.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-lua" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-makefile" "org/ob-makefile.el" (0 0 0 0))
;;; Generated autoloads from org/ob-makefile.el
@@ -22953,6 +23071,14 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-processing" "org/ob-processing.el" (0 0
+;;;;;; 0 0))
+;;; Generated autoloads from org/ob-processing.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-processing" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-python" "org/ob-python.el" (0 0 0 0))
;;; Generated autoloads from org/ob-python.el
@@ -23002,10 +23128,18 @@ Many aspects this mode can be customized using
;;;***
-;;;### (autoloads nil "ob-sh" "org/ob-sh.el" (0 0 0 0))
-;;; Generated autoloads from org/ob-sh.el
+;;;### (autoloads nil "ob-sed" "org/ob-sed.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-sed.el
+(push (purecopy '(ob-sed 0 1 0)) package--builtin-versions)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-sed" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-shell" "org/ob-shell.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-shell.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-sh" '("org-babel-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-shell" '("org-babel-")))
;;;***
@@ -23019,7 +23153,7 @@ Many aspects this mode can be customized using
;;;### (autoloads nil "ob-sql" "org/ob-sql.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sql.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-sql" '("org-babel-" "dbstring-mysql")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-sql" '("org-babel-")))
;;;***
@@ -23030,6 +23164,13 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-stan" "org/ob-stan.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-stan.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"ob-stan" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-table" "org/ob-table.el" (0 0 0 0))
;;; Generated autoloads from org/ob-table.el
@@ -23137,7 +23278,7 @@ Load the languages defined in
`org-babel-load-languages'.
\(fn SYM VALUE)" nil nil)
(autoload 'org-babel-load-file "org" "\
-Load Emacs Lisp source code blocks in the Org-mode FILE.
+Load Emacs Lisp source code blocks in the Org FILE.
This function exports the source code using `org-babel-tangle'
and then loads the resulting file using `load-file'. With prefix
arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp
@@ -23146,10 +23287,11 @@ file to byte-code before it is loaded.
\(fn FILE &optional COMPILE)" t nil)
(autoload 'org-version "org" "\
-Show the org-mode version in the echo area.
-With prefix argument HERE, insert it at point.
-When FULL is non-nil, use a verbose version string.
-When MESSAGE is non-nil, display a message with the version.
+Show the Org version.
+Interactively, or when MESSAGE is non-nil, show it in echo area.
+With prefix argument, or when HERE is non-nil, insert it at point.
+In non-interactive uses, a reduced version string is output unless
+FULL is given.
\(fn &optional HERE FULL MESSAGE)" t nil)
@@ -23167,15 +23309,15 @@ Set up hooks for clock persistence.
Outline-based notes management and organizer, alias
\"Carsten's outline-mode for keeping track of everything.\"
-Org-mode develops organizational tasks around a NOTES file which
-contains information about projects as plain text. Org-mode is
-implemented on top of outline-mode, which is ideal to keep the content
+Org mode develops organizational tasks around a NOTES file which
+contains information about projects as plain text. Org mode is
+implemented on top of Outline mode, which is ideal to keep the content
of large files well structured. It supports ToDo items, deadlines and
time stamps, which magically appear in the diary listing of the Emacs
calendar. Tables are easily created with a built-in table editor.
Plain text URL-like links connect to websites, emails (VM), Usenet
messages (Gnus), BBDB entries, and any files related to the project.
-For printing and sharing of notes, an Org-mode file (or a part of it)
+For printing and sharing of notes, an Org file (or a part of it)
can be exported as a structured ASCII or HTML file.
The following commands are available:
@@ -23185,58 +23327,60 @@ The following commands are available:
\(fn)" t nil)
(autoload 'org-cycle "org" "\
-TAB-action and visibility cycling for Org-mode.
+TAB-action and visibility cycling for Org mode.
-This is the command invoked in Org-mode by the TAB key. Its main purpose
-is outline visibility cycling, but it also invokes other actions
+This is the command invoked in Org mode by the `TAB' key. Its main
+purpose is outline visibility cycling, but it also invokes other actions
in special contexts.
-- When this function is called with a prefix argument, rotate the entire
- buffer through 3 states (global cycling)
+When this function is called with a `\\[universal-argument]' prefix, rotate
the entire
+buffer through 3 states (global cycling)
1. OVERVIEW: Show only top-level headlines.
2. CONTENTS: Show all headlines of all levels, but no body text.
3. SHOW ALL: Show everything.
- When called with two `C-u C-u' prefixes, switch to the startup visibility,
- determined by the variable `org-startup-folded', and by any VISIBILITY
- properties in the buffer.
- When called with three `C-u C-u C-u' prefixed, show the entire buffer,
- including any drawers.
-- When inside a table, re-align the table and move to the next field.
+With a `\\[universal-argument] \\[universal-argument]' prefix argument, switch
to the startup visibility,
+determined by the variable `org-startup-folded', and by any VISIBILITY
+properties in the buffer.
+
+With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]'
prefix argument, show the entire buffer, including
+any drawers.
-- When point is at the beginning of a headline, rotate the subtree started
- by this line through 3 different states (local cycling)
+When inside a table, re-align the table and move to the next field.
+
+When point is at the beginning of a headline, rotate the subtree started
+by this line through 3 different states (local cycling)
1. FOLDED: Only the main headline is shown.
2. CHILDREN: The main headline and the direct children are shown.
From this state, you can move to one of the children
and zoom in further.
3. SUBTREE: Show the entire subtree, including body text.
- If there is no subtree, switch directly from CHILDREN to FOLDED.
+If there is no subtree, switch directly from CHILDREN to FOLDED.
-- When point is at the beginning of an empty headline and the variable
- `org-cycle-level-after-item/entry-creation' is set, cycle the level
- of the headline by demoting and promoting it to likely levels. This
- speeds up creation document structure by pressing TAB once or several
- times right after creating a new headline.
+When point is at the beginning of an empty headline and the variable
+`org-cycle-level-after-item/entry-creation' is set, cycle the level
+of the headline by demoting and promoting it to likely levels. This
+speeds up creation document structure by pressing `TAB' once or several
+times right after creating a new headline.
-- When there is a numeric prefix, go up to a heading with level ARG, do
- a `show-subtree' and return to the previous cursor position. If ARG
- is negative, go up that many levels.
+When there is a numeric prefix, go up to a heading with level ARG, do
+a `show-subtree' and return to the previous cursor position. If ARG
+is negative, go up that many levels.
-- When point is not at the beginning of a headline, execute the global
- binding for TAB, which is re-indenting the line. See the option
- `org-cycle-emulate-tab' for details.
+When point is not at the beginning of a headline, execute the global
+binding for `TAB', which is re-indenting the line. See the option
+`org-cycle-emulate-tab' for details.
-- Special case: if point is at the beginning of the buffer and there is
- no headline in line 1, this function will act as if called with prefix arg
- (C-u TAB, same as S-TAB) also when called without prefix arg.
- But only if also the variable `org-cycle-global-at-bob' is t.
+As a special case, if point is at the beginning of the buffer and there is
+no headline in line 1, this function will act as if called with prefix arg
+\(`\\[universal-argument] TAB', same as `S-TAB') also when called without
prefix arg, but only
+if the variable `org-cycle-global-at-bob' is t.
\(fn &optional ARG)" t nil)
(autoload 'org-global-cycle "org" "\
Cycle the global visibility. For details see `org-cycle'.
-With \\[universal-argument] prefix arg, switch to startup visibility.
+With `\\[universal-argument]' prefix ARG, switch to startup visibility.
With a numeric prefix, show all headlines up to that level.
\(fn &optional ARG)" t nil)
@@ -23244,10 +23388,10 @@ With a numeric prefix, show all headlines up to that
level.
(autoload 'orgstruct-mode "org" "\
Toggle the minor mode `orgstruct-mode'.
-This mode is for using Org-mode structure commands in other
-modes. The following keys behave as if Org-mode were active, if
+This mode is for using Org mode structure commands in other
+modes. The following keys behave as if Org mode were active, if
the cursor is on a headline, or on a plain list item (both as
-defined by Org-mode).
+defined by Org mode).
\(fn &optional ARG)" t nil)
@@ -23262,61 +23406,59 @@ Unconditionally turn on `orgstruct++-mode'.
\(fn)" nil nil)
(autoload 'org-run-like-in-org-mode "org" "\
-Run a command, pretending that the current buffer is in Org-mode.
+Run a command, pretending that the current buffer is in Org mode.
This will temporarily bind local variables that are typically bound in
-Org-mode to the values they have in Org-mode, and then interactively
+Org mode to the values they have in Org mode, and then interactively
call CMD.
\(fn CMD)" nil nil)
(autoload 'org-store-link "org" "\
-\\<org-mode-map>Store an org-link to the current location.
+Store an org-link to the current location.
+\\<org-mode-map>
This link is added to `org-stored-links' and can later be inserted
-into an org-buffer with \\[org-insert-link].
+into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
-For some link types, a prefix arg is interpreted.
-For links to Usenet articles, arg negates `org-gnus-prefer-web-links'.
-For file links, arg negates `org-context-in-file-links'.
+For some link types, a `\\[universal-argument]' prefix ARG is interpreted. A
single
+`\\[universal-argument]' negates `org-context-in-file-links' for file links or
+`org-gnus-prefer-web-links' for links to Usenet articles.
-A double prefix arg force skipping storing functions that are not
-part of Org's core.
+A `\\[universal-argument] \\[universal-argument]' prefix ARG forces skipping
storing functions that are not
+part of Org core.
-A triple prefix arg force storing a link for each line in the
+A `\\[universal-argument] \\[universal-argument] \\[universal-argument]'
prefix ARG forces storing a link for each line in the
active region.
\(fn ARG)" t nil)
(autoload 'org-insert-link-global "org" "\
-Insert a link like Org-mode does.
-This command can be called in any mode to insert a link in Org-mode syntax.
+Insert a link like Org mode does.
+This command can be called in any mode to insert a link in Org syntax.
\(fn)" t nil)
(autoload 'org-open-at-point-global "org" "\
-Follow a link like Org-mode does.
-This command can be called in any mode to follow a link that has
-Org-mode syntax.
+Follow a link or time-stamp like Org mode does.
+This command can be called in any mode to follow an external link
+or a time-stamp that has Org mode syntax. Its behavior is
+undefined when called on internal links (e.g., fuzzy links).
+Raise an error when there is nothing to follow.
\(fn)" t nil)
(autoload 'org-open-link-from-string "org" "\
-Open a link in the string S, as if it was in Org-mode.
+Open a link in the string S, as if it was in Org mode.
\(fn S &optional ARG REFERENCE-BUFFER)" t nil)
(autoload 'org-switchb "org" "\
Switch between Org buffers.
-With one prefix argument, restrict available buffers to files.
-With two prefix arguments, restrict available buffers to agenda files.
-
-Defaults to `iswitchb' for buffer name completion.
-Set `org-completion-use-ido' to make it use ido instead.
-\(fn &optional ARG)" t nil)
+With `\\[universal-argument]' prefix, restrict available buffers to files.
-(defalias 'org-ido-switchb 'org-switchb)
+With `\\[universal-argument] \\[universal-argument]' prefix, restrict
available buffers to agenda files.
-(defalias 'org-iswitchb 'org-switchb)
+\(fn &optional ARG)" t nil)
(autoload 'org-cycle-agenda-files "org" "\
Cycle through the files in `org-agenda-files'.
@@ -23326,13 +23468,13 @@ If the current buffer does not, find the first agenda
file.
\(fn)" t nil)
(autoload 'org-submit-bug-report "org" "\
-Submit a bug report on Org-mode via mail.
+Submit a bug report on Org via mail.
Don't hesitate to report any problems or inaccurate documentation.
If you don't have setup sending mail from (X)Emacs, please copy the
output buffer into your mail program, as it gives us important
-information about your Org-mode version and configuration.
+information about your Org version and configuration.
\(fn)" t nil)
@@ -23388,9 +23530,9 @@ More commands can be added by configuring the variable
`org-agenda-custom-commands'. In particular, specific tags and TODO keyword
searches can be pre-defined in this way.
-If the current buffer is in Org-mode and visiting a file, you can also
+If the current buffer is in Org mode and visiting a file, you can also
first press `<' once to indicate that the agenda should be temporarily
-\(until the next use of \\[org-agenda]) restricted to the current file.
+\(until the next use of `\\[org-agenda]') restricted to the current file.
Pressing `<' twice means to restrict to the current subtree or region
\(if active).
@@ -23519,7 +23661,7 @@ in `org-agenda-text-search-extra-files'.
(autoload 'org-todo-list "org-agenda" "\
Show all (not done) TODO entries from all agenda file in a single list.
The prefix arg can be used to select a specific TODO keyword and limit
-the list to these. When using \\[universal-argument], you will be prompted
+the list to these. When using `\\[universal-argument]', you will be prompted
for a keyword. A numeric prefix directly selects the Nth keyword in
`org-todo-keywords-1'.
@@ -23575,22 +23717,22 @@ Do we have a reason to ignore this TODO entry because
it has a time stamp?
(autoload 'org-agenda-set-restriction-lock "org-agenda" "\
Set restriction lock for agenda, to current subtree or file.
-Restriction will be the file if TYPE is `file', or if TYPE is the
-universal prefix `(4)', or if the cursor is before the first headline
+Restriction will be the file if TYPE is `file', or if type is the
+universal prefix \\='(4), or if the cursor is before the first headline
in the file. Otherwise, restriction will be to the current subtree.
\(fn &optional TYPE)" t nil)
(autoload 'org-calendar-goto-agenda "org-agenda" "\
-Compute the Org-mode agenda for the calendar date displayed at the cursor.
+Compute the Org agenda for the calendar date displayed at the cursor.
This is a command that has to be installed in `calendar-mode-map'.
\(fn)" t nil)
(autoload 'org-agenda-to-appt "org-agenda" "\
Activate appointments found in `org-agenda-files'.
-With a \\[universal-argument] prefix, refresh the list of
-appointments.
+
+With a `\\[universal-argument]' prefix, refresh the list of appointments.
If FILTER is t, interactively prompt the user for a regular
expression, and filter out entries that don't match it.
@@ -23605,8 +23747,8 @@ argument: an entry from `org-agenda-get-day-entries'.
FILTER can also be an alist with the car of each cell being
either `headline' or `category'. For example:
- ((headline \"IMPORTANT\")
- (category \"Work\"))
+ \\='((headline \"IMPORTANT\")
+ (category \"Work\"))
will only add headlines containing IMPORTANT or headlines
belonging to the \"Work\" category.
@@ -23668,16 +23810,17 @@ Capture STRING with the template selected by KEYS.
(autoload 'org-capture "org-capture" "\
Capture something.
\\<org-capture-mode-map>
-This will let you select a template from `org-capture-templates', and then
-file the newly captured information. The text is immediately inserted
-at the target location, and an indirect buffer is shown where you can
-edit it. Pressing \\[org-capture-finalize] brings you back to the previous
state
-of Emacs, so that you can continue your work.
+This will let you select a template from `org-capture-templates', and
+then file the newly captured information. The text is immediately
+inserted at the target location, and an indirect buffer is shown where
+you can edit it. Pressing `\\[org-capture-finalize]' brings you back to the
previous
+state of Emacs, so that you can continue your work.
+
+When called interactively with a `\\[universal-argument]' prefix argument
GOTO, don't
+capture anything, just go to the file/headline where the selected
+template stores its notes.
-When called interactively with a \\[universal-argument] prefix argument GOTO,
don't capture
-anything, just go to the file/headline where the selected template
-stores its notes. With a double prefix argument \\[universal-argument]
\\[universal-argument], go to the last note
-stored.
+With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to
the last note stored.
When called with a `C-0' (zero) prefix, insert a template at point.
@@ -23723,26 +23866,29 @@ Remove all currently active column overlays.
\(fn)" nil nil)
(autoload 'org-columns "org-colview" "\
-Turn on column view on an org-mode file.
+Turn on column view on an Org mode file.
+
+Column view applies to the whole buffer if point is before the
+first headline. Otherwise, it applies to the first ancestor
+setting \"COLUMNS\" property. If there is none, it defaults to
+the current headline. With a `\\[universal-argument]' prefix argument, turn
on column
+view for the whole buffer unconditionally.
+
When COLUMNS-FMT-STRING is non-nil, use it as the column format.
-\(fn &optional COLUMNS-FMT-STRING)" t nil)
+\(fn &optional GLOBAL COLUMNS-FMT-STRING)" t nil)
(autoload 'org-columns-compute "org-colview" "\
-Sum the values of property PROPERTY hierarchically, for the entire buffer.
+Summarize the values of PROPERTY hierarchically.
+Also update existing values for PROPERTY according to the first
+column specification.
\(fn PROPERTY)" t nil)
-(autoload 'org-columns-number-to-string "org-colview" "\
-Convert a computed column number to a string value, according to FMT.
-
-\(fn N FMT &optional PRINTF)" nil nil)
-
(autoload 'org-dblock-write:columnview "org-colview" "\
Write the column view table.
PARAMS is a property list of parameters:
-:width enforce same column widths with <N> specifiers.
:id the :ID: property of the entry where the columns view
should be built. When the symbol `local', call locally.
When `global' call column view with the cursor at the beginning
@@ -23752,15 +23898,17 @@ PARAMS is a property list of parameters:
using `org-id-find'.
:hlines When t, insert a hline before each item. When a number, insert
a hline before each level <= that number.
+:indent When non-nil, indent each ITEM field according to its level.
:vlines When t, make each column a colgroup to enforce vertical lines.
:maxlevel When set to a number, don't capture headlines below this level.
:skip-empty-rows
When t, skip rows where all specifiers other than ITEM are empty.
+:width apply widths specified in columns format using <N> specifiers.
:format When non-nil, specify the column view format to use.
\(fn PARAMS)" nil nil)
-(autoload 'org-insert-columns-dblock "org-colview" "\
+(autoload 'org-columns-insert-dblock "org-colview" "\
Create a dynamic block capturing a column view table.
\(fn)" t nil)
@@ -23796,7 +23944,7 @@ Try very hard to provide sensible version strings.
;;;### (autoloads nil "org-ctags" "org/org-ctags.el" (0 0 0 0))
;;; Generated autoloads from org/org-ctags.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"org-ctags" '("org-ctags-" "y-or-n-minibuffer")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"org-ctags" '("org-ctags-")))
;;;***
@@ -23827,7 +23975,7 @@ Try very hard to provide sensible version strings.
;;;;;; 0))
;;; Generated autoloads from org/org-entities.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"org-entities" '("replace-amp" "org-entit")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"org-entities" '("org-entit")))
;;;***
@@ -23838,6 +23986,13 @@ Try very hard to provide sensible version strings.
;;;***
+;;;### (autoloads nil "org-eww" "org/org-eww.el" (0 0 0 0))
+;;; Generated autoloads from org/org-eww.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"org-eww" '("org-eww-")))
+
+;;;***
+
;;;### (autoloads nil "org-faces" "org/org-faces.el" (0 0 0 0))
;;; Generated autoloads from org/org-faces.el
@@ -23864,7 +24019,7 @@ Try very hard to provide sensible version strings.
;;;### (autoloads nil "org-gnus" "org/org-gnus.el" (0 0 0 0))
;;; Generated autoloads from org/org-gnus.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"org-gnus" '("org-gnus-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"org-gnus" '("org-")))
;;;***
@@ -23914,6 +24069,24 @@ Try very hard to provide sensible version strings.
;;;***
+;;;### (autoloads nil "org-lint" "org/org-lint.el" (0 0 0 0))
+;;; Generated autoloads from org/org-lint.el
+
+(autoload 'org-lint "org-lint" "\
+Check current Org buffer for syntax mistakes.
+
+By default, run all checkers. With a `\\[universal-argument]' prefix ARG,
select one
+category of checkers only. With a `\\[universal-argument]
\\[universal-argument]' prefix, run one precise
+checker by its name.
+
+ARG can also be a list of checker names, as symbols, to run.
+
+\(fn &optional ARG)" t nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"org-lint" '("org-lint-")))
+
+;;;***
+
;;;### (autoloads nil "org-list" "org/org-list.el" (0 0 0 0))
;;; Generated autoloads from org/org-list.el
@@ -23932,7 +24105,7 @@ Try very hard to provide sensible version strings.
;;; Generated autoloads from org/org-macs.el
(autoload 'org-load-noerror-mustsuffix "org-macs" "\
-Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX
argument for XEmacs, which doesn't recognize it.
+Load FILE with optional arguments NOERROR and MUSTSUFFIX.
\(fn FILE)" nil t)
@@ -24004,7 +24177,7 @@ Load FILE with optional arguments NOERROR and
MUSTSUFFIX. Drop the MUSTSUFFIX a
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/org-table.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"org-table" '("org" "*orgtbl-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"org-table" '("org")))
;;;***
@@ -24020,14 +24193,14 @@ Load FILE with optional arguments NOERROR and
MUSTSUFFIX. Drop the MUSTSUFFIX a
;;; Generated autoloads from org/org-version.el
(autoload 'org-release "org-version" "\
-The release version of org-mode.
- Inserted by installing org-mode or when a release is made.
+The release version of Org.
+Inserted by installing Org mode or when a release is made.
\(fn)" nil nil)
(autoload 'org-git-version "org-version" "\
The Git version of org-mode.
- Inserted by installing org-mode or when a release is made.
+Inserted by installing Org or when a release is made.
\(fn)" nil nil)
@@ -26220,7 +26393,7 @@ Optional argument FACE specifies the face to do the
highlighting.
;;; Generated autoloads from progmodes/python.el
(push (purecopy '(python 0 25 2)) package--builtin-versions)
-(add-to-list 'auto-mode-alist (cons (purecopy "\\.pyw?\\'") 'python-mode))
+(add-to-list 'auto-mode-alist (cons (purecopy "\\.py[iw]?\\'") 'python-mode))
(add-to-list 'interpreter-mode-alist (cons (purecopy "python[0-9.]*")
'python-mode))
@@ -34153,7 +34326,7 @@ Reenable Ange-FTP, when Tramp is unloaded.
;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
-(push (purecopy '(tramp 2 3 2)) package--builtin-versions)
+(push (purecopy '(tramp 2 3 3 -1)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"trampver" '("tramp-")))
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 24c3acd..18c30f7 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -221,6 +221,11 @@ restore a previous autoload if possible.")
;; Remove the struct.
(setf (cl--find-class name) nil)))
+(cl-defmethod loadhist-unload-element ((x (head define-symbol-props)))
+ (pcase-dolist (`(,symbol . ,props) (cdr x))
+ (dolist (prop props)
+ (put symbol prop nil))))
+
;;;###autoload
(defun unload-feature (feature &optional force)
"Unload the library that provided FEATURE.
@@ -301,11 +306,6 @@ something strange, such as redefining an Emacs function."
;; Change major mode in all buffers using one defined in the feature
being unloaded.
(unload--set-major-mode)
- (when (fboundp 'elp-restore-function) ; remove ELP stuff first
- (dolist (elt unload-function-defs-list)
- (when (symbolp elt)
- (elp-restore-function elt))))
-
(mapc #'loadhist-unload-element unload-function-defs-list)
;; Delete the load-history element for this file.
(setq load-history (delq (assoc file load-history) load-history))))
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index b368efb..9a81ef0 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -1,4 +1,4 @@
-;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
+;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp -*-
lexical-binding: t -*-
;; Copyright (C) 1992, 1994, 2000-2017 Free Software Foundation, Inc.
@@ -60,6 +60,8 @@
;;; Code:
+
+
(defgroup ls-lisp nil
"Emulate the ls program completely in Emacs Lisp."
:version "21.1"
@@ -477,6 +479,34 @@ not contain `d', so that a full listing is expected."
(message "%s: doesn't exist or is inaccessible" file)
(ding) (sit-for 2))))) ; to show user the message!
+(declare-function dired-read-dir-and-switches "dired" (str))
+(declare-function dired-goto-next-file "dired" ())
+
+(defun ls-lisp--dired (orig-fun dir-or-list &optional switches)
+ (interactive (dired-read-dir-and-switches ""))
+ (if (consp dir-or-list)
+ (funcall orig-fun dir-or-list switches)
+ (let ((dir-wildcard (insert-directory-wildcard-in-dir-p
+ (expand-file-name dir-or-list))))
+ (if (not dir-wildcard)
+ (funcall orig-fun dir-or-list switches)
+ (let* ((default-directory (car dir-wildcard))
+ (files (file-expand-wildcards (cdr dir-wildcard)))
+ (dir (car dir-wildcard)))
+ (if files
+ (let ((inhibit-read-only t)
+ (buf
+ (apply orig-fun (nconc (list dir) files) (and switches
(list switches)))))
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (point-min))
+ (dired-goto-next-file)
+ (forward-line 0)
+ (insert " wildcard " (cdr dir-wildcard) "\n"))))
+ (user-error "No files matching regexp")))))))
+
+(advice-add 'dired :around #'ls-lisp--dired)
+
(defun ls-lisp-sanitize (file-alist)
"Sanitize the elements in FILE-ALIST.
Fixes any elements in the alist for directory entries whose file
@@ -866,6 +896,13 @@ All ls time options, namely c, t and u, are handled."
file-size)
(format " %6s" (file-size-human-readable file-size))))
+(defun ls-lisp-unload-function ()
+ "Unload ls-lisp library."
+ (advice-remove 'insert-directory #'ls-lisp--insert-directory)
+ (advice-remove 'dired #'ls-lisp--dired)
+ ;; Continue standard unloading.
+ nil)
+
(provide 'ls-lisp)
;;; ls-lisp.el ends here
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 05a336b..75ffd1e 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1101,6 +1101,7 @@ The selected font will be the default on both the
existing and future frames."
:button (:radio . (eq tool-bar-mode nil))))
menu)))
+(defvar display-line-numbers-type)
(defun menu-bar-display-line-numbers-mode (type)
(setq display-line-numbers-type type)
(if global-display-line-numbers-mode
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 8772b523..e3ee4df 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -1382,10 +1382,9 @@ unless optional argument SOFT is non-nil."
(interactive)
(comment-normalize-vars t)
(let (compos comin)
- ;; If we are not inside a comment and we only auto-fill comments,
- ;; don't do anything (unless no comment syntax is defined).
+ ;; If we are not inside a comment don't do anything (unless no
+ ;; comment syntax is defined).
(unless (and comment-start
- comment-auto-fill-only-comments
(not (called-interactively-p 'interactive))
(not (save-excursion
(prog1 (setq compos (comment-beginning))
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index 7be3c6f..cbc248b 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -66,7 +66,7 @@ Whether passwords are cached at all is controlled by
`password-cache'."
:type '(choice (const :tag "Never" nil)
(integer :tag "Seconds")))
-(defvar password-data (make-vector 7 0))
+(defvar password-data (make-hash-table :test #'equal))
(defun password-read-from-cache (key)
"Obtain passphrase for KEY from time-limited passphrase cache.
@@ -74,20 +74,20 @@ Custom variables `password-cache' and
`password-cache-expiry'
regulate cache behavior."
(and password-cache
key
- (symbol-value (intern-soft key password-data))))
+ (gethash key password-data)))
;;;###autoload
(defun password-in-cache-p (key)
"Check if KEY is in the cache."
(and password-cache
key
- (intern-soft key password-data)))
+ (gethash key password-data)))
(defun password-read (prompt &optional key)
"Read password, for use with KEY, from user, or from cache if wanted.
KEY indicate the purpose of the password, so the cache can
-separate passwords. The cache is not used if KEY is nil. It is
-typically a string.
+separate passwords. The cache is not used if KEY is nil.
+KEY is typically a string but can be anything (compared via `equal').
The variable `password-cache' control whether the cache is used."
(or (password-read-from-cache key)
(read-passwd prompt)))
@@ -115,29 +115,27 @@ but can be invoked at any time to forcefully remove
passwords
from the cache. This may be useful when it has been detected
that a password is invalid, so that `password-read' query the
user again."
- (let ((sym (intern-soft key password-data)))
- (when sym
- (let ((password (symbol-value sym)))
- (when (stringp password)
- (if (fboundp 'clear-string)
- (clear-string password)
- (fillarray password ?_)))
- (unintern key password-data)))))
+ (let ((password (gethash key password-data)))
+ (when (stringp password)
+ (if (fboundp 'clear-string)
+ (clear-string password)
+ (fillarray password ?_)))
+ (remhash key password-data)))
(defun password-cache-add (key password)
"Add password to cache.
The password is removed by a timer after `password-cache-expiry' seconds."
- (when (and password-cache-expiry (null (intern-soft key password-data)))
+ (when (and password-cache-expiry (null (gethash key password-data)))
(run-at-time password-cache-expiry nil
#'password-cache-remove
key))
- (set (intern key password-data) password)
+ (puthash key password password-data)
nil)
(defun password-reset ()
"Clear the password cache."
(interactive)
- (fillarray password-data 0))
+ (clrhash password-data))
(provide 'password-cache)
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 66f2575..b35d33a 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1182,10 +1182,15 @@ casts and declarations are fontified. Used on level 2
and higher."
(goto-char match-pos)
(backward-char)
(c-backward-token-2)
- (or (looking-at c-block-stmt-2-key)
- (looking-at c-block-stmt-1-2-key)
- (looking-at c-typeof-key))))
- (cons nil t))
+ (cond
+ ((looking-at c-paren-stmt-key)
+ ;; Allow comma separated <> arglists in for statements.
+ (cons nil nil))
+ ((or (looking-at c-block-stmt-2-key)
+ (looking-at c-block-stmt-1-2-key)
+ (looking-at c-typeof-key))
+ (cons nil t))
+ (t nil)))))
;; Near BOB.
((<= match-pos (point-min))
(cons 'arglist t))
@@ -1226,13 +1231,16 @@ casts and declarations are fontified. Used on level 2
and higher."
;; Got a cached hit in some other type of arglist.
(type
(cons 'arglist t))
- (not-front-decl
+ ((and not-front-decl
;; The point is within the range of a previously
;; encountered type decl expression, so the arglist
;; is probably one that contains declarations.
;; However, if `c-recognize-paren-inits' is set it
;; might also be an initializer arglist.
- ;;
+ (or (not c-recognize-paren-inits)
+ (save-excursion
+ (goto-char match-pos)
+ (not (c-back-over-member-initializers)))))
;; The result of this check is cached with a char
;; property on the match token, so that we can look
;; it up again when refontifying single lines in a
@@ -1243,17 +1251,21 @@ casts and declarations are fontified. Used on level 2
and higher."
;; Got an open paren preceded by an arith operator.
((and (eq (char-before match-pos) ?\()
(save-excursion
+ (goto-char match-pos)
(and (zerop (c-backward-token-2 2))
(looking-at c-arithmetic-op-regexp))))
(cons nil nil))
;; In a C++ member initialization list.
((and (eq (char-before match-pos) ?,)
(c-major-mode-is 'c++-mode)
- (save-excursion (c-back-over-member-initializers)))
+ (save-excursion
+ (goto-char match-pos)
+ (c-back-over-member-initializers)))
(c-put-char-property (1- match-pos) 'c-type 'c-not-decl)
(cons 'not-decl nil))
;; At start of a declaration inside a declaration paren.
((save-excursion
+ (goto-char match-pos)
(and (memq (char-before match-pos) '(?\( ?\,))
(c-go-up-list-backward match-pos)
(eq (char-after) ?\()
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index bf0439f..0bf89b9 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1539,6 +1539,21 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
(setq new-pos capture-opener))
(and (/= new-pos pos) new-pos)))
+(defun c-fl-decl-end (pos)
+ ;; If POS is inside a declarator, return the end of the token that follows
+ ;; the declarator, otherwise return nil.
+ (goto-char pos)
+ (let ((lit-start (c-literal-start))
+ pos1)
+ (if lit-start (goto-char lit-start))
+ (c-backward-syntactic-ws)
+ (when (setq pos1 (c-on-identifier))
+ (goto-char pos1)
+ (when (and (c-forward-declarator)
+ (eq (c-forward-token-2) 0))
+ (c-backward-syntactic-ws)
+ (point)))))
+
(defun c-change-expand-fl-region (_beg _end _old-len)
;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock
;; region. This will usually be the smallest sequence of whole lines
@@ -1552,18 +1567,16 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
(setq c-new-BEG
(or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG))
c-new-END
- (save-excursion
- (goto-char c-new-END)
- (if (bolp)
- (point)
- (c-point 'bonl c-new-END))))))
+ (or (c-fl-decl-end c-new-END)
+ (c-point 'bonl (max (1- c-new-END) (point-min)))))))
(defun c-context-expand-fl-region (beg end)
;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a
;; "local" declaration containing BEG (see `c-fl-decl-start') or BOL BEG is
;; in. NEW-END is beginning of the line after the one END is in.
- (cons (or (c-fl-decl-start beg) (c-point 'bol beg))
- (c-point 'bonl end)))
+ (c-save-buffer-state ()
+ (cons (or (c-fl-decl-start beg) (c-point 'bol beg))
+ (or (c-fl-decl-end end) (c-point 'bonl (1- end))))))
(defun c-before-context-fl-expand-region (beg end)
;; Expand the region (BEG END) as specified by
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 2ddaf88..466b524 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -31,7 +31,6 @@
(require 'compile)
-
(defgroup grep nil
"Run `grep' and display the results."
:group 'tools
@@ -366,53 +365,44 @@ A grep buffer becomes most recent when you select Grep
mode in it.
Notice that using \\[next-error] or \\[compile-goto-error] modifies
`compilation-last-buffer' rather than `grep-last-buffer'.")
-(defconst grep--regexp-alist-column
- ;; Calculate column positions (col . end-col) of first grep match on a line
- (cons
- (lambda ()
- (when grep-highlight-matches
- (let* ((beg (match-end 0))
- (end (save-excursion (goto-char beg) (line-end-position)))
- (mbeg (text-property-any beg end 'font-lock-face
'grep-match-face)))
- (when mbeg
- (- mbeg beg)))))
- (lambda ()
- (when grep-highlight-matches
- (let* ((beg (match-end 0))
- (end (save-excursion (goto-char beg) (line-end-position)))
- (mbeg (text-property-any beg end 'font-lock-face
'grep-match-face))
- (mend (and mbeg (next-single-property-change mbeg
'font-lock-face nil end))))
- (when mend
- (- mend beg)))))))
-(defconst grep--regexp-alist-bin-matcher
- '("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
-(defconst grep-with-null-regexp-alist
- `(("^\\([^\0]+\\)\\(\0\\)\\([0-9]+\\):" 1 3 ,grep--regexp-alist-column nil
nil
- (2 '(face unspecified display ":")))
- ,grep--regexp-alist-bin-matcher)
- "Regexp used to match grep hits.
-See `compilation-error-regexp-alist'.")
-(defconst grep-fallback-regexp-alist
- `(;; Use a tight regexp to handle weird file names (with colons
- ;; in them) as well as possible. E.g., use [1-9][0-9]* rather
- ;; than [0-9]+ so as to accept ":034:" in file names.
- ("^\\(.*?[^/\n]\\):[ \t]*\\([1-9][0-9]*\\)[ \t]*:"
- 1 2 ,grep--regexp-alist-column)
- ,grep--regexp-alist-bin-matcher)
- "Regexp used to match grep hits when `--null' is not supported.
-See `compilation-error-regexp-alist'.")
-
-(defvaralias 'grep-regex-alist 'grep-with-null-regexp-alist)
-(make-obsolete-variable
- 'grep-regex-alist "Call `grep-regexp-alist' instead." "26.1")
-
;;;###autoload
-(defun grep-regexp-alist ()
- "Return a regexp alist to match grep hits.
-The regexp used depends on `grep-use-null-filename-separator'.
-See `compilation-error-regexp-alist' for format details."
- (if grep-use-null-filename-separator
- grep-with-null-regexp-alist grep-fallback-regexp-alist))
+(defconst grep-regexp-alist
+ `((,(concat "^\\(?:"
+ ;; Parse using NUL characters when `--null' is used.
+ ;; Note that we must still assume no newlines in
+ ;; filenames due to "foo: Is a directory." type
+ ;; messages.
+ "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):"
+ "\\|"
+ ;; Fallback if `--null' is not used, use a tight regexp
+ ;; to handle weird file names (with colons in them) as
+ ;; well as possible. E.g., use [1-9][0-9]* rather than
+ ;; [0-9]+ so as to accept ":034:" in file names.
+ "\\(?1:[^\n:]+?[^\n/:]\\):[\t ]*\\(?2:[1-9][0-9]*\\)[\t ]*:"
+ "\\)")
+ 1 2
+ ;; Calculate column positions (col . end-col) of first grep match on a
line
+ (,(lambda ()
+ (when grep-highlight-matches
+ (let* ((beg (match-end 0))
+ (end (save-excursion (goto-char beg) (line-end-position)))
+ (mbeg (text-property-any beg end 'font-lock-face
'grep-match-face)))
+ (when mbeg
+ (- mbeg beg)))))
+ .
+ ,(lambda ()
+ (when grep-highlight-matches
+ (let* ((beg (match-end 0))
+ (end (save-excursion (goto-char beg) (line-end-position)))
+ (mbeg (text-property-any beg end 'font-lock-face
'grep-match-face))
+ (mend (and mbeg (next-single-property-change mbeg
'font-lock-face nil end))))
+ (when mend
+ (- mend beg))))))
+ nil nil
+ (3 '(face nil display ":")))
+ ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
+ "Regexp used to match grep hits.
+See `compilation-error-regexp-alist' for format details.")
(defvar grep-first-column 0 ; bug#10594
"Value to use for `compilation-first-column' in grep buffers.")
@@ -451,7 +441,9 @@ See `compilation-error-regexp-alist' for format details."
(2 grep-error-face nil t))
;; "filename-linenumber-" format is used for context lines in GNU grep,
;; "filename=linenumber=" for lines with function names in "git grep -p".
- ("^.+?[-=][0-9]+[-=].*\n" (0 grep-context-face)))
+ ("^.+?\\([-=\0]\\)[0-9]+\\([-=]\\).*\n" (0 grep-context-face)
+ (1 (if (eq (char-after (match-beginning 1)) ?\0)
+ `(face nil display ,(match-string 2))))))
"Additional things to highlight in grep output.
This gets tacked on the end of the generated expressions.")
@@ -781,7 +773,7 @@ This function is called from `compilation-filter-hook'."
(set (make-local-variable 'compilation-error-face)
grep-hit-face)
(set (make-local-variable 'compilation-error-regexp-alist)
- (grep-regexp-alist))
+ grep-regexp-alist)
;; compilation-directory-matcher can't be nil, so we set it to a regexp that
;; can never match.
(set (make-local-variable 'compilation-directory-matcher) '("\\`a\\`"))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 35b555e..23e79f6 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1683,6 +1683,7 @@ with your script for an edit-interpret-debug cycle."
((string-match "[.]sh\\>" buffer-file-name) "sh")
((string-match "[.]bash\\>" buffer-file-name) "bash")
((string-match "[.]ksh\\>" buffer-file-name) "ksh")
+ ((string-match "[.]mkshrc\\>" buffer-file-name) "mksh")
((string-match "[.]t?csh\\(rc\\)?\\>" buffer-file-name) "csh")
((string-match "[.]zsh\\(rc\\|env\\)?\\>" buffer-file-name) "zsh")
((equal (file-name-nondirectory buffer-file-name) ".profile") "sh")
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index cc9b794..35a5c88 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -929,7 +929,7 @@ IGNORES is a list of glob patterns."
(expand-file-name dir)
ignores))
(buf (get-buffer-create " *xref-grep*"))
- (`(,grep-re ,file-group ,line-group . ,_) (car (grep-regexp-alist)))
+ (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
(status nil)
(hits nil))
(with-current-buffer buf
diff --git a/lisp/register.el b/lisp/register.el
index 7cc3ccd..e395963 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -164,6 +164,10 @@ display such a window regardless."
help-chars)
(unless (get-buffer-window buffer)
(register-preview buffer 'show-empty)))
+ (when (or (eq ?\C-g last-input-event)
+ (eq 'escape last-input-event)
+ (eq ?\C-\[ last-input-event))
+ (keyboard-quit))
(if (characterp last-input-event) last-input-event
(error "Non-character input-event")))
(and (timerp timer) (cancel-timer timer))
diff --git a/lisp/replace.el b/lisp/replace.el
index 64dfe7d..a502494 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1395,6 +1395,11 @@ invoke `occur'."
"Show all lines in the current buffer containing a match for REGEXP.
If a match spreads across multiple lines, all those lines are shown.
+Each match is extended to include complete lines. Only non-overlapping
+matches are considered. (Note that extending matches to complete
+lines could cause some of the matches to overlap; if so, they will not
+be shown as separate matches.)
+
Each line is displayed with NLINES lines before and after, or -NLINES
before if NLINES is negative.
NLINES defaults to `list-matching-lines-default-context-lines'.
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 7b0588d..1627797 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -304,7 +304,10 @@ or remove a tab stop.
\\[ruler-mode-toggle-show-tab-stops] or
(defsubst ruler-mode-window-col (n)
"Return a column number relative to the selected window.
-N is a column number relative to selected frame."
+N is a column number relative to selected frame.
+If required, account for screen estate taken by `display-line-numbers'."
+ (if display-line-numbers
+ (setq n (- n (line-number-display-width) 2)))
(- n
(or (car (window-margins)) 0)
(fringe-columns 'left)
@@ -665,7 +668,7 @@ Optional argument PROPS specifies other text properties to
apply."
(let* ((w (ruler-mode-text-scaled-window-width))
(m (window-margins))
(f (window-fringes))
- (i 0)
+ (i (if display-line-numbers (+ (line-number-display-width) 2) 0))
(j (ruler-mode-text-scaled-window-hscroll))
;; Setup the scrollbar, fringes, and margins areas.
(lf (ruler-mode-space
@@ -696,8 +699,20 @@ Optional argument PROPS specifies other text properties to
apply."
;; Create an "clean" ruler.
(ruler
(propertize
+ ;; FIXME: `make-string' returns a unibyte string if it's ASCII-only,
+ ;; which prevents further `aset' from inserting non-ASCII chars,
+ ;; hence the need for `string-to-multibyte'.
+ ;;
http://lists.gnu.org/archive/html/emacs-devel/2017-05/msg00841.html
(string-to-multibyte
- (make-string w ruler-mode-basic-graduation-char))
+ ;; Make the part of header-line corresponding to the
+ ;; line-number display be blank, not filled with
+ ;; ruler-mode-basic-graduation-char.
+ (if display-line-numbers
+ (let* ((lndw (+ (line-number-display-width) 2))
+ (s (make-string lndw ?\s)))
+ (concat s (make-string (- w lndw)
+ ruler-mode-basic-graduation-char)))
+ (make-string w ruler-mode-basic-graduation-char)))
'face 'ruler-mode-default
'local-map ruler-mode-map
'help-echo (cond
diff --git a/lisp/shell.el b/lisp/shell.el
index c5e5cbb..ea7f0be 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -264,7 +264,9 @@ see the function `dirtrack-mode'."
:group 'shell-directories)
(defcustom explicit-shell-file-name nil
- "If non-nil, is file name to use for explicitly requested inferior shell."
+ "If non-nil, is file name to use for explicitly requested inferior shell.
+When nil, such interactive shell sessions fallback to using either
+the shell specified in $ESHELL or in `shell-file-name'."
:type '(choice (const :tag "None" nil) file)
:group 'shell)
diff --git a/lisp/simple.el b/lisp/simple.el
index 3d23fc3..027ce39 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -996,23 +996,24 @@ instead of deleted."
:version "24.1")
(defvar region-extract-function
- (lambda (delete)
+ (lambda (method)
(when (region-beginning)
(cond
- ((eq delete 'bounds)
+ ((eq method 'bounds)
(list (cons (region-beginning) (region-end))))
- ((eq delete 'delete-only)
+ ((eq method 'delete-only)
(delete-region (region-beginning) (region-end)))
(t
- (filter-buffer-substring (region-beginning) (region-end) delete)))))
+ (filter-buffer-substring (region-beginning) (region-end) method)))))
"Function to get the region's content.
-Called with one argument DELETE.
-If DELETE is `delete-only', then only delete the region and the return value
-is undefined. If DELETE is nil, just return the content as a string.
-If DELETE is `bounds', then don't delete, but just return the
-boundaries of the region as a list of (START . END) positions.
-If anything else, delete the region and return its content as a string,
-after filtering it with `filter-buffer-substring'.")
+Called with one argument METHOD.
+If METHOD is `delete-only', then delete the region; the return value
+is undefined. If METHOD is nil, then return the content as a string.
+If METHOD is `bounds', then return the boundaries of the region
+as a list of the form (START . END).
+If METHOD is anything else, delete the region and return its content
+as a string, after filtering it with `filter-buffer-substring', which
+is called with METHOD as its 3rd argument.")
(defvar region-insert-function
(lambda (lines)
@@ -7218,6 +7219,13 @@ unless optional argument SOFT is non-nil."
;; If we're not inside a comment, just try to indent.
(t (indent-according-to-mode))))))
+(defun internal-auto-fill ()
+ "The function called by `self-insert-command' to perform auto-filling."
+ (when (or (not comment-start)
+ (not comment-auto-fill-only-comments)
+ (nth 4 (syntax-ppss)))
+ (do-auto-fill)))
+
(defvar normal-auto-fill-function 'do-auto-fill
"The function to use for `auto-fill-function' if Auto Fill mode is turned on.
Some major modes set this.")
diff --git a/lisp/subr.el b/lisp/subr.el
index 79a28d3..b3f9f90 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1999,6 +1999,25 @@ If TOGGLE has a `:menu-tag', that is used for the menu
item's label."
;; "Return the name of the file from which AUTOLOAD will be loaded.
;; \n\(fn AUTOLOAD)")
+(defun define-symbol-prop (symbol prop val)
+ "Define the property PROP of SYMBOL to be VAL.
+This is to `put' what `defalias' is to `fset'."
+ ;; Can't use `cl-pushnew' here (nor `push' on (cdr foo)).
+ ;; (cl-pushnew symbol (alist-get prop
+ ;; (alist-get 'define-symbol-props
+ ;; current-load-list)))
+ (let ((sps (assq 'define-symbol-props current-load-list)))
+ (unless sps
+ (setq sps (list 'define-symbol-props))
+ (push sps current-load-list))
+ (let ((ps (assq prop sps)))
+ (unless ps
+ (setq ps (list prop))
+ (setcdr sps (cons ps (cdr sps))))
+ (unless (member symbol (cdr ps))
+ (setcdr ps (cons symbol (cdr ps))))))
+ (put symbol prop val))
+
(defun symbol-file (symbol &optional type)
"Return the name of the file that defined SYMBOL.
The value is normally an absolute file name. It can also be nil,
@@ -2008,47 +2027,30 @@ file name without extension.
If TYPE is nil, then any kind of definition is acceptable. If
TYPE is `defun', `defvar', or `defface', that specifies function
-definition, variable definition, or face definition only."
+definition, variable definition, or face definition only.
+Otherwise TYPE is assumed to be a symbol property."
(if (and (or (null type) (eq type 'defun))
(symbolp symbol)
(autoloadp (symbol-function symbol)))
(nth 1 (symbol-function symbol))
- (let ((files load-history)
- file match)
- (while files
- (if (if type
- (if (eq type 'defvar)
- ;; Variables are present just as their names.
- (member symbol (cdr (car files)))
- ;; Other types are represented as (TYPE . NAME).
- (member (cons type symbol) (cdr (car files))))
- ;; We accept all types, so look for variable def
- ;; and then for any other kind.
- (or (member symbol (cdr (car files)))
- (and (setq match (rassq symbol (cdr (car files))))
- (not (eq 'require (car match))))))
- (setq file (car (car files)) files nil))
- (setq files (cdr files)))
- file)))
-
-(defun method-files (method)
- "Return a list of files where METHOD is defined by `cl-defmethod'.
-The list will have entries of the form (FILE . (METHOD ...))
-where (METHOD ...) contains the qualifiers and specializers of
-the method and is a suitable argument for
-`find-function-search-for-symbol'. Filenames are absolute."
- (let ((files load-history)
- result)
- (while files
- (let ((defs (cdr (car files))))
- (while defs
- (let ((def (car defs)))
- (if (and (eq (car-safe def) 'cl-defmethod)
- (eq (cadr def) method))
- (push (cons (car (car files)) (cdr def)) result)))
- (setq defs (cdr defs))))
- (setq files (cdr files)))
- result))
+ (catch 'found
+ (pcase-dolist (`(,file . ,elems) load-history)
+ (when (if type
+ (if (eq type 'defvar)
+ ;; Variables are present just as their names.
+ (member symbol elems)
+ ;; Many other types are represented as (TYPE . NAME).
+ (or (member (cons type symbol) elems)
+ (memq symbol (alist-get type
+ (alist-get 'define-symbol-props
+ elems)))))
+ ;; We accept all types, so look for variable def
+ ;; and then for any other kind.
+ (or (member symbol elems)
+ (let ((match (rassq symbol elems)))
+ (and match
+ (not (eq 'require (car match)))))))
+ (throw 'found file))))))
(defun locate-library (library &optional nosuffix path interactive-call)
"Show the precise file name of Emacs library LIBRARY.
diff --git a/lisp/term.el b/lisp/term.el
index 063a6ea..5eb7b3e 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -1354,8 +1354,7 @@ commands to use in that buffer.
(interactive (list (read-from-minibuffer "Run program: "
(or explicit-shell-file-name
(getenv "ESHELL")
- (getenv "SHELL")
- "/bin/sh"))))
+ shell-file-name))))
(set-buffer (make-term "terminal" program))
(term-mode)
(term-char-mode)
@@ -4149,8 +4148,7 @@ the process. Any more args are arguments to PROGRAM."
(interactive (list (read-from-minibuffer "Run program: "
(or explicit-shell-file-name
(getenv "ESHELL")
- (getenv "SHELL")
- "/bin/sh"))))
+ shell-file-name))))
;; Pick the name of the new buffer.
(setq term-ansi-buffer-name
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 4df5f0a..8848360 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -774,7 +774,7 @@ See the documentation of `create-fontset-from-fontset-spec'
for the format.")
(defun ns-suspend-error ()
;; Don't allow suspending if any of the frames are NS frames.
(if (memq 'ns (mapcar 'window-system (frame-list)))
- (error "Cannot suspend Emacs while running under NS")))
+ (error "Cannot suspend Emacs while an NS GUI frame exists")))
;; Set some options to be as Nextstep-like as possible.
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 532d039..dd42dda 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1182,7 +1182,7 @@ as returned by `x-server-vendor'."
This returns an error if any Emacs frames are X frames."
;; Don't allow suspending if any of the frames are X frames.
(if (memq 'x (mapcar #'window-system (frame-list)))
- (error "Cannot suspend Emacs while running under X")))
+ (error "Cannot suspend Emacs while an X GUI frame exists")))
(defvar x-initialized nil
"Non-nil if the X window system has been initialized.")
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 596570c..cdc2af4 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -4889,7 +4889,7 @@ If optional argument STATE is positive, turn borders on."
(select-window (posn-window (event-start last-input-event)))
(list last-input-event
(if (display-popup-menus-p)
- (x-popup-menu last-nonmenu-event artist-popup-menu-table)
+ (x-popup-menu t artist-popup-menu-table)
'no-popup-menus))))
(if (eq op 'no-popup-menus)
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index b37e6dc..19cb7b4 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -835,7 +835,7 @@ cannot be completed sensibly: `custom-ident',
(defface css-selector '((t :inherit font-lock-function-name-face))
"Face to use for selectors."
:group 'css)
-(defface css-property '((t :inherit font-lock-variable-name-face))
+(defface css-property '((t :inherit font-lock-keyword-face))
"Face to use for properties."
:group 'css)
(defface css-proprietary-property '((t :inherit (css-property italic)))
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 4912db6..0edc93c 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -1,4 +1,4 @@
-;;; url-cookie.el --- URL cookie support
+;;; url-cookie.el --- URL cookie support -*- lexical-binding:t -*-
;; Copyright (C) 1996-1999, 2004-2017 Free Software Foundation, Inc.
@@ -227,21 +227,17 @@ telling Microsoft that."
:group 'url-cookie)
(defun url-cookie-host-can-set-p (host domain)
- (let ((last nil)
- (case-fold-search t))
- (cond
- ((string= host domain) ; Apparently netscape lets you do this
- t)
- ((zerop (length domain))
- nil)
- (t
- ;; Remove the dot from wildcard domains before matching.
- (when (eq ?. (aref domain 0))
- (setq domain (substring domain 1)))
- (and (url-domsuf-cookie-allowed-p domain)
- ;; Need to check and make sure the host is actually _in_ the
- ;; domain it wants to set a cookie for though.
- (string-match (concat (regexp-quote domain) "$") host))))))
+ (cond
+ ((string= host domain) ; Apparently netscape lets you do this
+ t)
+ ((zerop (length domain))
+ nil)
+ (t
+ ;; Remove the dot from wildcard domains before matching.
+ (when (eq ?. (aref domain 0))
+ (setq domain (substring domain 1)))
+ (and (url-domsuf-cookie-allowed-p domain)
+ (string-suffix-p domain host 'ignore-case)))))
(defun url-cookie-handle-set-cookie (str)
(setq url-cookies-changed-since-last-save t)
@@ -380,8 +376,8 @@ instead delete all cookies that do not match REGEXP."
"Display a buffer listing the current URL cookies, if there are any.
Use \\<url-cookie-mode-map>\\[url-cookie-delete] to remove cookies."
(interactive)
- (when (and (null url-cookie-secure-storage)
- (null url-cookie-storage))
+ (unless (or url-cookie-secure-storage
+ url-cookie-storage)
(error "No cookies are defined"))
(pop-to-buffer "*url cookies*")
@@ -442,20 +438,13 @@ Use \\<url-cookie-mode-map>\\[url-cookie-delete] to
remove cookies."
(forward-line 1)
(point)))))
-(defun url-cookie-quit ()
- "Kill the current buffer."
- (interactive)
- (kill-buffer (current-buffer)))
-
(defvar url-cookie-mode-map
(let ((map (make-sparse-keymap)))
- (suppress-keymap map)
- (define-key map "q" 'url-cookie-quit)
(define-key map [delete] 'url-cookie-delete)
(define-key map [(control k)] 'url-cookie-delete)
map))
-(define-derived-mode url-cookie-mode nil "URL Cookie"
+(define-derived-mode url-cookie-mode special-mode "URL Cookie"
"Mode for listing cookies.
\\{url-cookie-mode-map}"
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 21c39c8..f94f8a6 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -938,15 +938,15 @@ It has the following disadvantages:
- cannot use `diff -w' because the weighting causes added spaces in a line
to be represented as added copies of some line, so `diff -w' can't do the
right thing any more.
-- may in degenerate cases take a 1KB input region and turn it into a 1MB
- file to pass to diff.")
+- Is a bit more costly (may in degenerate cases use temp files that are 10x
+ larger than the refined regions).")
(defun smerge--refine-forward (n)
(let ((case-fold-search nil)
(re "[[:upper:]]?[[:lower:]]+\\|[[:upper:]]+\\|[[:digit:]]+\\|.\\|\n"))
(when (and smerge-refine-ignore-whitespace
;; smerge-refine-weight-hack causes additional spaces to
- ;; appear as additional lines as well, so even if diff ignore
+ ;; appear as additional lines as well, so even if diff ignores
;; whitespace changes, it'll report added/removed lines :-(
(not smerge-refine-weight-hack))
(setq re (concat "[ \t]*\\(?:" re "\\)")))
@@ -954,6 +954,8 @@ It has the following disadvantages:
(unless (looking-at re) (error "Smerge refine internal error"))
(goto-char (match-end 0)))))
+(defvar smerge--refine-long-words)
+
(defun smerge--refine-chopup-region (beg end file &optional preproc)
"Chopup the region into small elements, one per line.
Save the result into FILE.
@@ -976,18 +978,46 @@ chars to try and eliminate some spurious differences."
(subst-char-in-region (point-min) (point-max) ?\n ?\s))
(goto-char (point-min))
(while (not (eobp))
- (funcall smerge-refine-forward-function 1)
- (let ((s (if (prog2 (forward-char -1) (bolp) (forward-char 1))
- nil
- (buffer-substring (line-beginning-position) (point)))))
- ;; We add \n after each char except after \n, so we get
- ;; one line per text char, where each line contains
- ;; just one char, except for \n chars which are
- ;; represented by the empty line.
- (unless (eq (char-before) ?\n) (insert ?\n))
- ;; HACK ALERT!!
- (if smerge-refine-weight-hack
- (dotimes (_i (1- (length s))) (insert s "\n")))))
+ (cl-assert (bolp))
+ (let ((start (point)))
+ (funcall smerge-refine-forward-function 1)
+ (let ((len (- (point) start)))
+ (cl-assert (>= len 1))
+ ;; We add \n after each chunk except after \n, so we get
+ ;; one line per text chunk, where each line contains
+ ;; just one chunk, except for \n chars which are
+ ;; represented by the empty line.
+ (unless (bolp) (insert ?\n))
+ (when (and smerge-refine-weight-hack (> len 1))
+ (let ((s (buffer-substring-no-properties start (point))))
+ ;; The weight-hack inserts N copies of words of size N,
+ ;; so it naturally suffers from an O(N²) blow up.
+ ;; To circumvent this, we map each long word
+ ;; to a shorter (but still unique) replacement.
+ ;; Another option would be to change smerge--refine-forward
+ ;; so it chops up long words into smaller ones.
+ (when (> len 8)
+ (let ((short (gethash s smerge--refine-long-words)))
+ (unless short
+ ;; To avoid accidental conflicts with ≤8 words,
+ ;; we make sure the replacement is >8 chars. Overall,
+ ;; this should bound the blowup factor to ~10x,
+ ;; tho if those chars end up encoded as multiple bytes
+ ;; each, it could probably still reach ~30x in
+ ;; pathological cases.
+ (setq short
+ (concat (substring s 0 7)
+ " "
+ (string
+ (+ ?0
+ (hash-table-count
+ smerge--refine-long-words)))
+ "\n"))
+ (puthash s short smerge--refine-long-words))
+ (delete-region start (point))
+ (insert short)
+ (setq s short)))
+ (dotimes (_i (1- len)) (insert s)))))))
(unless (bolp) (error "Smerge refine internal error"))
(let ((coding-system-for-write 'emacs-internal))
(write-region (point-min) (point-max) file nil 'nomessage))))
@@ -1042,7 +1072,9 @@ used to replace chars to try and eliminate some spurious
differences."
(let* ((pos (point))
deactivate-mark ; The code does not modify any visible buffer.
(file1 (make-temp-file "diff1"))
- (file2 (make-temp-file "diff2")))
+ (file2 (make-temp-file "diff2"))
+ (smerge--refine-long-words
+ (if smerge-refine-weight-hack (make-hash-table :test #'equal))))
(unless (markerp beg1) (setq beg1 (copy-marker beg1)))
(unless (markerp beg2) (setq beg2 (copy-marker beg2)))
;; Chop up regions into smaller elements and save into files.
@@ -1062,7 +1094,7 @@ used to replace chars to try and eliminate some spurious
differences."
;; also and more importantly because otherwise it
;; may happen that diff doesn't behave like
;; smerge-refine-weight-hack expects it to.
- ;; See
http://thread.gmane.org/gmane.emacs.devel/82685.
+ ;; See
http://thread.gmane.org/gmane.emacs.devel/82685, aka
https://lists.gnu.org/archive/html/emacs-devel/2007-11/msg00401.html
"-awd" "-ad")
file1 file2))
;; Process diff's output.
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index c6d5b16..4198b9b 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1,4 +1,4 @@
-;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE
+;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE -*-
lexical-binding: t -*-
;; Copyright (C) 2000-2017 Free Software Foundation, Inc.
diff --git a/m4/d-type.m4 b/m4/d-type.m4
new file mode 100644
index 0000000..c819fc0
--- /dev/null
+++ b/m4/d-type.m4
@@ -0,0 +1,32 @@
+# serial 12
+
+dnl From Jim Meyering.
+dnl
+dnl Check whether struct dirent has a member named d_type.
+dnl
+
+# Copyright (C) 1997, 1999-2004, 2006, 2009-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_CHECK_TYPE_STRUCT_DIRENT_D_TYPE],
+ [AC_CACHE_CHECK([for d_type member in directory struct],
+ [gl_cv_struct_dirent_d_type],
+ [AC_LINK_IFELSE([AC_LANG_PROGRAM([[
+#include <sys/types.h>
+#include <dirent.h>
+ ]],
+ [[struct dirent dp; dp.d_type = 0;]])],
+ [gl_cv_struct_dirent_d_type=yes],
+ [gl_cv_struct_dirent_d_type=no])
+ ]
+ )
+ if test $gl_cv_struct_dirent_d_type = yes; then
+ AC_DEFINE([HAVE_STRUCT_DIRENT_D_TYPE], [1],
+ [Define if there is a member named d_type in the struct describing
+ directory headers.])
+ fi
+ ]
+)
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index 2f13577..188c116 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -61,6 +61,7 @@ AC_DEFUN([gl_EARLY],
# Code from module crypto/sha1:
# Code from module crypto/sha256:
# Code from module crypto/sha512:
+ # Code from module d-type:
# Code from module diffseq:
# Code from module dirent:
# Code from module dirfd:
@@ -199,6 +200,7 @@ AC_DEFUN([gl_INIT],
gl_SHA1
gl_SHA256
gl_SHA512
+ gl_CHECK_TYPE_STRUCT_DIRENT_D_TYPE
gl_DIRENT_H
AC_REQUIRE([gl_C99_STRTOLD])
gl_FUNC_DUP2
@@ -968,6 +970,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/count-leading-zeros.m4
m4/count-one-bits.m4
m4/count-trailing-zeros.m4
+ m4/d-type.m4
m4/dirent_h.m4
m4/dirfd.m4
m4/dup2.m4
diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4
index 2d35eff..6a8939b 100644
--- a/m4/manywarnings.m4
+++ b/m4/manywarnings.m4
@@ -1,4 +1,4 @@
-# manywarnings.m4 serial 8
+# manywarnings.m4 serial 10
dnl Copyright (C) 2008-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -258,9 +258,20 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC],
# gcc --help=warnings outputs an unusual form for these options; list
# them here so that the above 'comm' command doesn't report a false match.
- # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal:
- ptrdiff_max_max=9223372036854775807
- gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$ptrdiff_max_max"
+ # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal
+ # and AC_COMPUTE_INT requires it to fit in a long:
+ AC_MSG_CHECKING([max safe object size])
+ AC_COMPUTE_INT([gl_alloc_max],
+ [(LONG_MAX < PTRDIFF_MAX ? LONG_MAX : PTRDIFF_MAX) < (size_t) -1
+ ? (LONG_MAX < PTRDIFF_MAX ? LONG_MAX : PTRDIFF_MAX)
+ : (size_t) -1],
+ [[#include <limits.h>
+ #include <stddef.h>
+ #include <stdint.h>
+ ]],
+ [gl_alloc_max=2147483647])
+ AC_MSG_RESULT([$gl_alloc_max])
+ gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$gl_alloc_max"
gl_manywarn_set="$gl_manywarn_set -Warray-bounds=2"
gl_manywarn_set="$gl_manywarn_set -Wformat-overflow=2"
gl_manywarn_set="$gl_manywarn_set -Wformat-truncation=2"
diff --git a/src/buffer.c b/src/buffer.c
index 649ddbe..0d0f43e 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1077,7 +1077,8 @@ is first appended to NAME, to speed up finding a
non-existent buffer. */)
CHECK_STRING (name);
- if (!NILP (Fstring_equal (name, ignore)) || NILP (Fget_buffer (name)))
+ if ((!NILP (ignore) && !NILP (Fstring_equal (name, ignore)))
+ || NILP (Fget_buffer (name)))
return name;
if (SREF (name, 0) != ' ') /* See bug#1229. */
diff --git a/src/cmds.c b/src/cmds.c
index 51652d5..6f2db86 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -268,9 +268,10 @@ Whichever character you type to run this command is
inserted.
The numeric prefix argument N says how many times to repeat the insertion.
Before insertion, `expand-abbrev' is executed if the inserted character does
not have word syntax and the previous character in the buffer does.
-After insertion, the value of `auto-fill-function' is called if the
-`auto-fill-chars' table has a non-nil value for the inserted character.
-At the end, it runs `post-self-insert-hook'. */)
+After insertion, `internal-auto-fill' is called if
+`auto-fill-function' is non-nil and if the `auto-fill-chars' table has
+a non-nil value for the inserted character. At the end, it runs
+`post-self-insert-hook'. */)
(Lisp_Object n)
{
CHECK_NUMBER (n);
@@ -475,7 +476,7 @@ internal_self_insert (int c, EMACS_INT n)
that. Must have the newline in place already so filling and
justification, if any, know where the end is going to be. */
SET_PT_BOTH (PT - 1, PT_BYTE - 1);
- auto_fill_result = call0 (BVAR (current_buffer, auto_fill_function));
+ auto_fill_result = call0 (Qinternal_auto_fill);
/* Test PT < ZV in case the auto-fill-function is strange. */
if (c == '\n' && PT < ZV)
SET_PT_BOTH (PT + 1, PT_BYTE + 1);
@@ -494,6 +495,8 @@ internal_self_insert (int c, EMACS_INT n)
void
syms_of_cmds (void)
{
+ DEFSYM (Qinternal_auto_fill, "internal-auto-fill");
+
DEFSYM (Qundo_auto_amalgamate, "undo-auto-amalgamate");
DEFSYM (Qundo_auto__this_command_amalgamating,
"undo-auto--this-command-amalgamating");
diff --git a/src/dired.c b/src/dired.c
index 5ea00fb..288ba6b 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -64,6 +64,21 @@ dirent_namelen (struct dirent *dp)
#endif
}
+#ifndef HAVE_STRUCT_DIRENT_D_TYPE
+enum { DT_UNKNOWN, DT_DIR, DT_LNK };
+#endif
+
+/* Return the file type of DP. */
+static int
+dirent_type (struct dirent *dp)
+{
+#ifdef HAVE_STRUCT_DIRENT_D_TYPE
+ return dp->d_type;
+#else
+ return DT_UNKNOWN;
+#endif
+}
+
static DIR *
open_directory (Lisp_Object dirname, int *fdp)
{
@@ -434,7 +449,7 @@ is matched against file and directory names relative to
DIRECTORY. */)
return file_name_completion (file, directory, 1, Qnil);
}
-static int file_name_completion_stat (int, struct dirent *, struct stat *);
+static bool file_name_completion_dirp (int, struct dirent *, ptrdiff_t);
static Lisp_Object
file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
@@ -448,7 +463,6 @@ file_name_completion (Lisp_Object file, Lisp_Object
dirname, bool all_flag,
Lisp_Object bestmatch, tem, elt, name;
Lisp_Object encoded_file;
Lisp_Object encoded_dir;
- struct stat st;
bool directoryp;
/* If not INCLUDEALL, exclude files in completion-ignored-extensions as
well as "." and "..". Until shown otherwise, assume we can't exclude
@@ -512,10 +526,21 @@ file_name_completion (Lisp_Object file, Lisp_Object
dirname, bool all_flag,
>= 0))
continue;
- if (file_name_completion_stat (fd, dp, &st) < 0)
- continue;
+ switch (dirent_type (dp))
+ {
+ case DT_DIR:
+ directoryp = true;
+ break;
+
+ case DT_LNK: case DT_UNKNOWN:
+ directoryp = file_name_completion_dirp (fd, dp, len);
+ break;
+
+ default:
+ directoryp = false;
+ break;
+ }
- directoryp = S_ISDIR (st.st_mode) != 0;
tem = Qnil;
/* If all_flag is set, always include all.
It would not actually be helpful to the user to ignore any possible
@@ -781,32 +806,18 @@ scmp (const char *s1, const char *s2, ptrdiff_t len)
return len - l;
}
-static int
-file_name_completion_stat (int fd, struct dirent *dp, struct stat *st_addr)
+/* Return true if in the directory FD the directory entry DP, whose
+ string length is LEN, is that of a subdirectory that can be searched. */
+static bool
+file_name_completion_dirp (int fd, struct dirent *dp, ptrdiff_t len)
{
- int value;
-
-#ifdef MSDOS
- /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
- but aren't required here. Avoid computing the following fields:
- st_inode, st_size and st_nlink for directories, and the execute bits
- in st_mode for non-directory files with non-standard extensions. */
-
- unsigned short save_djstat_flags = _djstat_flags;
-
- _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
-#endif /* MSDOS */
-
- /* We want to return success if a link points to a nonexistent file,
- but we want to return the status for what the link points to,
- in case it is a directory. */
- value = fstatat (fd, dp->d_name, st_addr, AT_SYMLINK_NOFOLLOW);
- if (value == 0 && S_ISLNK (st_addr->st_mode))
- fstatat (fd, dp->d_name, st_addr, 0);
-#ifdef MSDOS
- _djstat_flags = save_djstat_flags;
-#endif /* MSDOS */
- return value;
+ USE_SAFE_ALLOCA;
+ char *subdir_name = SAFE_ALLOCA (len + 2);
+ memcpy (subdir_name, dp->d_name, len);
+ strcpy (subdir_name + len, "/");
+ bool dirp = faccessat (fd, subdir_name, F_OK, AT_EACCESS) == 0;
+ SAFE_FREE ();
+ return dirp;
}
static char *
diff --git a/src/eval.c b/src/eval.c
index e590038..fe2708b 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -354,10 +354,11 @@ usage: (or CONDITIONS...) */)
while (CONSP (args))
{
- val = eval_sub (XCAR (args));
+ Lisp_Object arg = XCAR (args);
+ args = XCDR (args);
+ val = eval_sub (arg);
if (!NILP (val))
break;
- args = XCDR (args);
}
return val;
@@ -374,10 +375,11 @@ usage: (and CONDITIONS...) */)
while (CONSP (args))
{
- val = eval_sub (XCAR (args));
+ Lisp_Object arg = XCAR (args);
+ args = XCDR (args);
+ val = eval_sub (arg);
if (NILP (val))
break;
- args = XCDR (args);
}
return val;
@@ -397,7 +399,7 @@ usage: (if COND THEN ELSE...) */)
if (!NILP (cond))
return eval_sub (Fcar (XCDR (args)));
- return Fprogn (XCDR (XCDR (args)));
+ return Fprogn (Fcdr (XCDR (args)));
}
DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
@@ -439,8 +441,9 @@ usage: (progn BODY...) */)
while (CONSP (body))
{
- val = eval_sub (XCAR (body));
+ Lisp_Object form = XCAR (body);
body = XCDR (body);
+ val = eval_sub (form);
}
return val;
@@ -488,35 +491,26 @@ The return value of the `setq' form is the value of the
last VAL.
usage: (setq [SYM VAL]...) */)
(Lisp_Object args)
{
- Lisp_Object val, sym, lex_binding;
+ Lisp_Object val = args, tail = args;
- val = args;
- if (CONSP (args))
+ for (EMACS_INT nargs = 0; CONSP (tail); nargs += 2)
{
- Lisp_Object args_left = args;
- Lisp_Object numargs = Flength (args);
-
- if (XINT (numargs) & 1)
- xsignal2 (Qwrong_number_of_arguments, Qsetq, numargs);
-
- do
- {
- val = eval_sub (Fcar (XCDR (args_left)));
- sym = XCAR (args_left);
-
- /* Like for eval_sub, we do not check declared_special here since
- it's been done when let-binding. */
- if (!NILP (Vinternal_interpreter_environment) /* Mere optimization!
*/
- && SYMBOLP (sym)
- && !NILP (lex_binding
- = Fassq (sym, Vinternal_interpreter_environment)))
- XSETCDR (lex_binding, val); /* SYM is lexically bound. */
- else
- Fset (sym, val); /* SYM is dynamically bound. */
-
- args_left = Fcdr (XCDR (args_left));
- }
- while (CONSP (args_left));
+ Lisp_Object sym = XCAR (tail), lex_binding;
+ tail = XCDR (tail);
+ if (!CONSP (tail))
+ xsignal2 (Qwrong_number_of_arguments, Qsetq, make_number (nargs + 1));
+ Lisp_Object arg = XCAR (tail);
+ tail = XCDR (tail);
+ val = eval_sub (arg);
+ /* Like for eval_sub, we do not check declared_special here since
+ it's been done when let-binding. */
+ if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
+ && SYMBOLP (sym)
+ && !NILP (lex_binding
+ = Fassq (sym, Vinternal_interpreter_environment)))
+ XSETCDR (lex_binding, val); /* SYM is lexically bound. */
+ else
+ Fset (sym, val); /* SYM is dynamically bound. */
}
return val;
@@ -535,7 +529,7 @@ of unexpected results when a quoted object is modified.
usage: (quote ARG) */)
(Lisp_Object args)
{
- if (CONSP (XCDR (args)))
+ if (!NILP (XCDR (args)))
xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
return XCAR (args);
}
@@ -549,7 +543,7 @@ usage: (function ARG) */)
{
Lisp_Object quoted = XCAR (args);
- if (CONSP (XCDR (args)))
+ if (!NILP (XCDR (args)))
xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
if (!NILP (Vinternal_interpreter_environment)
@@ -734,9 +728,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
sym = XCAR (args);
tail = XCDR (args);
- if (CONSP (tail))
+ if (!NILP (tail))
{
- if (CONSP (XCDR (tail)) && CONSP (XCDR (XCDR (tail))))
+ if (!NILP (XCDR (tail)) && !NILP (XCDR (XCDR (tail))))
error ("Too many arguments");
tem = Fdefault_boundp (sym);
@@ -803,20 +797,24 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
Lisp_Object sym, tem;
sym = XCAR (args);
- if (CONSP (Fcdr (XCDR (XCDR (args)))))
- error ("Too many arguments");
+ Lisp_Object docstring = Qnil;
+ if (!NILP (XCDR (XCDR (args))))
+ {
+ if (!NILP (XCDR (XCDR (XCDR (args)))))
+ error ("Too many arguments");
+ docstring = XCAR (XCDR (XCDR (args)));
+ }
- tem = eval_sub (Fcar (XCDR (args)));
+ tem = eval_sub (XCAR (XCDR (args)));
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fset_default (sym, tem);
XSYMBOL (sym)->declared_special = 1;
- tem = Fcar (XCDR (XCDR (args)));
- if (!NILP (tem))
+ if (!NILP (docstring))
{
if (!NILP (Vpurify_flag))
- tem = Fpurecopy (tem);
- Fput (sym, Qvariable_documentation, tem);
+ docstring = Fpurecopy (docstring);
+ Fput (sym, Qvariable_documentation, docstring);
}
Fput (sym, Qrisky_local_variable, Qt);
LOADHIST_ATTACH (sym);
@@ -844,27 +842,29 @@ Each VALUEFORM can refer to the symbols already bound by
this VARLIST.
usage: (let* VARLIST BODY...) */)
(Lisp_Object args)
{
- Lisp_Object varlist, var, val, elt, lexenv;
+ Lisp_Object var, val, elt, lexenv;
ptrdiff_t count = SPECPDL_INDEX ();
lexenv = Vinternal_interpreter_environment;
- for (varlist = XCAR (args); CONSP (varlist); varlist = XCDR (varlist))
+ Lisp_Object varlist = XCAR (args);
+ while (CONSP (varlist))
{
maybe_quit ();
elt = XCAR (varlist);
+ varlist = XCDR (varlist);
if (SYMBOLP (elt))
{
var = elt;
val = Qnil;
}
- else if (! NILP (Fcdr (Fcdr (elt))))
- signal_error ("`let' bindings can have only one value-form", elt);
else
{
var = Fcar (elt);
- val = eval_sub (Fcar (Fcdr (elt)));
+ if (! NILP (Fcdr (XCDR (elt))))
+ signal_error ("`let' bindings can have only one value-form", elt);
+ val = eval_sub (Fcar (XCDR (elt)));
}
if (!NILP (lexenv) && SYMBOLP (var)
@@ -911,33 +911,37 @@ usage: (let VARLIST BODY...) */)
CHECK_LIST (varlist);
/* Make space to hold the values to give the bound variables. */
- elt = Flength (varlist);
- SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
+ EMACS_INT varlist_len = XFASTINT (Flength (varlist));
+ SAFE_ALLOCA_LISP (temps, varlist_len);
+ ptrdiff_t nvars = varlist_len;
/* Compute the values and store them in `temps'. */
- for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
+ for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++)
{
maybe_quit ();
elt = XCAR (varlist);
+ varlist = XCDR (varlist);
if (SYMBOLP (elt))
- temps [argnum++] = Qnil;
+ temps[argnum] = Qnil;
else if (! NILP (Fcdr (Fcdr (elt))))
signal_error ("`let' bindings can have only one value-form", elt);
else
- temps [argnum++] = eval_sub (Fcar (Fcdr (elt)));
+ temps[argnum] = eval_sub (Fcar (Fcdr (elt)));
}
+ nvars = argnum;
lexenv = Vinternal_interpreter_environment;
varlist = XCAR (args);
- for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
+ for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++)
{
Lisp_Object var;
elt = XCAR (varlist);
+ varlist = XCDR (varlist);
var = SYMBOLP (elt) ? elt : Fcar (elt);
- tem = temps[argnum++];
+ tem = temps[argnum];
if (!NILP (lexenv) && SYMBOLP (var)
&& !XSYMBOL (var)->declared_special
@@ -2135,6 +2139,7 @@ eval_sub (Lisp_Object form)
original_fun = XCAR (form);
original_args = XCDR (form);
+ CHECK_LIST (original_args);
/* This also protects them from gc. */
count = record_in_backtrace (original_fun, &original_args, UNEVALLED);
@@ -2176,15 +2181,16 @@ eval_sub (Lisp_Object form)
SAFE_ALLOCA_LISP (vals, XINT (numargs));
- while (!NILP (args_left))
+ while (CONSP (args_left) && argnum < XINT (numargs))
{
- vals[argnum++] = eval_sub (Fcar (args_left));
- args_left = Fcdr (args_left);
+ Lisp_Object arg = XCAR (args_left);
+ args_left = XCDR (args_left);
+ vals[argnum++] = eval_sub (arg);
}
- set_backtrace_args (specpdl + count, vals, XINT (numargs));
+ set_backtrace_args (specpdl + count, vals, argnum);
- val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
+ val = XSUBR (fun)->function.aMANY (argnum, vals);
check_cons_list ();
lisp_eval_depth--;
diff --git a/src/fileio.c b/src/fileio.c
index a57d50b..db760d9 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -2216,7 +2216,7 @@ With a prefix argument, TRASH is nil. */)
encoded_file = ENCODE_FILE (filename);
- if (unlink (SSDATA (encoded_file)) < 0)
+ if (unlink (SSDATA (encoded_file)) != 0 && errno != ENOENT)
report_file_error ("Removing old name", filename);
return Qnil;
}
@@ -2311,6 +2311,7 @@ This is what happens in interactive use with M-x. */)
{
Lisp_Object handler;
Lisp_Object encoded_file, encoded_newname, symlink_target;
+ int dirp = -1;
symlink_target = encoded_file = encoded_newname = Qnil;
CHECK_STRING (file);
@@ -2324,8 +2325,8 @@ This is what happens in interactive use with M-x. */)
&& (NILP (Ffile_name_case_insensitive_p (file))
|| NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname)))))
{
- Lisp_Object fname = (NILP (Ffile_directory_p (file))
- ? file : Fdirectory_file_name (file));
+ dirp = !NILP (Ffile_directory_p (file));
+ Lisp_Object fname = dirp ? Fdirectory_file_name (file) : file;
newname = Fexpand_file_name (Ffile_name_nondirectory (fname), newname);
}
else
@@ -2344,46 +2345,69 @@ This is what happens in interactive use with M-x. */)
encoded_newname = ENCODE_FILE (newname);
/* If the filesystem is case-insensitive and the file names are
- identical but for the case, don't ask for confirmation: they
- simply want to change the letter-case of the file name. */
- if ((!(file_name_case_insensitive_p (SSDATA (encoded_file)))
- || NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
- && ((NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists))))
- barf_or_query_if_file_exists (newname, false, "rename to it",
- INTEGERP (ok_if_already_exists), false);
- if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
+ identical but for the case, don't worry whether the destination
+ already exists: the caller simply wants to change the letter-case
+ of the file name. */
+ bool plain_rename
+ = ((!NILP (ok_if_already_exists) && !INTEGERP (ok_if_already_exists))
+ || (file_name_case_insensitive_p (SSDATA (encoded_file))
+ && ! NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname)))));
+
+ int rename_errno;
+ if (!plain_rename)
{
- int rename_errno = errno;
- if (rename_errno == EXDEV)
+ if (renameat_noreplace (AT_FDCWD, SSDATA (encoded_file),
+ AT_FDCWD, SSDATA (encoded_newname))
+ == 0)
+ return Qnil;
+
+ rename_errno = errno;
+ switch (rename_errno)
{
- ptrdiff_t count;
- symlink_target = Ffile_symlink_p (file);
- if (! NILP (symlink_target))
- Fmake_symbolic_link (symlink_target, newname,
- NILP (ok_if_already_exists) ? Qnil : Qt);
- else if (!NILP (Ffile_directory_p (file)))
- call4 (Qcopy_directory, file, newname, Qt, Qnil);
- else
- /* We have already prompted if it was an integer, so don't
- have copy-file prompt again. */
- Fcopy_file (file, newname,
- NILP (ok_if_already_exists) ? Qnil : Qt,
- Qt, Qt, Qt);
+ case EEXIST: case EINVAL: case ENOSYS:
+ barf_or_query_if_file_exists (newname, rename_errno == EEXIST,
+ "rename to it",
+ INTEGERP (ok_if_already_exists),
+ false);
+ plain_rename = true;
+ break;
+ }
+ }
- count = SPECPDL_INDEX ();
- specbind (Qdelete_by_moving_to_trash, Qnil);
+ if (plain_rename)
+ {
+ if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
+ return Qnil;
+ rename_errno = errno;
+ /* Don't prompt again. */
+ ok_if_already_exists = Qt;
+ }
+ else if (!NILP (ok_if_already_exists))
+ ok_if_already_exists = Qt;
- if (!NILP (Ffile_directory_p (file)) && NILP (symlink_target))
- call2 (Qdelete_directory, file, Qt);
- else
- Fdelete_file (file, Qnil);
- unbind_to (count, Qnil);
- }
+ if (rename_errno != EXDEV)
+ report_file_errno ("Renaming", list2 (file, newname), rename_errno);
+
+ symlink_target = Ffile_symlink_p (file);
+ if (!NILP (symlink_target))
+ Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists);
+ else
+ {
+ if (dirp < 0)
+ dirp = !NILP (Ffile_directory_p (file));
+ if (dirp)
+ call4 (Qcopy_directory, file, newname, Qt, Qnil);
else
- report_file_errno ("Renaming", list2 (file, newname), rename_errno);
+ Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt);
}
- return Qnil;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ specbind (Qdelete_by_moving_to_trash, Qnil);
+ if (dirp && NILP (symlink_target))
+ call2 (Qdelete_directory, file, Qt);
+ else
+ Fdelete_file (file, Qnil);
+ return unbind_to (count, Qnil);
}
DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
@@ -2425,19 +2449,21 @@ This is what happens in interactive use with M-x. */)
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
- if (NILP (ok_if_already_exists)
- || INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (newname, false, "make it a new name",
- INTEGERP (ok_if_already_exists), false);
+ if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
+ return Qnil;
- unlink (SSDATA (newname));
- if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
+ if (errno == EEXIST)
{
- int link_errno = errno;
- report_file_errno ("Adding new name", list2 (file, newname), link_errno);
+ if (NILP (ok_if_already_exists)
+ || INTEGERP (ok_if_already_exists))
+ barf_or_query_if_file_exists (newname, true, "make it a new name",
+ INTEGERP (ok_if_already_exists), false);
+ unlink (SSDATA (newname));
+ if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
+ return Qnil;
}
- return Qnil;
+ report_file_error ("Adding new name", list2 (file, newname));
}
DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
@@ -2484,31 +2510,25 @@ This happens for interactive use with M-x. */)
encoded_target = ENCODE_FILE (target);
encoded_linkname = ENCODE_FILE (linkname);
- if (NILP (ok_if_already_exists)
- || INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (linkname, false, "make it a link",
- INTEGERP (ok_if_already_exists), false);
- if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) < 0)
- {
- /* If we didn't complain already, silently delete existing file. */
- int symlink_errno;
- if (errno == EEXIST)
- {
- unlink (SSDATA (encoded_linkname));
- if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname))
- >= 0)
- return Qnil;
- }
- if (errno == ENOSYS)
- xsignal1 (Qfile_error,
- build_string ("Symbolic links are not supported"));
+ if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
+ return Qnil;
- symlink_errno = errno;
- report_file_errno ("Making symbolic link", list2 (target, linkname),
- symlink_errno);
+ if (errno == ENOSYS)
+ xsignal1 (Qfile_error,
+ build_string ("Symbolic links are not supported"));
+
+ if (errno == EEXIST)
+ {
+ if (NILP (ok_if_already_exists)
+ || INTEGERP (ok_if_already_exists))
+ barf_or_query_if_file_exists (linkname, true, "make it a link",
+ INTEGERP (ok_if_already_exists), false);
+ unlink (SSDATA (encoded_linkname));
+ if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
+ return Qnil;
}
- return Qnil;
+ report_file_error ("Making symbolic link", list2 (target, linkname));
}
diff --git a/src/filelock.c b/src/filelock.c
index bfa1d63..dd8cb28 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -339,6 +339,9 @@ rename_lock_file (char const *old, char const *new, bool
force)
{
struct stat st;
+ int r = renameat_noreplace (AT_FDCWD, old, AT_FDCWD, new);
+ if (! (r < 0 && errno == ENOSYS))
+ return r;
if (link (old, new) == 0)
return unlink (old) == 0 || errno == ENOENT ? 0 : -1;
if (errno != ENOSYS && errno != LINKS_MIGHT_NOT_WORK)
diff --git a/src/gnutls.c b/src/gnutls.c
index 5969407..188f995 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -26,22 +26,36 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include "coding.h"
#include "buffer.h"
-#ifdef HAVE_GNUTLS
+#if 0x030014 <= GNUTLS_VERSION_NUMBER
+# define HAVE_GNUTLS_X509_SYSTEM_TRUST
+#endif
-#ifdef WINDOWSNT
-#include <windows.h>
-#include "w32.h"
+/* Although AEAD support started in GnuTLS 3.4.0 and works in 3.5.14,
+ it was broken through at least GnuTLS 3.4.10; see:
+ https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00992.html
+ The relevant fix seems to have been made in GnuTLS 3.5.1; see:
+
https://gitlab.com/gnutls/gnutls/commit/568935848dd6b82b9315d8b6c529d00e2605e03d
+ So, require 3.5.1. */
+#if 0x030501 <= GNUTLS_VERSION_NUMBER
+# define HAVE_GNUTLS_AEAD
#endif
+#ifdef HAVE_GNUTLS
+
+# ifdef WINDOWSNT
+# include <windows.h>
+# include "w32.h"
+# endif
+
static bool emacs_gnutls_handle_error (gnutls_session_t, int);
static bool gnutls_global_initialized;
static void gnutls_log_function (int, const char *);
static void gnutls_log_function2 (int, const char *, const char *);
-#ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
static void gnutls_audit_log_function (gnutls_session_t, const char *);
-#endif
+# endif
enum extra_peer_verification
{
@@ -49,7 +63,7 @@ enum extra_peer_verification
};
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
DEF_DLL_FN (gnutls_alert_description_t, gnutls_alert_get,
(gnutls_session_t));
@@ -74,12 +88,10 @@ DEF_DLL_FN (int, gnutls_certificate_set_x509_crl_file,
DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file,
(gnutls_certificate_credentials_t, const char *, const char *,
gnutls_x509_crt_fmt_t));
-# if ((GNUTLS_VERSION_MAJOR \
- + (GNUTLS_VERSION_MINOR > 0 || GNUTLS_VERSION_PATCH >= 20)) \
- > 3)
+# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
DEF_DLL_FN (int, gnutls_certificate_set_x509_system_trust,
(gnutls_certificate_credentials_t));
-# endif
+# endif
DEF_DLL_FN (int, gnutls_certificate_set_x509_trust_file,
(gnutls_certificate_credentials_t, const char *,
gnutls_x509_crt_fmt_t));
@@ -96,9 +108,9 @@ DEF_DLL_FN (int, gnutls_dh_get_prime_bits,
(gnutls_session_t));
DEF_DLL_FN (int, gnutls_error_is_fatal, (int));
DEF_DLL_FN (int, gnutls_global_init, (void));
DEF_DLL_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
-# ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
DEF_DLL_FN (void, gnutls_global_set_audit_log_function,
(gnutls_audit_log_func));
-# endif
+# endif
DEF_DLL_FN (void, gnutls_global_set_log_level, (int));
DEF_DLL_FN (int, gnutls_handshake, (gnutls_session_t));
DEF_DLL_FN (int, gnutls_init, (gnutls_session_t *, unsigned int));
@@ -172,14 +184,13 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name,
DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t));
DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t));
-# ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t));
DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void));
DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t));
DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t));
DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void));
DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t));
-# ifdef HAVE_GNUTLS3_CIPHER
DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void));
DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t));
DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t));
@@ -194,7 +205,7 @@ DEF_DLL_FN (int, gnutls_cipher_encrypt2,
DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t));
DEF_DLL_FN (int, gnutls_cipher_decrypt2,
(gnutls_cipher_hd_t, const void *, size_t, void *, size_t));
-# ifdef HAVE_GNUTLS3_AEAD
+# ifdef HAVE_GNUTLS_AEAD
DEF_DLL_FN (int, gnutls_aead_cipher_init,
(gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t,
const gnutls_datum_t *));
@@ -205,25 +216,20 @@ DEF_DLL_FN (int, gnutls_aead_cipher_encrypt,
DEF_DLL_FN (int, gnutls_aead_cipher_decrypt,
(gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
size_t, size_t, const void *, size_t, void *, size_t *));
-# endif /* HAVE_GNUTLS3_AEAD */
-# ifdef HAVE_GNUTLS3_HMAC
+# endif
DEF_DLL_FN (int, gnutls_hmac_init,
(gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t));
DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t));
DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t));
DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *));
DEF_DLL_FN (void, gnutls_hmac_output, (gnutls_hmac_hd_t, void *));
-# endif /* HAVE_GNUTLS3_HMAC */
-# endif /* HAVE_GNUTLS3_CIPHER */
-# ifdef HAVE_GNUTLS3_DIGEST
DEF_DLL_FN (int, gnutls_hash_init,
(gnutls_hash_hd_t *, gnutls_digest_algorithm_t));
DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t));
DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t));
DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *));
DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *));
-# endif /* HAVE_GNUTLS3_DIGEST */
-# endif /* HAVE_GNUTLS3 */
+# endif /* HAVE_GNUTLS3 */
static bool
@@ -249,11 +255,9 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_certificate_set_verify_flags);
LOAD_DLL_FN (library, gnutls_certificate_set_x509_crl_file);
LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file);
-# if ((GNUTLS_VERSION_MAJOR \
- + (GNUTLS_VERSION_MINOR > 0 || GNUTLS_VERSION_PATCH >= 20)) \
- > 3)
+# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
LOAD_DLL_FN (library, gnutls_certificate_set_x509_system_trust);
-# endif
+# endif
LOAD_DLL_FN (library, gnutls_certificate_set_x509_trust_file);
LOAD_DLL_FN (library, gnutls_certificate_type_get);
LOAD_DLL_FN (library, gnutls_certificate_verify_peers2);
@@ -264,9 +268,9 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_error_is_fatal);
LOAD_DLL_FN (library, gnutls_global_init);
LOAD_DLL_FN (library, gnutls_global_set_log_function);
-# ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
LOAD_DLL_FN (library, gnutls_global_set_audit_log_function);
-# endif
+# endif
LOAD_DLL_FN (library, gnutls_global_set_log_level);
LOAD_DLL_FN (library, gnutls_handshake);
LOAD_DLL_FN (library, gnutls_init);
@@ -309,14 +313,13 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_cipher_get_name);
LOAD_DLL_FN (library, gnutls_mac_get);
LOAD_DLL_FN (library, gnutls_mac_get_name);
-# ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
LOAD_DLL_FN (library, gnutls_rnd);
LOAD_DLL_FN (library, gnutls_mac_list);
LOAD_DLL_FN (library, gnutls_mac_get_nonce_size);
LOAD_DLL_FN (library, gnutls_mac_get_key_size);
LOAD_DLL_FN (library, gnutls_digest_list);
LOAD_DLL_FN (library, gnutls_digest_get_name);
-# ifdef HAVE_GNUTLS3_CIPHER
LOAD_DLL_FN (library, gnutls_cipher_list);
LOAD_DLL_FN (library, gnutls_cipher_get_iv_size);
LOAD_DLL_FN (library, gnutls_cipher_get_key_size);
@@ -327,28 +330,23 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_cipher_encrypt2);
LOAD_DLL_FN (library, gnutls_cipher_deinit);
LOAD_DLL_FN (library, gnutls_cipher_decrypt2);
-# ifdef HAVE_GNUTLS3_AEAD
+# ifdef HAVE_GNUTLS_AEAD
LOAD_DLL_FN (library, gnutls_aead_cipher_init);
LOAD_DLL_FN (library, gnutls_aead_cipher_deinit);
LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt);
LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt);
# endif
-# ifdef HAVE_GNUTLS3_HMAC
LOAD_DLL_FN (library, gnutls_hmac_init);
LOAD_DLL_FN (library, gnutls_hmac_get_len);
LOAD_DLL_FN (library, gnutls_hmac);
LOAD_DLL_FN (library, gnutls_hmac_deinit);
LOAD_DLL_FN (library, gnutls_hmac_output);
-# endif /* HAVE_GNUTLS3_HMAC */
-# endif /* HAVE_GNUTLS3_CIPHER */
-# ifdef HAVE_GNUTLS3_DIGEST
LOAD_DLL_FN (library, gnutls_hash_init);
LOAD_DLL_FN (library, gnutls_hash_get_len);
LOAD_DLL_FN (library, gnutls_hash);
LOAD_DLL_FN (library, gnutls_hash_deinit);
LOAD_DLL_FN (library, gnutls_hash_output);
-# endif
-# endif /* HAVE_GNUTLS3 */
+# endif /* HAVE_GNUTLS3 */
max_log_level = global_gnutls_log_level;
@@ -361,111 +359,105 @@ init_gnutls_functions (void)
return 1;
}
-# define gnutls_alert_get fn_gnutls_alert_get
-# define gnutls_alert_get_name fn_gnutls_alert_get_name
-# define gnutls_anon_allocate_client_credentials
fn_gnutls_anon_allocate_client_credentials
-# define gnutls_anon_free_client_credentials
fn_gnutls_anon_free_client_credentials
-# define gnutls_bye fn_gnutls_bye
-# define gnutls_certificate_allocate_credentials
fn_gnutls_certificate_allocate_credentials
-# define gnutls_certificate_free_credentials
fn_gnutls_certificate_free_credentials
-# define gnutls_certificate_get_peers fn_gnutls_certificate_get_peers
-# define gnutls_certificate_set_verify_flags
fn_gnutls_certificate_set_verify_flags
-# define gnutls_certificate_set_x509_crl_file
fn_gnutls_certificate_set_x509_crl_file
-# define gnutls_certificate_set_x509_key_file
fn_gnutls_certificate_set_x509_key_file
-# define gnutls_certificate_set_x509_system_trust
fn_gnutls_certificate_set_x509_system_trust
-# define gnutls_certificate_set_x509_trust_file
fn_gnutls_certificate_set_x509_trust_file
-# define gnutls_certificate_type_get fn_gnutls_certificate_type_get
-# define gnutls_certificate_verify_peers2 fn_gnutls_certificate_verify_peers2
-# define gnutls_cipher_get fn_gnutls_cipher_get
-# define gnutls_cipher_get_name fn_gnutls_cipher_get_name
-# define gnutls_credentials_set fn_gnutls_credentials_set
-# define gnutls_deinit fn_gnutls_deinit
-# define gnutls_dh_get_prime_bits fn_gnutls_dh_get_prime_bits
-# define gnutls_dh_set_prime_bits fn_gnutls_dh_set_prime_bits
-# define gnutls_error_is_fatal fn_gnutls_error_is_fatal
-# define gnutls_global_init fn_gnutls_global_init
-# define gnutls_global_set_audit_log_function
fn_gnutls_global_set_audit_log_function
-# define gnutls_global_set_log_function fn_gnutls_global_set_log_function
-# define gnutls_global_set_log_level fn_gnutls_global_set_log_level
-# define gnutls_handshake fn_gnutls_handshake
-# define gnutls_init fn_gnutls_init
-# define gnutls_kx_get fn_gnutls_kx_get
-# define gnutls_kx_get_name fn_gnutls_kx_get_name
-# define gnutls_mac_get fn_gnutls_mac_get
-# define gnutls_mac_get_name fn_gnutls_mac_get_name
-# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name
-# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param
-# define gnutls_priority_set_direct fn_gnutls_priority_set_direct
-# define gnutls_protocol_get_name fn_gnutls_protocol_get_name
-# define gnutls_protocol_get_version fn_gnutls_protocol_get_version
-# define gnutls_record_check_pending fn_gnutls_record_check_pending
-# define gnutls_record_recv fn_gnutls_record_recv
-# define gnutls_record_send fn_gnutls_record_send
-# define gnutls_sec_param_get_name fn_gnutls_sec_param_get_name
-# define gnutls_server_name_set fn_gnutls_server_name_set
-# define gnutls_sign_get_name fn_gnutls_sign_get_name
-# define gnutls_strerror fn_gnutls_strerror
-# define gnutls_transport_set_errno fn_gnutls_transport_set_errno
-# define gnutls_transport_set_ptr2 fn_gnutls_transport_set_ptr2
-# define gnutls_transport_set_pull_function
fn_gnutls_transport_set_pull_function
-# define gnutls_transport_set_push_function
fn_gnutls_transport_set_push_function
-# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
-# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
-# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
-# define gnutls_x509_crt_get_activation_time
fn_gnutls_x509_crt_get_activation_time
-# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
-# define gnutls_x509_crt_get_expiration_time
fn_gnutls_x509_crt_get_expiration_time
-# define gnutls_x509_crt_get_fingerprint fn_gnutls_x509_crt_get_fingerprint
-# define gnutls_x509_crt_get_issuer_dn fn_gnutls_x509_crt_get_issuer_dn
-# define gnutls_x509_crt_get_issuer_unique_id
fn_gnutls_x509_crt_get_issuer_unique_id
-# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
-# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
-# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
-# define gnutls_x509_crt_get_signature_algorithm
fn_gnutls_x509_crt_get_signature_algorithm
-# define gnutls_x509_crt_get_subject_unique_id
fn_gnutls_x509_crt_get_subject_unique_id
-# define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version
-# define gnutls_x509_crt_import fn_gnutls_x509_crt_import
-# define gnutls_x509_crt_init fn_gnutls_x509_crt_init
-# ifdef HAVE_GNUTLS3
-# define gnutls_rnd fn_gnutls_rnd
-# define gnutls_mac_list fn_gnutls_mac_list
-# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size
-# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size
-# define gnutls_digest_list fn_gnutls_digest_list
-# define gnutls_digest_get_name fn_gnutls_digest_get_name
-# ifdef HAVE_GNUTLS3_CIPHER
-# define gnutls_cipher_list fn_gnutls_cipher_list
-# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size
-# define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size
-# define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size
-# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size
-# define gnutls_cipher_init fn_gnutls_cipher_init
-# define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv
-# define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2
-# define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2
-# define gnutls_cipher_deinit fn_gnutls_cipher_deinit
-# ifdef HAVE_GNUTLS3_AEAD
-# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt
-# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt
-# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
-# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
-# endif /* HAVE_GNUTLS3_AEAD */
-# ifdef HAVE_GNUTLS3_HMAC
-# define gnutls_hmac_init fn_gnutls_hmac_init
-# define gnutls_hmac_get_len fn_gnutls_hmac_get_len
-# define gnutls_hmac fn_gnutls_hmac
-# define gnutls_hmac_deinit fn_gnutls_hmac_deinit
-# define gnutls_hmac_output fn_gnutls_hmac_output
-# endif /* HAVE_GNUTLS3_HMAC */
-# endif /* HAVE_GNUTLS3_CIPHER */
-# ifdef HAVE_GNUTLS3_DIGEST
-# define gnutls_hash_init fn_gnutls_hash_init
-# define gnutls_hash_get_len fn_gnutls_hash_get_len
-# define gnutls_hash fn_gnutls_hash
-# define gnutls_hash_deinit fn_gnutls_hash_deinit
-# define gnutls_hash_output fn_gnutls_hash_output
-# endif
-# endif /* HAVE_GNUTLS3 */
+# define gnutls_alert_get fn_gnutls_alert_get
+# define gnutls_alert_get_name fn_gnutls_alert_get_name
+# define gnutls_anon_allocate_client_credentials
fn_gnutls_anon_allocate_client_credentials
+# define gnutls_anon_free_client_credentials
fn_gnutls_anon_free_client_credentials
+# define gnutls_bye fn_gnutls_bye
+# define gnutls_certificate_allocate_credentials
fn_gnutls_certificate_allocate_credentials
+# define gnutls_certificate_free_credentials
fn_gnutls_certificate_free_credentials
+# define gnutls_certificate_get_peers fn_gnutls_certificate_get_peers
+# define gnutls_certificate_set_verify_flags
fn_gnutls_certificate_set_verify_flags
+# define gnutls_certificate_set_x509_crl_file
fn_gnutls_certificate_set_x509_crl_file
+# define gnutls_certificate_set_x509_key_file
fn_gnutls_certificate_set_x509_key_file
+# define gnutls_certificate_set_x509_system_trust
fn_gnutls_certificate_set_x509_system_trust
+# define gnutls_certificate_set_x509_trust_file
fn_gnutls_certificate_set_x509_trust_file
+# define gnutls_certificate_type_get fn_gnutls_certificate_type_get
+# define gnutls_certificate_verify_peers2 fn_gnutls_certificate_verify_peers2
+# define gnutls_cipher_get fn_gnutls_cipher_get
+# define gnutls_cipher_get_name fn_gnutls_cipher_get_name
+# define gnutls_credentials_set fn_gnutls_credentials_set
+# define gnutls_deinit fn_gnutls_deinit
+# define gnutls_dh_get_prime_bits fn_gnutls_dh_get_prime_bits
+# define gnutls_dh_set_prime_bits fn_gnutls_dh_set_prime_bits
+# define gnutls_error_is_fatal fn_gnutls_error_is_fatal
+# define gnutls_global_init fn_gnutls_global_init
+# define gnutls_global_set_audit_log_function
fn_gnutls_global_set_audit_log_function
+# define gnutls_global_set_log_function fn_gnutls_global_set_log_function
+# define gnutls_global_set_log_level fn_gnutls_global_set_log_level
+# define gnutls_handshake fn_gnutls_handshake
+# define gnutls_init fn_gnutls_init
+# define gnutls_kx_get fn_gnutls_kx_get
+# define gnutls_kx_get_name fn_gnutls_kx_get_name
+# define gnutls_mac_get fn_gnutls_mac_get
+# define gnutls_mac_get_name fn_gnutls_mac_get_name
+# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name
+# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param
+# define gnutls_priority_set_direct fn_gnutls_priority_set_direct
+# define gnutls_protocol_get_name fn_gnutls_protocol_get_name
+# define gnutls_protocol_get_version fn_gnutls_protocol_get_version
+# define gnutls_record_check_pending fn_gnutls_record_check_pending
+# define gnutls_record_recv fn_gnutls_record_recv
+# define gnutls_record_send fn_gnutls_record_send
+# define gnutls_sec_param_get_name fn_gnutls_sec_param_get_name
+# define gnutls_server_name_set fn_gnutls_server_name_set
+# define gnutls_sign_get_name fn_gnutls_sign_get_name
+# define gnutls_strerror fn_gnutls_strerror
+# define gnutls_transport_set_errno fn_gnutls_transport_set_errno
+# define gnutls_transport_set_ptr2 fn_gnutls_transport_set_ptr2
+# define gnutls_transport_set_pull_function
fn_gnutls_transport_set_pull_function
+# define gnutls_transport_set_push_function
fn_gnutls_transport_set_push_function
+# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
+# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
+# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
+# define gnutls_x509_crt_get_activation_time
fn_gnutls_x509_crt_get_activation_time
+# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
+# define gnutls_x509_crt_get_expiration_time
fn_gnutls_x509_crt_get_expiration_time
+# define gnutls_x509_crt_get_fingerprint fn_gnutls_x509_crt_get_fingerprint
+# define gnutls_x509_crt_get_issuer_dn fn_gnutls_x509_crt_get_issuer_dn
+# define gnutls_x509_crt_get_issuer_unique_id
fn_gnutls_x509_crt_get_issuer_unique_id
+# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
+# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
+# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
+# define gnutls_x509_crt_get_signature_algorithm
fn_gnutls_x509_crt_get_signature_algorithm
+# define gnutls_x509_crt_get_subject_unique_id
fn_gnutls_x509_crt_get_subject_unique_id
+# define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version
+# define gnutls_x509_crt_import fn_gnutls_x509_crt_import
+# define gnutls_x509_crt_init fn_gnutls_x509_crt_init
+# ifdef HAVE_GNUTLS3
+# define gnutls_rnd fn_gnutls_rnd
+# define gnutls_mac_list fn_gnutls_mac_list
+# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size
+# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size
+# define gnutls_digest_list fn_gnutls_digest_list
+# define gnutls_digest_get_name fn_gnutls_digest_get_name
+# define gnutls_cipher_list fn_gnutls_cipher_list
+# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size
+# define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size
+# define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size
+# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size
+# define gnutls_cipher_init fn_gnutls_cipher_init
+# define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv
+# define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2
+# define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2
+# define gnutls_cipher_deinit fn_gnutls_cipher_deinit
+# ifdef HAVE_GNUTLS_AEAD
+# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt
+# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt
+# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
+# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
+# endif
+# define gnutls_hmac_init fn_gnutls_hmac_init
+# define gnutls_hmac_get_len fn_gnutls_hmac_get_len
+# define gnutls_hmac fn_gnutls_hmac
+# define gnutls_hmac_deinit fn_gnutls_hmac_deinit
+# define gnutls_hmac_output fn_gnutls_hmac_output
+# define gnutls_hash_init fn_gnutls_hash_init
+# define gnutls_hash_get_len fn_gnutls_hash_get_len
+# define gnutls_hash fn_gnutls_hash
+# define gnutls_hash_deinit fn_gnutls_hash_deinit
+# define gnutls_hash_output fn_gnutls_hash_output
+# endif /* HAVE_GNUTLS3 */
/* This wrapper is called from fns.c, which doesn't know about the
LOAD_DLL_FN stuff above. */
@@ -475,7 +467,7 @@ w32_gnutls_rnd (gnutls_rnd_level_t level, void *data,
size_t len)
return gnutls_rnd (level, data, len);
}
-#endif /* WINDOWSNT */
+# endif /* WINDOWSNT */
/* Report memory exhaustion if ERR is an out-of-memory indication. */
@@ -489,7 +481,7 @@ check_memory_full (int err)
memory_full (0);
}
-#ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
/* Log a simple audit message. */
static void
gnutls_audit_log_function (gnutls_session_t session, const char *string)
@@ -499,7 +491,7 @@ gnutls_audit_log_function (gnutls_session_t session, const
char *string)
message ("gnutls.c: [audit] %s", string);
}
}
-#endif
+# endif
/* Log a simple message. */
static void
@@ -552,7 +544,7 @@ gnutls_try_handshake (struct Lisp_Process *proc)
return ret;
}
-#ifndef WINDOWSNT
+# ifndef WINDOWSNT
static int
emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
{
@@ -560,13 +552,13 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
switch (err)
{
-# ifdef _AIX
+# ifdef _AIX
/* This is taken from the GnuTLS system_errno function circa 2016;
see <http://savannah.gnu.org/support/?107464>. */
case 0:
errno = EAGAIN;
/* Fall through. */
-# endif
+# endif
case EINPROGRESS:
case ENOTCONN:
return EAGAIN;
@@ -575,7 +567,7 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
return err;
}
}
-#endif /* !WINDOWSNT */
+# endif /* !WINDOWSNT */
static int
emacs_gnutls_handshake (struct Lisp_Process *proc)
@@ -587,7 +579,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
{
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
/* On W32 we cannot transfer socket handles between different runtime
libraries, so we tell GnuTLS to use our special push/pull
functions. */
@@ -596,7 +588,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
(gnutls_transport_ptr_t) proc);
gnutls_transport_set_push_function (state, &emacs_gnutls_push);
gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
-#else
+# else
/* This is how GnuTLS takes sockets: as file descriptors passed
in. For an Emacs process socket, infd and outfd are the
same but we use this two-argument version for clarity. */
@@ -606,7 +598,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
if (proc->is_non_blocking_client)
gnutls_transport_set_errno_function (state,
emacs_gnutls_nonblock_errno);
-#endif
+# endif
proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
}
@@ -620,13 +612,13 @@ emacs_gnutls_record_check_pending (gnutls_session_t state)
return gnutls_record_check_pending (state);
}
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
void
emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
{
gnutls_transport_set_errno (state, err);
}
-#endif
+# endif
ptrdiff_t
emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t
nbyte)
@@ -732,10 +724,10 @@ emacs_gnutls_handle_error (gnutls_session_t session, int
err)
/* Mostly ignore "The TLS connection was non-properly
terminated" message which just means that the peer closed the
connection. */
-#ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
if (err == GNUTLS_E_PREMATURE_TERMINATION)
level = 3;
-#endif
+# endif
GNUTLS_LOG2 (level, max_log_level, "fatal error:", str);
ret = false;
@@ -1300,7 +1292,7 @@ gnutls_ip_address_p (char *string)
return true;
}
-#if 0
+# if 0
/* Deinitialize global GnuTLS state.
See also `gnutls-global-init'. */
static Lisp_Object
@@ -1313,7 +1305,7 @@ emacs_gnutls_global_deinit (void)
return gnutls_make_error (GNUTLS_E_SUCCESS);
}
-#endif
+# endif
static void ATTRIBUTE_FORMAT_PRINTF (2, 3)
boot_error (struct Lisp_Process *p, const char *m, ...)
@@ -1585,9 +1577,9 @@ one trustfile (usually a CA bundle). */)
if (TYPE_RANGED_INTEGERP (int, loglevel))
{
gnutls_global_set_log_function (gnutls_log_function);
-#ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
gnutls_global_set_audit_log_function (gnutls_audit_log_function);
-#endif
+# endif
gnutls_global_set_log_level (XINT (loglevel));
max_log_level = XINT (loglevel);
XPROCESS (proc)->gnutls_log_level = max_log_level;
@@ -1649,8 +1641,7 @@ one trustfile (usually a CA bundle). */)
int file_format = GNUTLS_X509_FMT_PEM;
Lisp_Object tail;
-#if GNUTLS_VERSION_MAJOR + \
- (GNUTLS_VERSION_MINOR > 0 || GNUTLS_VERSION_PATCH >= 20) > 3
+# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
ret = gnutls_certificate_set_x509_system_trust (x509_cred);
if (ret < GNUTLS_E_SUCCESS)
{
@@ -1658,7 +1649,7 @@ one trustfile (usually a CA bundle). */)
GNUTLS_LOG2i (4, max_log_level,
"setting system trust failed with code ", ret);
}
-#endif
+# endif
for (tail = trustfiles; CONSP (tail); tail = XCDR (tail))
{
@@ -1668,12 +1659,12 @@ one trustfile (usually a CA bundle). */)
GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
SSDATA (trustfile));
trustfile = ENCODE_FILE (trustfile);
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
/* Since GnuTLS doesn't support UTF-8 or UTF-16 encoded
file names on Windows, we need to re-encode the file
name using the current ANSI codepage. */
trustfile = ansi_encode_filename (trustfile);
-#endif
+# endif
ret = gnutls_certificate_set_x509_trust_file
(x509_cred,
SSDATA (trustfile),
@@ -1698,9 +1689,9 @@ one trustfile (usually a CA bundle). */)
GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
SSDATA (crlfile));
crlfile = ENCODE_FILE (crlfile);
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
crlfile = ansi_encode_filename (crlfile);
-#endif
+# endif
ret = gnutls_certificate_set_x509_crl_file
(x509_cred, SSDATA (crlfile), file_format);
@@ -1727,10 +1718,10 @@ one trustfile (usually a CA bundle). */)
SSDATA (certfile));
keyfile = ENCODE_FILE (keyfile);
certfile = ENCODE_FILE (certfile);
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
keyfile = ansi_encode_filename (keyfile);
certfile = ansi_encode_filename (certfile);
-#endif
+# endif
ret = gnutls_certificate_set_x509_key_file
(x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
@@ -1755,10 +1746,10 @@ one trustfile (usually a CA bundle). */)
GNUTLS_LOG (1, max_log_level, "gnutls_init");
int gnutls_flags = GNUTLS_CLIENT;
-#ifdef GNUTLS_NONBLOCK
+# ifdef GNUTLS_NONBLOCK
if (XPROCESS (proc)->is_non_blocking_client)
gnutls_flags |= GNUTLS_NONBLOCK;
-#endif
+# endif
ret = gnutls_init (&state, gnutls_flags);
XPROCESS (proc)->gnutls_state = state;
if (ret < GNUTLS_E_SUCCESS)
@@ -1852,7 +1843,6 @@ The alist key is the cipher name. */)
{
Lisp_Object ciphers = Qnil;
-#ifdef HAVE_GNUTLS3_CIPHER
const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list ();
for (ptrdiff_t pos = 0; gciphers[pos] != 0; pos++)
{
@@ -1886,7 +1876,6 @@ The alist key is the cipher name. */)
ciphers = Fcons (cp, ciphers);
}
-#endif
return ciphers;
}
@@ -1899,7 +1888,7 @@ gnutls_symmetric_aead (bool encrypting,
gnutls_cipher_algorithm_t gca,
const char *idata, ptrdiff_t isize,
Lisp_Object aead_auth)
{
-#ifdef HAVE_GNUTLS3_AEAD
+# ifdef HAVE_GNUTLS_AEAD
const char *desc = encrypting ? "encrypt" : "decrypt";
Lisp_Object actual_iv = make_unibyte_string (vdata, vsize);
@@ -1969,10 +1958,10 @@ gnutls_symmetric_aead (bool encrypting,
gnutls_cipher_algorithm_t gca,
SAFE_FREE ();
return list2 (output, actual_iv);
-#else
+# else
printmax_t print_gca = gca;
error ("GnuTLS AEAD cipher %"pMd" is invalid or not found", print_gca);
-#endif
+# endif
}
static Lisp_Object
@@ -2181,7 +2170,6 @@ name. */)
(void)
{
Lisp_Object mac_algorithms = Qnil;
-#ifdef HAVE_GNUTLS3_HMAC
const gnutls_mac_algorithm_t *macs = gnutls_mac_list ();
for (ptrdiff_t pos = 0; macs[pos] != 0; pos++)
{
@@ -2204,7 +2192,6 @@ name. */)
make_number (gnutls_mac_get_nonce_size (gma)));
mac_algorithms = Fcons (mp, mac_algorithms);
}
-#endif
return mac_algorithms;
}
@@ -2218,7 +2205,6 @@ method name. */)
(void)
{
Lisp_Object digest_algorithms = Qnil;
-#ifdef HAVE_GNUTLS3_DIGEST
const gnutls_digest_algorithm_t *digests = gnutls_digest_list ();
for (ptrdiff_t pos = 0; digests[pos] != 0; pos++)
{
@@ -2236,7 +2222,6 @@ method name. */)
digest_algorithms = Fcons (mp, digest_algorithms);
}
-#endif
return digest_algorithms;
}
@@ -2423,25 +2408,17 @@ GnuTLS AEAD ciphers : the list will contain
`AEAD-ciphers'. */)
# ifdef HAVE_GNUTLS3
capabilities = Fcons (intern("gnutls3"), capabilities);
-
-# ifdef HAVE_GNUTLS3_DIGEST
capabilities = Fcons (intern("digests"), capabilities);
-# endif
-
-# ifdef HAVE_GNUTLS3_CIPHER
capabilities = Fcons (intern("ciphers"), capabilities);
-# ifdef HAVE_GNUTLS3_AEAD
+# ifdef HAVE_GNUTLS_AEAD
capabilities = Fcons (intern("AEAD-ciphers"), capabilities);
-# endif
+# endif
-# ifdef HAVE_GNUTLS3_HMAC
capabilities = Fcons (intern("macs"), capabilities);
-# endif
-# endif /* HAVE_GNUTLS3_CIPHER */
# endif /* HAVE_GNUTLS3 */
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache);
if (CONSP (found))
return XCDR (found);
@@ -2452,15 +2429,10 @@ GnuTLS AEAD ciphers : the list will contain
`AEAD-ciphers'. */)
Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache);
return status;
}
-#else /* !WINDOWSNT */
+# endif /* WINDOWSNT */
+#endif /* HAVE_GNUTLS */
return capabilities;
-
-#endif /* WINDOWSNT */
-
-#else /* !HAVE_GNUTLS */
- return Qnil;
-#endif /* HAVE_GNUTLS */
}
void
diff --git a/src/gnutls.h b/src/gnutls.h
index 3ec86a8..9323cd1 100644
--- a/src/gnutls.h
+++ b/src/gnutls.h
@@ -23,8 +23,9 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include <gnutls/gnutls.h>
#include <gnutls/x509.h>
-#ifdef HAVE_GNUTLS3
-#include <gnutls/crypto.h>
+#if 0x030000 <= GNUTLS_VERSION_NUMBER
+# define HAVE_GNUTLS3
+# include <gnutls/crypto.h>
#endif
#include "lisp.h"
diff --git a/src/keyboard.c b/src/keyboard.c
index 804af85..97069a2 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -10168,7 +10168,8 @@ This may include sensitive information such as
passwords. */)
file = Fexpand_file_name (file, Qnil);
encfile = ENCODE_FILE (file);
fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
- if (fd < 0 && errno == EEXIST && unlink (SSDATA (encfile)) == 0)
+ if (fd < 0 && errno == EEXIST
+ && (unlink (SSDATA (encfile)) == 0 || errno == ENOENT))
fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
dribble = fd < 0 ? 0 : fdopen (fd, "w");
if (dribble == 0)
diff --git a/src/lisp.h b/src/lisp.h
index cffaf95..4de6fc8 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4298,13 +4298,15 @@ extern ptrdiff_t emacs_write (int, void const *,
ptrdiff_t);
extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t);
extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t);
extern void emacs_perror (char const *);
+extern int renameat_noreplace (int, char const *, int, char const *);
+extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-extern void unlock_all_files (void);
+/* Defined in filelock.c. */
extern void lock_file (Lisp_Object);
extern void unlock_file (Lisp_Object);
+extern void unlock_all_files (void);
extern void unlock_buffer (struct buffer *);
extern void syms_of_filelock (void);
-extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
/* Defined in sound.c. */
extern void syms_of_sound (void);
diff --git a/src/minibuf.c b/src/minibuf.c
index d4128ce..0101529 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -497,6 +497,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
Fcons (Vminibuffer_history_position,
Fcons (Vminibuffer_history_variable,
minibuf_save_list))))));
+ minibuf_save_list
+ = Fcons (Fthis_command_keys_vector (), minibuf_save_list);
record_unwind_protect_void (read_minibuf_unwind);
minibuf_level++;
@@ -836,6 +838,11 @@ read_minibuf_unwind (void)
Fset_buffer (XWINDOW (window)->contents);
/* Restore prompt, etc, from outer minibuffer level. */
+ Lisp_Object key_vec = Fcar (minibuf_save_list);
+ eassert (VECTORP (key_vec));
+ this_command_key_count = XFASTINT (Flength (key_vec));
+ this_command_keys = key_vec;
+ minibuf_save_list = Fcdr (minibuf_save_list);
minibuf_prompt = Fcar (minibuf_save_list);
minibuf_save_list = Fcdr (minibuf_save_list);
minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list));
diff --git a/src/regex.c b/src/regex.c
index fb48765..0dbb473 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -1942,7 +1942,7 @@ struct range_table_work_area
returned. If name is not a valid character class name zero, or RECC_ERROR,
is returned.
- Otherwise, if *strp doesn’t begin with "[:name:]", -1 is returned.
+ Otherwise, if *strp doesn't begin with "[:name:]", -1 is returned.
The function can be used on ASCII and multibyte (UTF-8-encoded) strings.
*/
@@ -1954,8 +1954,8 @@ re_wctype_parse (const unsigned char **strp, unsigned
limit)
if (limit < 4 || beg[0] != '[' || beg[1] != ':')
return -1;
- beg += 2; /* skip opening ‘[:’ */
- limit -= 3; /* opening ‘[:’ and half of closing ‘:]’; --limit handles rest
*/
+ beg += 2; /* skip opening "[:" */
+ limit -= 3; /* opening "[:" and half of closing ":]"; --limit handles rest
*/
for (it = beg; it[0] != ':' || it[1] != ']'; ++it)
if (!--limit)
return -1;
@@ -1985,7 +1985,7 @@ re_wctype_parse (const unsigned char **strp, unsigned
limit)
2 [:cntrl:]
1 [:ff:]
- If you update this list, consider also updating chain of or’ed conditions
+ If you update this list, consider also updating chain of or'ed conditions
in execute_charset function.
*/
diff --git a/src/regex.h b/src/regex.h
index 1d439de..5e3a797 100644
--- a/src/regex.h
+++ b/src/regex.h
@@ -21,7 +21,7 @@
#define _REGEX_H 1
#if defined emacs && (defined _REGEX_RE_COMP || defined _LIBC)
-/* We’re not defining re_set_syntax and using a different prototype of
+/* We're not defining re_set_syntax and using a different prototype of
re_compile_pattern when building Emacs so fail compilation early with
a (somewhat helpful) error message when conflict is detected. */
# error "_REGEX_RE_COMP nor _LIBC can be defined if emacs is defined."
diff --git a/src/sysdep.c b/src/sysdep.c
index db99f53..9eb73322 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -37,6 +37,11 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include "sysselect.h"
#include "blockinput.h"
+#ifdef HAVE_LINUX_FS_H
+# include <linux/fs.h>
+# include <sys/syscall.h>
+#endif
+
#if defined DARWIN_OS || defined __FreeBSD__
# include <sys/sysctl.h>
#endif
@@ -2678,6 +2683,21 @@ set_file_times (int fd, const char *filename,
timespec[1] = mtime;
return fdutimens (fd, filename, timespec);
}
+
+/* Rename directory SRCFD's entry SRC to directory DSTFD's entry DST.
+ This is like renameat except that it fails if DST already exists,
+ or if this operation is not supported atomically. Return 0 if
+ successful, -1 (setting errno) otherwise. */
+int
+renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst)
+{
+#if defined SYS_renameat2 && defined RENAME_NOREPLACE
+ return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE);
+#else
+ errno = ENOSYS;
+ return -1;
+#endif
+}
/* Like strsignal, except async-signal-safe, and this function typically
returns a string in the C locale rather than the current locale. */
diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el
index 2634777..9753029 100644
--- a/test/lisp/auth-source-tests.el
+++ b/test/lisp/auth-source-tests.el
@@ -215,7 +215,7 @@
(ert-deftest auth-source-test-remembrances-of-things-past ()
(let ((password-cache t)
- (password-data (make-vector 7 0)))
+ (password-data (copy-hash-table password-data)))
(auth-source-remember '(:host "wedd") '(4 5 6))
(should (auth-source-remembered-p '(:host "wedd")))
(should-not (auth-source-remembered-p '(:host "xedd")))
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 6933145..981afdd 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -21,7 +21,6 @@
(require 'ert)
(require 'dired)
(require 'nadvice)
-(require 'ls-lisp)
(ert-deftest dired-autoload ()
"Tests to see whether dired-x has been autoloaded"
@@ -55,10 +54,20 @@
(when (buffer-live-p buf) (kill-buffer buf)))
(delete-directory dir 'recursive))))
+(defvar dired-dwim-target)
(ert-deftest dired-test-bug25609 ()
"Test for http://debbugs.gnu.org/25609 ."
(let* ((from (make-temp-file "foo" 'dir))
+ ;; Make sure we have long file-names in 'from' and 'to', not
+ ;; their 8+3 short aliases, because the latter will confuse
+ ;; Dired commands invoked below.
+ (from (if (memq system-type '(ms-dos windows-nt))
+ (file-truename from)
+ from))
(to (make-temp-file "bar" 'dir))
+ (to (if (memq system-type '(ms-dos windows-nt))
+ (file-truename to)
+ to))
(target (expand-file-name (file-name-nondirectory from) to))
(nested (expand-file-name (file-name-nondirectory from) target))
(dired-dwim-target t)
@@ -68,20 +77,30 @@
:override
(lambda (_sym _prompt &rest _args) (setq dired-query t))
'((name . "advice-dired-query")))
- (advice-add 'completing-read ; Just return init.
+ (advice-add 'completing-read ; Don't prompt me: just return init.
:override
(lambda (_prompt _coll &optional _pred _match init _hist _def
_inherit _keymap)
init)
'((name . "advice-completing-read")))
+ (delete-other-windows) ; We don't want to display any other dired buffers.
(push (dired to) buffers)
(push (dired-other-window temporary-file-directory) buffers)
- (dired-goto-file from)
- (dired-do-copy)
- (dired-do-copy); Again.
(unwind-protect
- (progn
- (should (file-exists-p target))
- (should-not (file-exists-p nested)))
+ (let ((ok-fn
+ (lambda ()
+ (let ((win-buffers (mapcar #'window-buffer (window-list))))
+ (and (memq (car buffers) win-buffers)
+ (memq (cadr buffers) win-buffers))))))
+ (dired-goto-file from)
+ ;; Right before `dired-do-copy' call, to reproduce the bug conditions,
+ ;; ensure we have windows displaying the two dired buffers.
+ (and (funcall ok-fn) (dired-do-copy))
+ ;; Call `dired-do-copy' again: this must overwrite `target'; if the
bug
+ ;; still exists, then it creates `nested' instead.
+ (when (funcall ok-fn)
+ (dired-do-copy)
+ (should (file-exists-p target))
+ (should-not (file-exists-p nested))))
(dolist (buf buffers)
(when (buffer-live-p buf) (kill-buffer buf)))
(delete-directory from 'recursive)
@@ -89,10 +108,94 @@
(advice-remove 'dired-query "advice-dired-query")
(advice-remove 'completing-read "advice-completing-read"))))
-(ert-deftest dired-test-bug27243 ()
- "Test for http://debbugs.gnu.org/27243 ."
+;; (ert-deftest dired-test-bug27243 ()
+;; "Test for http://debbugs.gnu.org/27243 ."
+;; (let ((test-dir (make-temp-file "test-dir-" t))
+;; (dired-auto-revert-buffer t) buffers)
+;; (with-current-buffer (find-file-noselect test-dir)
+;; (make-directory "test-subdir"))
+;; (push (dired test-dir) buffers)
+;; (unwind-protect
+;; (let ((buf (current-buffer))
+;; (pt1 (point))
+;; (test-file (concat (file-name-as-directory "test-subdir")
+;; "test-file")))
+;; (write-region "Test" nil test-file nil 'silent nil 'excl)
+;; ;; Sanity check: point should now be on the subdirectory.
+;; (should (equal (dired-file-name-at-point)
+;; (concat (file-name-as-directory test-dir)
+;; (file-name-as-directory "test-subdir"))))
+;; (push (dired-find-file) buffers)
+;; (let ((pt2 (point))) ; Point is on test-file.
+;; (switch-to-buffer buf)
+;; ;; Sanity check: point should now be back on the subdirectory.
+;; (should (eq (point) pt1))
+;; ;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5
+;; (push (dired-find-file) buffers)
+;; (should (eq (point) pt2))
+;; ;; Case 2:
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28
+;; (push (dired test-dir) buffers)
+;; (should (eq (point) pt1))))
+;; (dolist (buf buffers)
+;; (when (buffer-live-p buf) (kill-buffer buf)))
+;; (delete-directory test-dir t))))
+
+(ert-deftest dired-test-bug27243-01 ()
+ "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 ."
+ (let* ((test-dir (file-name-as-directory (make-temp-file "test-dir-" t)))
+ (save-pos (lambda ()
+ (with-current-buffer (car (dired-buffers-for-dir
test-dir))
+ (dired-save-positions))))
+ (dired-auto-revert-buffer t) buffers)
+ ;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
+ ;; corresponding long file names exist, otherwise such names trip
+ ;; dired-buffers-for-dir.
+ (if (eq system-type 'windows-nt)
+ (setq test-dir (file-truename test-dir)))
+ (should-not (dired-buffers-for-dir test-dir))
+ (with-current-buffer (find-file-noselect test-dir)
+ (make-directory "test-subdir"))
+ (message "Saved pos: %S" (funcall save-pos))
+ ;; Point must be at end-of-buffer.
+ (with-current-buffer (car (dired-buffers-for-dir test-dir))
+ (should (eobp)))
+ (push (dired test-dir) buffers)
+ (message "Saved pos: %S" (funcall save-pos))
+ ;; Previous dired call shouldn't create a new buffer: must visit the one
+ ;; created by `find-file-noselect' above.
+ (should (eq 1 (length (dired-buffers-for-dir test-dir))))
+ (unwind-protect
+ (let ((buf (current-buffer))
+ (pt1 (point))
+ (test-file (concat (file-name-as-directory "test-subdir")
+ "test-file")))
+ (message "Saved pos: %S" (funcall save-pos))
+ (write-region "Test" nil test-file nil 'silent nil 'excl)
+ (message "Saved pos: %S" (funcall save-pos))
+ ;; Sanity check: point should now be on the subdirectory.
+ (should (equal (dired-file-name-at-point)
+ (concat test-dir (file-name-as-directory
"test-subdir"))))
+ (message "Saved pos: %S" (funcall save-pos))
+ (push (dired-find-file) buffers)
+ (let ((pt2 (point))) ; Point is on test-file.
+ (pop-to-buffer-same-window buf)
+ ;; Sanity check: point should now be back on the subdirectory.
+ (should (eq (point) pt1))
+ (push (dired-find-file) buffers)
+ (should (eq (point) pt2))))
+ (dolist (buf buffers)
+ (when (buffer-live-p buf) (kill-buffer buf)))
+ (delete-directory test-dir t))))
+
+(ert-deftest dired-test-bug27243-02 ()
+ "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 ."
(let ((test-dir (make-temp-file "test-dir-" t))
(dired-auto-revert-buffer t) buffers)
+ ;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
+ ;; corresponding long file names exist, otherwise such names trip
+ ;; string comparisons below.
+ (if (eq system-type 'windows-nt)
+ (setq test-dir (file-truename test-dir)))
(with-current-buffer (find-file-noselect test-dir)
(make-directory "test-subdir"))
(push (dired test-dir) buffers)
@@ -111,30 +214,44 @@
(switch-to-buffer buf)
;; Sanity check: point should now be back on the subdirectory.
(should (eq (point) pt1))
- ;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5
- (push (dired-find-file) buffers)
- (should (eq (point) pt2))
- ;; Case 2: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28
(push (dired test-dir) buffers)
(should (eq (point) pt1))))
(dolist (buf buffers)
(when (buffer-live-p buf) (kill-buffer buf)))
(delete-directory test-dir t))))
-(ert-deftest dired-test-bug27693 ()
- "Test for http://debbugs.gnu.org/27693 ."
- (let ((dir (expand-file-name "lisp" source-directory))
- (size "")
- ls-lisp-use-insert-directory-program buf)
+(ert-deftest dired-test-bug27243-03 ()
+ "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#61 ."
+ (let ((test-dir (make-temp-file "test-dir-" t))
+ (dired-auto-revert-buffer t)
+ test-subdir1 test-subdir2 allbufs)
(unwind-protect
(progn
- (setq buf (dired (list dir "simple.el" "subr.el"))
- size (number-to-string
- (file-attribute-size
- (file-attributes (dired-get-filename)))))
- (search-backward-regexp size nil t)
- (should (looking-back "[[:space:]]" (1- (point)))))
- (when (buffer-live-p buf) (kill-buffer buf)))))
+ (with-current-buffer (find-file-noselect test-dir)
+ (push (current-buffer) allbufs)
+ (make-directory "test-subdir1")
+ (make-directory "test-subdir2")
+ (let ((test-file1 "test-file1")
+ (test-file2 "test-file2"))
+ (with-current-buffer (find-file-noselect "test-subdir1")
+ (push (current-buffer) allbufs)
+ (write-region "Test1" nil test-file1 nil 'silent nil 'excl))
+ (with-current-buffer (find-file-noselect "test-subdir2")
+ (push (current-buffer) allbufs)
+ (write-region "Test2" nil test-file2 nil 'silent nil 'excl))))
+ ;; Call find-file with a wild card and test point in each file.
+ (let ((buffers (find-file (concat (file-name-as-directory test-dir)
+ "*")
+ t)))
+ (dolist (buf buffers)
+ (let ((pt (with-current-buffer buf (point))))
+ (switch-to-buffer (find-file-noselect test-dir))
+ (find-file (buffer-name buf))
+ (should (equal (point) pt))))
+ (append buffers allbufs)))
+ (dolist (buf allbufs)
+ (when (buffer-live-p buf) (kill-buffer buf)))
+ (delete-directory test-dir t))))
(ert-deftest dired-test-bug7131 ()
"Test for http://debbugs.gnu.org/7131 ."
@@ -152,28 +269,94 @@
(should (cdr (dired-get-marked-files))))
(when (buffer-live-p buf) (kill-buffer buf)))))
-(ert-deftest dired-test-bug27762 ()
- "Test for http://debbugs.gnu.org/27762 ."
- :expected-result :failed
- (let* ((dir source-directory)
+(ert-deftest dired-test-bug27631 ()
+ "Test for http://debbugs.gnu.org/27631 ."
+ ;; For dired using 'ls' emulation we test for this bug in
+ ;; ls-lisp-tests.el and em-ls-tests.el.
+ (skip-unless (and (not (featurep 'ls-lisp))
+ (not (featurep 'eshell))))
+ (let* ((dir (make-temp-file "bug27631" 'dir))
+ (dir1 (expand-file-name "dir1" dir))
+ (dir2 (expand-file-name "dir2" dir))
(default-directory dir)
- (files (mapcar (lambda (f) (concat "src/" f))
- (directory-files
- (expand-file-name "src") nil "\\.*\\.c\\'")))
- ls-lisp-use-insert-directory-program buf)
+ buf)
(unwind-protect
- (let ((file1 "src/cygw32.c")
- (file2 "src/atimer.c"))
- (setq buf (dired (nconc (list dir) files)))
- (dired-goto-file (expand-file-name file2 default-directory))
- (should-not (looking-at "^ -")) ; Must be 2 spaces not 3.
- (setq files (cons file1 (delete file1 files)))
- (kill-buffer buf)
- (setq buf (dired (nconc (list dir) files)))
- (should (looking-at "src"))
- (next-line) ; File names must be aligned.
- (should (looking-at "src")))
+ (progn
+ (make-directory dir1)
+ (make-directory dir2)
+ (with-temp-file (expand-file-name "a.txt" dir1))
+ (with-temp-file (expand-file-name "b.txt" dir2))
+ (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
+ (dired-toggle-marks)
+ (should (cdr (dired-get-marked-files))))
+ (delete-directory dir 'recursive)
(when (buffer-live-p buf) (kill-buffer buf)))))
+(ert-deftest dired-test-bug27899 ()
+ "Test for http://debbugs.gnu.org/27899 ."
+ (let* ((dir (expand-file-name "src" source-directory))
+ (buf (dired (list dir "cygw32.c" "alloc.c" "w32xfns.c" "xdisp.c")))
+ (orig dired-hide-details-mode))
+ (dired-goto-file (expand-file-name "cygw32.c"))
+ (forward-line 0)
+ (unwind-protect
+ (progn
+ (let ((inhibit-read-only t))
+ (dired-align-file (point) (point-max)))
+ (dired-hide-details-mode t)
+ (dired-move-to-filename)
+ (should (eq 2 (current-column))))
+ (dired-hide-details-mode orig))))
+
+(ert-deftest dired-test-bug27968 ()
+ "Test for http://debbugs.gnu.org/27968 ."
+ (let* ((top-dir (make-temp-file "top-dir" t))
+ (subdir (expand-file-name "subdir" top-dir))
+ (header-len-fn (lambda ()
+ (save-excursion
+ (goto-char 1)
+ (forward-line 1)
+ (- (point-at-eol) (point)))))
+ orig-len len diff pos line-nb)
+ (make-directory subdir 'parents)
+ (unwind-protect
+ (with-current-buffer (dired-noselect subdir)
+ (setq orig-len (funcall header-len-fn)
+ pos (point)
+ line-nb (line-number-at-pos))
+ ;; Bug arises when the header line changes its length; this may
+ ;; happen if the used space has changed: for instance, with the
+ ;; creation of additional files.
+ (make-directory "subdir" t)
+ (dired-revert)
+ ;; Change the header line.
+ (save-excursion
+ (goto-char 1)
+ (forward-line 1)
+ (let ((inhibit-read-only t)
+ (new-header " test-bug27968"))
+ (delete-region (point) (point-at-eol))
+ (when (= orig-len (length new-header))
+ ;; Wow lucky guy! I must buy lottery today.
+ (setq new-header (concat new-header " :-)")))
+ (insert new-header)))
+ (setq len (funcall header-len-fn)
+ diff (- len orig-len))
+ (should-not (zerop diff)) ; Header length has changed.
+ ;; If diff > 0, then the point moves back.
+ ;; If diff < 0, then the point moves forward.
+ ;; If diff = 0, then the point doesn't move.
+ ;; Sometimes this point movement causes
+ ;; line-nb != (line-number-at-pos pos), so that we get
+ ;; an unexpected file at point if we store buffer points.
+ ;; Note that the line number before/after revert
+ ;; doesn't change.
+ (should (= line-nb
+ (line-number-at-pos)
+ (line-number-at-pos (+ pos diff))))
+ ;; After revert, the point must be in 'subdir' line.
+ (should (equal "subdir" (dired-get-filename 'local t))))
+ (delete-directory top-dir t))))
+
(provide 'dired-tests)
;; dired-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el
b/test/lisp/emacs-lisp/cl-generic-tests.el
index 0768e31..31f6541 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -219,5 +219,29 @@
(should (equal (cl--generic-1 '(5) nil) '("cinq" (5))))
(should (equal (cl--generic-1 '(6) nil) '("six" a))))
+(cl-defgeneric cl-generic-tests--generic (x))
+(cl-defmethod cl-generic-tests--generic ((x string))
+ (message "%s is a string" x))
+(cl-defmethod cl-generic-tests--generic ((x integer))
+ (message "%s is a number" x))
+(cl-defgeneric cl-generic-tests--generic-without-methods (x y))
+(defvar cl-generic-tests--this-file
+ (file-truename (or load-file-name buffer-file-name)))
+
+(ert-deftest cl-generic-tests--method-files--finds-methods ()
+ "`method-files' returns a list of files and methods for a generic function."
+ (let ((retval (cl--generic-method-files 'cl-generic-tests--generic)))
+ (should (equal (length retval) 2))
+ (mapc (lambda (x)
+ (should (equal (car x) cl-generic-tests--this-file))
+ (should (equal (cadr x) 'cl-generic-tests--generic)))
+ retval)
+ (should-not (equal (nth 0 retval) (nth 1 retval)))))
+
+(ert-deftest cl-generic-tests--method-files--nonexistent-methods ()
+ "`method-files' returns nil if asked to find a method which doesn't exist."
+ (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic))
+ (should-not (cl--generic-method-files
'cl-generic-tests--generic-without-methods)))
+
(provide 'cl-generic-tests)
;;; cl-generic-tests.el ends here
diff --git a/test/lisp/emacs-lisp/ert-tests.el
b/test/lisp/emacs-lisp/ert-tests.el
index 317838b..57463ad 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -352,7 +352,7 @@ This macro is used to test if macroexpansion in `should'
works."
(let ((abc (ert-get-test 'ert-test-abc)))
(should (equal (ert-test-tags abc) '(bar)))
(should (equal (ert-test-documentation abc) "foo")))
- (should (equal (symbol-file 'ert-test-deftest 'ert-deftest)
+ (should (equal (symbol-file 'ert-test-deftest 'ert--test)
(symbol-file 'ert-test--which-file 'defun)))
(ert-deftest ert-test-def () :expected-result ':passed)
diff --git a/test/lisp/emacs-lisp/map-tests.el
b/test/lisp/emacs-lisp/map-tests.el
index 15b0655..fc0a6a5 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -64,9 +64,11 @@ Evaluate BODY for each created map.
(should (= 5 (map-elt map 7 5)))))
(ert-deftest test-map-elt-testfn ()
- (let ((map (list (cons "a" 1) (cons "b" 2))))
- (should-not (map-elt map "a"))
- (should (map-elt map "a" nil 'equal))))
+ (let ((map (list (cons "a" 1) (cons "b" 2)))
+ ;; Make sure to use a non-eq "a", even when compiled.
+ (noneq-key (string ?a)))
+ (should-not (map-elt map noneq-key))
+ (should (map-elt map noneq-key nil 'equal))))
(ert-deftest test-map-elt-with-nil-value ()
(should (null (map-elt '((a . 1)
@@ -100,10 +102,12 @@ Evaluate BODY for each created map.
'b))))
(ert-deftest test-map-put-testfn-alist ()
- (let ((alist (list (cons "a" 1) (cons "b" 2))))
- (map-put alist "a" 3 'equal)
+ (let ((alist (list (cons "a" 1) (cons "b" 2)))
+ ;; Make sure to use a non-eq "a", even when compiled.
+ (noneq-key (string ?a)))
+ (map-put alist noneq-key 3 'equal)
(should-not (cddr alist))
- (map-put alist "a" 9)
+ (map-put alist noneq-key 9)
(should (cddr alist))))
(ert-deftest test-map-put-return-value ()
diff --git a/test/lisp/eshell/em-ls-tests.el b/test/lisp/eshell/em-ls-tests.el
new file mode 100644
index 0000000..8e7b91d
--- /dev/null
+++ b/test/lisp/eshell/em-ls-tests.el
@@ -0,0 +1,98 @@
+;;; tests/em-ls-tests.el --- em-ls test suite
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Tino Calancha <address@hidden>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+
+;;; Code:
+
+(require 'ert)
+(require 'em-ls)
+
+(ert-deftest em-ls-test-bug27631 ()
+ "Test for http://debbugs.gnu.org/27631 ."
+ (let* ((dir (make-temp-file "bug27631" 'dir))
+ (dir1 (expand-file-name "dir1" dir))
+ (dir2 (expand-file-name "dir2" dir))
+ (default-directory dir)
+ (orig eshell-ls-use-in-dired)
+ buf)
+ (unwind-protect
+ (progn
+ (customize-set-value 'eshell-ls-use-in-dired t)
+ (make-directory dir1)
+ (make-directory dir2)
+ (with-temp-file (expand-file-name "a.txt" dir1))
+ (with-temp-file (expand-file-name "b.txt" dir2))
+ (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
+ (dired-toggle-marks)
+ (should (cdr (dired-get-marked-files))))
+ (customize-set-variable 'eshell-ls-use-in-dired orig)
+ (delete-directory dir 'recursive)
+ (when (buffer-live-p buf) (kill-buffer buf)))))
+
+(ert-deftest em-ls-test-bug27817 ()
+ "Test for http://debbugs.gnu.org/27817 ."
+ (let ((orig eshell-ls-use-in-dired)
+ (dired-use-ls-dired 'unspecified)
+ buf insert-directory-program)
+ (unwind-protect
+ (progn
+ (customize-set-variable 'eshell-ls-use-in-dired t)
+ (should (setq buf (dired source-directory))))
+ (customize-set-variable 'eshell-ls-use-in-dired orig)
+ (and (buffer-live-p buf) (kill-buffer)))))
+
+(ert-deftest em-ls-test-bug27843 ()
+ "Test for http://debbugs.gnu.org/27843 ."
+ (let ((orig eshell-ls-use-in-dired)
+ (dired-use-ls-dired 'unspecified)
+ buf insert-directory-program)
+ (unwind-protect
+ (progn
+ (customize-set-variable 'eshell-ls-use-in-dired t)
+ (setq buf (dired (list source-directory "lisp")))
+ (dired-toggle-marks)
+ (should-not (cdr (dired-get-marked-files))))
+ (customize-set-variable 'eshell-ls-use-in-dired orig)
+ (and (buffer-live-p buf) (kill-buffer)))))
+
+(ert-deftest em-ls-test-bug27844 ()
+ "Test for http://debbugs.gnu.org/27844 ."
+ (let ((orig eshell-ls-use-in-dired)
+ (dired-use-ls-dired 'unspecified)
+ buf insert-directory-program)
+ (unwind-protect
+ (progn
+ (customize-set-variable 'eshell-ls-use-in-dired t)
+ (setq buf (dired (expand-file-name "lisp/*.el" source-directory)))
+ (dired-toggle-marks)
+ (should (cdr (dired-get-marked-files)))
+ (kill-buffer buf)
+ (setq buf (dired (expand-file-name "lisp/subr.el" source-directory)))
+ (should (looking-at "subr\\.el")))
+ (customize-set-variable 'eshell-ls-use-in-dired orig)
+ (and (buffer-live-p buf) (kill-buffer)))))
+
+
+(provide 'em-ls-test)
+
+;;; em-ls-tests.el ends here
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 4583b1a..7bfdca5 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -247,10 +247,11 @@ be $HOME."
(ert-deftest files-tests--file-name-non-special--subprocess ()
"Check that Bug#25949 is fixed."
(skip-unless (executable-find "true"))
- (should (eq (let ((default-directory "/:/")) (process-file "true")) 0))
- (should (processp (let ((default-directory "/:/"))
- (start-file-process "foo" nil "true"))))
- (should (eq (let ((default-directory "/:/")) (shell-command "true")) 0)))
+ (let ((defdir (if (memq system-type '(ms-dos windows-nt)) "/:c:/" "/:/")))
+ (should (eq (let ((default-directory defdir)) (process-file "true")) 0))
+ (should (processp (let ((default-directory defdir))
+ (start-file-process "foo" nil "true"))))
+ (should (eq (let ((default-directory defdir)) (shell-command "true")) 0))))
(defmacro files-tests--with-advice (symbol where function &rest body)
(declare (indent 3))
@@ -313,5 +314,23 @@ be invoked with the right arguments."
`((verify-visited-file-modtime ,buffer-visiting-file)
(verify-visited-file-modtime nil))))))))
+(ert-deftest files-tests--insert-directory-wildcard-in-dir-p ()
+ (let ((alist (list (cons "/home/user/*/.txt" (cons "/home/user/" "*/.txt"))
+ (cons "/home/user/.txt" nil)
+ (cons "/home/*/.txt" (cons "/home/" "*/.txt"))
+ (cons "/home/*/" (cons "/home/" "*/"))
+ (cons "/*/.txt" (cons "/" "*/.txt"))
+ ;;
+ (cons "c:/tmp/*/*.txt" (cons "c:/tmp/" "*/*.txt"))
+ (cons "c:/tmp/*.txt" nil)
+ (cons "c:/tmp/*/" (cons "c:/tmp/" "*/"))
+ (cons "c:/*/*.txt" (cons "c:/" "*/*.txt")))))
+ (dolist (path-res alist)
+ (should
+ (equal
+ (cdr path-res)
+ (insert-directory-wildcard-in-dir-p (car path-res)))))))
+
+
(provide 'files-tests)
;;; files-tests.el ends here
diff --git a/test/lisp/ls-lisp-tests.el b/test/lisp/ls-lisp-tests.el
new file mode 100644
index 0000000..d24b30e
--- /dev/null
+++ b/test/lisp/ls-lisp-tests.el
@@ -0,0 +1,94 @@
+;;; ls-lisp-tests.el --- tests for ls-lisp.el -*- lexical-binding: t-*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Tino Calacha <address@hidden>
+;; Keywords:
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+
+;;; Code:
+(require 'ert)
+(require 'ls-lisp)
+
+(ert-deftest ls-lisp-unload ()
+ "Test for http://debbugs.gnu.org/xxxxx ."
+ (should (advice-member-p 'ls-lisp--insert-directory 'insert-directory))
+ (unload-feature 'ls-lisp 'force)
+ (should-not (advice-member-p 'ls-lisp--insert-directory 'insert-directory))
+ (require 'ls-lisp))
+
+(ert-deftest ls-lisp-test-bug27762 ()
+ "Test for http://debbugs.gnu.org/27762 ."
+ (let* ((dir source-directory)
+ (default-directory dir)
+ (files (mapcar (lambda (f) (concat "src/" f))
+ (directory-files
+ (expand-file-name "src") nil "\\.*\\.c\\'")))
+ ls-lisp-use-insert-directory-program buf)
+ (unwind-protect
+ (let ((file1 "src/cygw32.c")
+ (file2 "src/atimer.c"))
+ (setq buf (dired (nconc (list dir) files)))
+ (dired-goto-file (expand-file-name file2 default-directory))
+ (should-not (looking-at "^ -")) ; Must be 2 spaces not 3.
+ (setq files (cons file1 (delete file1 files)))
+ (kill-buffer buf)
+ (setq buf (dired (nconc (list dir) files)))
+ (should (looking-at "src"))
+ (next-line) ; File names must be aligned.
+ (should (looking-at "src")))
+ (when (buffer-live-p buf) (kill-buffer buf)))))
+
+(ert-deftest ls-lisp-test-bug27631 ()
+ "Test for http://debbugs.gnu.org/27631 ."
+ (let* ((dir (make-temp-file "bug27631" 'dir))
+ (dir1 (expand-file-name "dir1" dir))
+ (dir2 (expand-file-name "dir2" dir))
+ (default-directory dir)
+ ls-lisp-use-insert-directory-program buf)
+ (unwind-protect
+ (progn
+ (make-directory dir1)
+ (make-directory dir2)
+ (with-temp-file (expand-file-name "a.txt" dir1))
+ (with-temp-file (expand-file-name "b.txt" dir2))
+ (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
+ (dired-toggle-marks)
+ (should (cdr (dired-get-marked-files))))
+ (delete-directory dir 'recursive)
+ (when (buffer-live-p buf) (kill-buffer buf)))))
+
+(ert-deftest ls-lisp-test-bug27693 ()
+ "Test for http://debbugs.gnu.org/27693 ."
+ (let ((dir (expand-file-name "lisp" source-directory))
+ (size "")
+ ls-lisp-use-insert-directory-program buf)
+ (unwind-protect
+ (progn
+ (setq buf (dired (list dir "simple.el" "subr.el"))
+ size (number-to-string
+ (file-attribute-size
+ (file-attributes (dired-get-filename)))))
+ (search-backward-regexp size nil t)
+ (should (looking-back "[[:space:]]" (1- (point)))))
+ (when (buffer-live-p buf) (kill-buffer buf)))))
+
+(provide 'ls-lisp-tests)
+;;; ls-lisp-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index bb1bafa..50dfd6f 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -123,9 +123,10 @@ being the result.")
(cdr tramp--test-enabled-checked))
(defun tramp--test-make-temp-name (&optional local quoted)
- "Create a temporary file name for test.
-If LOCAL is non-nil, a local file is created.
-If QUOTED is non-nil, the local part of the file is quoted."
+ "Return a temporary file name for test.
+If LOCAL is non-nil, a local file name is returned.
+If QUOTED is non-nil, the local part of the file name is quoted.
+The temporary file is not created."
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(expand-file-name
@@ -2201,6 +2202,110 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
+(ert-deftest tramp-test17-dired-with-wildcards ()
+ "Check `dired' with wildcards."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-sh-p))
+ ;; Since Emacs 26.1.
+ (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p))
+
+ (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
+ (let* ((tmp-name1
+ (expand-file-name (tramp--test-make-temp-name nil quoted)))
+ (tmp-name2
+ (expand-file-name (tramp--test-make-temp-name nil quoted)))
+ (tmp-name3 (expand-file-name "foo" tmp-name1))
+ (tmp-name4 (expand-file-name "bar" tmp-name2))
+ (tramp-test-temporary-file-directory
+ (funcall
+ (if quoted 'tramp-compat-file-name-quote 'identity)
+ tramp-test-temporary-file-directory))
+ buffer)
+ (unwind-protect
+ (progn
+ (make-directory tmp-name1)
+ (write-region "foo" nil tmp-name3)
+ (should (file-directory-p tmp-name1))
+ (should (file-exists-p tmp-name3))
+ (make-directory tmp-name2)
+ (write-region "foo" nil tmp-name4)
+ (should (file-directory-p tmp-name2))
+ (should (file-exists-p tmp-name4))
+
+ ;; Check for expanded directory names.
+ (with-current-buffer
+ (setq buffer
+ (dired-noselect
+ (expand-file-name
+ "tramp-test*" tramp-test-temporary-file-directory)))
+ (goto-char (point-min))
+ (should
+ (re-search-forward
+ (regexp-quote
+ (file-relative-name
+ tmp-name1 tramp-test-temporary-file-directory))))
+ (goto-char (point-min))
+ (should
+ (re-search-forward
+ (regexp-quote
+ (file-relative-name
+ tmp-name2 tramp-test-temporary-file-directory)))))
+ (kill-buffer buffer)
+
+ ;; Check for expanded directory and file names.
+ (with-current-buffer
+ (setq buffer
+ (dired-noselect
+ (expand-file-name
+ "tramp-test*/*" tramp-test-temporary-file-directory)))
+ (goto-char (point-min))
+ (should
+ (re-search-forward
+ (regexp-quote
+ (file-relative-name
+ tmp-name3 tramp-test-temporary-file-directory))))
+ (goto-char (point-min))
+ (should
+ (re-search-forward
+ (regexp-quote
+ (file-relative-name
+ tmp-name4
+ tramp-test-temporary-file-directory)))))
+ (kill-buffer buffer)
+
+ ;; Check for special characters.
+ (setq tmp-name3 (expand-file-name "*?" tmp-name1))
+ (setq tmp-name4 (expand-file-name "[a-z0-9]" tmp-name2))
+ (write-region "foo" nil tmp-name3)
+ (should (file-exists-p tmp-name3))
+ (write-region "foo" nil tmp-name4)
+ (should (file-exists-p tmp-name4))
+
+ (with-current-buffer
+ (setq buffer
+ (dired-noselect
+ (expand-file-name
+ "tramp-test*/*" tramp-test-temporary-file-directory)))
+ (goto-char (point-min))
+ (should
+ (re-search-forward
+ (regexp-quote
+ (file-relative-name
+ tmp-name3 tramp-test-temporary-file-directory))))
+ (goto-char (point-min))
+ (should
+ (re-search-forward
+ (regexp-quote
+ (file-relative-name
+ tmp-name4
+ tramp-test-temporary-file-directory)))))
+ (kill-buffer buffer))
+
+ ;; Cleanup.
+ (ignore-errors (kill-buffer buffer))
+ (ignore-errors (delete-directory tmp-name1 'recursive))
+ (ignore-errors (delete-directory tmp-name2 'recursive))))))
+
(ert-deftest tramp-test18-file-attributes ()
"Check `file-attributes'.
This tests also `file-readable-p', `file-regular-p' and
@@ -3005,6 +3110,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
+ ;; Since Emacs 26.1.
(skip-unless (and (fboundp 'connection-local-set-profile-variables)
(fboundp 'connection-local-set-profiles)))
@@ -3214,6 +3320,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(ert-deftest tramp-test33-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless (tramp--test-enabled))
+ ;; Since Emacs 26.1.
(skip-unless
(and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
@@ -3680,6 +3787,10 @@ Use the `ls' command."
tramp-connection-properties)))
(tramp--test-utf8)))
+(defun tramp--test-timeout-handler ()
+ (interactive)
+ (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
+
;; This test is inspired by Bug#16928.
(ert-deftest tramp-test36-asynchronous-requests ()
"Check parallel asynchronous requests.
@@ -3689,10 +3800,16 @@ process sentinels. They shall not disturb each other."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
- ;; This test could be blocked on hydra.
- (with-timeout
- (300 (ert-fail "`tramp-test36-asynchronous-requests' timed out"))
- (let* ((tmp-name (tramp--test-make-temp-name))
+ ;; This test could be blocked on hydra. So we set a timeout of 300
+ ;; seconds, and we send a SIGUSR1 signal after 300 seconds.
+ (with-timeout (300 (tramp--test-timeout-handler))
+ (define-key special-event-map [sigusr1] 'tramp--test-timeout-handler)
+ (tramp--test-instrument-test-case (if (getenv "EMACS_HYDRA_CI") 10 0)
+ (let* ((watchdog
+ (start-process
+ "*watchdog*" nil shell-file-name shell-command-switch
+ (format "sleep 300; kill -USR1 %d" (emacs-pid))))
+ (tmp-name (tramp--test-make-temp-name))
(default-directory tmp-name)
;; Do not cache Tramp properties.
(remote-file-name-inhibit-cache t)
@@ -3791,25 +3908,18 @@ process sentinels. They shall not disturb each other."
(count (process-get proc 'bar)))
(tramp--test-message
"Start action %d %s %s" count buf (current-time-string))
- ;; Regular operation.
+ ;; Regular operation prior process action.
(if (= count 0)
(should-not (file-attributes file))
(should (file-attributes file)))
;; Send string to process.
- (tramp--test-message
- "Trace 1 action %d %s %s" count buf (current-time-string))
(process-send-string proc (format "%s\n" (buffer-name buf)))
- (tramp--test-message
- "Trace 2 action %d %s %s" count buf (current-time-string))
(accept-process-output proc 0.1 nil 0)
- ;; Regular operation.
- (tramp--test-message
- "Trace 3 action %d %s %s" count buf (current-time-string))
+ ;; Give the watchdog a chance.
+ (read-event nil nil 0.01)
+ ;; Regular operation post process action.
(if (= count 2)
- (if (= (length buffers) 1)
- (tramp--test-instrument-test-case 10
- (should-not (file-attributes file)))
- (should-not (file-attributes file)))
+ (should-not (file-attributes file))
(should (file-attributes file)))
(tramp--test-message
"Stop action %d %s %s" count buf (current-time-string))
@@ -3820,8 +3930,7 @@ process sentinels. They shall not disturb each other."
;; Checks. All process output shall exists in the
;; respective buffers. All created files shall be
;; deleted.
- (tramp--test-message
- "Check %s" (current-time-string))
+ (tramp--test-message "Check %s" (current-time-string))
(dolist (buf buffers)
(with-current-buffer buf
(should (string-equal (format "%s\n" buf) (buffer-string)))))
@@ -3830,11 +3939,13 @@ process sentinels. They shall not disturb each other."
tmp-name nil directory-files-no-dot-files-regexp)))
;; Cleanup.
+ (define-key special-event-map [sigusr1] 'ignore)
+ (ignore-errors (quit-process watchdog))
(dolist (buf buffers)
(ignore-errors (delete-process (get-buffer-process buf)))
(ignore-errors (kill-buffer buf)))
(ignore-errors (cancel-timer timer))
- (ignore-errors (delete-directory tmp-name 'recursive))))))
+ (ignore-errors (delete-directory tmp-name 'recursive)))))))
(ert-deftest tramp-test37-recursive-load ()
"Check that Tramp does not fail due to recursive load."
@@ -3911,8 +4022,8 @@ Since it unloads Tramp, it shall be the last test to run."
(should-not (cl--find-class 'tramp-file-name))
(mapatoms
(lambda (x)
- (and (string-match "tramp-file-name" (symbol-name x))
- (functionp x)
+ (and (functionp x)
+ (string-match "tramp-file-name" (symbol-name x))
(ert-fail (format "Structure function `%s' still exists" x)))))
;; There shouldn't be left a hook function containing a Tramp
;; function. We do not regard the Tramp unload hooks.
diff --git a/test/lisp/register-tests.el b/test/lisp/register-tests.el
new file mode 100644
index 0000000..0425bc0
--- /dev/null
+++ b/test/lisp/register-tests.el
@@ -0,0 +1,43 @@
+;;; register-tests.el --- tests for register.el -*- lexical-binding: t-*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Tino Calacha <address@hidden>
+;; Keywords:
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+
+;;; Code:
+(require 'ert)
+(require 'cl-lib)
+
+(ert-deftest register-test-bug27634 ()
+ "Test for http://debbugs.gnu.org/27634 ."
+ (dolist (event (list ?\C-g 'escape ?\C-\[))
+ (cl-letf (((symbol-function 'read-key) #'ignore)
+ (last-input-event event)
+ (register-alist nil))
+ (should (equal 'quit
+ (condition-case err
+ (call-interactively 'point-to-register)
+ (quit (car err)))))
+ (should-not register-alist))))
+
+(provide 'register-tests)
+;;; register-tests.el ends here
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 7e50429..a59f0ca 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -292,31 +292,6 @@ cf. Bug#25477."
(should-error (eval '(dolist "foo") t)
:type 'wrong-type-argument))
-(require 'cl-generic)
-(cl-defgeneric subr-tests--generic (x))
-(cl-defmethod subr-tests--generic ((x string))
- (message "%s is a string" x))
-(cl-defmethod subr-tests--generic ((x integer))
- (message "%s is a number" x))
-(cl-defgeneric subr-tests--generic-without-methods (x y))
-(defvar subr-tests--this-file
- (file-truename (or load-file-name buffer-file-name)))
-
-(ert-deftest subr-tests--method-files--finds-methods ()
- "`method-files' returns a list of files and methods for a generic function."
- (let ((retval (method-files 'subr-tests--generic)))
- (should (equal (length retval) 2))
- (mapc (lambda (x)
- (should (equal (car x) subr-tests--this-file))
- (should (equal (cadr x) 'subr-tests--generic)))
- retval)
- (should-not (equal (nth 0 retval) (nth 1 retval)))))
-
-(ert-deftest subr-tests--method-files--nonexistent-methods ()
- "`method-files' returns nil if asked to find a method which doesn't exist."
- (should-not (method-files 'subr-tests--undefined-generic))
- (should-not (method-files 'subr-tests--generic-without-methods)))
-
(ert-deftest subr-tests-bug22027 ()
"Test for http://debbugs.gnu.org/22027 ."
(let ((default "foo") res)
diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el
index 387786c..6fbc1b0 100644
--- a/test/lisp/vc/ediff-ptch-tests.el
+++ b/test/lisp/vc/ediff-ptch-tests.el
@@ -66,41 +66,55 @@ index 6a07f80..6e8e947 100644
(write-region nil nil bar nil 'silent))
(call-process git-program nil `(:file ,patch) nil "diff")
(call-process git-program nil nil nil "reset" "--hard" "HEAD")
+ ;; Visit the diff file i.e., patch; extract from it the parts
+ ;; affecting just each of the files: store in patch-bar the part
+ ;; affecting 'bar', and in patch-qux the part affecting 'qux'.
(find-file patch)
(unwind-protect
(let* ((info
(progn (ediff-map-patch-buffer (current-buffer))
ediff-patch-map))
- (patch1
+ (patch-bar
(buffer-substring-no-properties
(car (nth 3 (car info)))
(car (nth 4 (car info)))))
- (patch2
+ (patch-qux
(buffer-substring-no-properties
(car (nth 3 (cadr info)))
(car (nth 4 (cadr info))))))
;; Apply both patches.
- (dolist (x (list (cons patch1 bar) (cons patch2 qux)))
+ (dolist (x (list (cons patch-bar bar) (cons patch-qux qux)))
(with-temp-buffer
- (insert (car x))
- (call-process-region (point-min)
- (point-max)
- ediff-patch-program
- nil nil nil
- "-b" (cdr x))))
- ;; Check backup files were saved correctly.
+ ;; Some windows variants require the option '--binary'
+ ;; in order to 'patch' create backup files.
+ (let ((opts (format "--backup%s"
+ (if (memq system-type '(windows-nt ms-dos))
+ " --binary" ""))))
+ (insert (car x))
+ (call-process-region (point-min)
+ (point-max)
+ ediff-patch-program
+ nil nil nil
+ opts (cdr x)))))
+ ;; Check backup files were saved correctly; in Bug#26084 some
+ ;; of the backup files are overwritten with the actual content
+ ;; of the updated file. To ensure that the bug is fixed we just
+ ;; need to check that every backup file produced has different
+ ;; content that the current updated file.
(dolist (x (list qux bar))
(let ((backup
(car
(directory-files
tmpdir 'full
(concat (file-name-nondirectory x) ".")))))
- (should-not
- (string= (with-temp-buffer
- (insert-file-contents x)
- (buffer-string))
- (with-temp-buffer
- (insert-file-contents backup)
- (buffer-string))))))
+ ;; Compare files only if the backup has being created.
+ (when backup
+ (should-not
+ (string= (with-temp-buffer
+ (insert-file-contents x)
+ (buffer-string))
+ (with-temp-buffer
+ (insert-file-contents backup)
+ (buffer-string)))))))
(delete-directory tmpdir 'recursive)
(delete-file patch)))))
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 793dddd..8740674 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -45,4 +45,9 @@ with parameters from the *Messages* buffer modification."
(should (eq buf (current-buffer))))
(when msg-ov (delete-overlay msg-ov))))))
+(ert-deftest test-generate-new-buffer-name-bug27966 ()
+ (should-not (string-equal "nil"
+ (progn (get-buffer-create "nil")
+ (generate-new-buffer-name "nil")))))
+
;;; buffer-tests.el ends here
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index 03f4087..b98de0a 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -59,4 +59,24 @@ Bug#24912 and Bug#24913."
(should-error (,form ,arg) :type 'wrong-type-argument))
t)))
+(ert-deftest eval-tests--if-dot-string ()
+ "Check that Emacs rejects (if . \"string\")."
+ (should-error (eval '(if . "abc")) :type 'wrong-type-argument)
+ (let ((if-tail (list '(setcdr if-tail "abc") t)))
+ (should-error (eval (cons 'if if-tail))))
+ (let ((if-tail (list '(progn (setcdr if-tail "abc") nil) t)))
+ (should-error (eval (cons 'if if-tail)))))
+
+(ert-deftest eval-tests--let-with-circular-defs ()
+ "Check that Emacs reports an error for (let VARS ...) when VARS is circular."
+ (let ((vars (list 'v)))
+ (setcdr vars vars)
+ (dolist (let-sym '(let let*))
+ (should-error (eval (list let-sym vars))))))
+
+(ert-deftest eval-tests--mutating-cond ()
+ "Check that Emacs doesn't crash on a cond clause that mutates during eval."
+ (let ((clauses (list '((progn (setcdr clauses "ouch") nil)))))
+ (should-error (eval (cons 'cond clauses)))))
+
;;; eval-tests.el ends here
- [Emacs-diffs] master updated (c2f1830 -> 6e2c092), Michael Mauger, 2017/08/06
- [Emacs-diffs] master c5a31f8 1/7: * lisp/progmodes/sql.el: Version 3.6, Michael Mauger, 2017/08/06
- [Emacs-diffs] master 776635c 3/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Michael Mauger, 2017/08/06
- [Emacs-diffs] master 7f62a4a 4/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Michael Mauger, 2017/08/06
- [Emacs-diffs] master eb27fc4 5/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Michael Mauger, 2017/08/06
- [Emacs-diffs] master 77083e2 2/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Michael Mauger, 2017/08/06
- [Emacs-diffs] master 6e2c092 7/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs,
Michael Mauger <=
- [Emacs-diffs] master df1a712 6/7: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Michael Mauger, 2017/08/06