[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/etags-regen 8d00e2f 1/8: Merge branch 'master' into scratch/etag
|
From: |
Dmitry Gutov |
|
Subject: |
scratch/etags-regen 8d00e2f 1/8: Merge branch 'master' into scratch/etags-regen |
|
Date: |
Sun, 7 Feb 2021 21:11:58 -0500 (EST) |
branch: scratch/etags-regen
commit 8d00e2f20bc6fc33eeb262fc03664b8fda3ae1e1
Merge: 153a549 25e1b73
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: Dmitry Gutov <dgutov@yandex.ru>
Merge branch 'master' into scratch/etags-regen
---
.gitignore | 1 +
.gitlab-ci.yml | 90 +------
admin/notes/elpa | 32 ++-
admin/nt/dist-build/README-scripts | 38 ++-
admin/nt/dist-build/README-windows-binaries | 49 ++--
admin/nt/dist-build/build-dep-zips.py | 188 +++++++--------
admin/nt/dist-build/build-zips.sh | 90 +++----
admin/nt/dist-build/emacs.nsi | 31 +--
configure.ac | 21 +-
doc/lispref/commands.texi | 14 +-
doc/lispref/control.texi | 5 +-
doc/lispref/elisp.texi | 1 +
doc/lispref/errors.texi | 5 +
doc/lispref/minibuf.texi | 33 +++
doc/lispref/modes.texi | 2 +-
doc/misc/tramp.texi | 28 ++-
doc/misc/trampver.texi | 2 +-
etc/HELLO | 2 +
etc/NEWS | 24 ++
etc/PROBLEMS | 5 +
lisp/calc/calc.el | 10 +-
lisp/cedet/ede/auto.el | 24 +-
lisp/comint.el | 26 +--
lisp/cus-face.el | 1 +
lisp/custom.el | 11 +-
lisp/dired-x.el | 2 +-
lisp/emacs-lisp/byte-opt.el | 351 ++++++++++++++--------------
lisp/emacs-lisp/eieio-base.el | 135 ++++++-----
lisp/emacs-lisp/ert.el | 4 +-
lisp/emacs-lisp/pcase.el | 46 +++-
lisp/emacs-lisp/radix-tree.el | 7 +-
lisp/erc/erc-services.el | 56 ++++-
lisp/foldout.el | 2 +-
lisp/frame.el | 8 +-
lisp/gnus/gnus-search.el | 11 +-
lisp/gnus/nnmaildir.el | 3 +-
lisp/info.el | 2 +-
lisp/isearch.el | 61 ++---
lisp/language/cham.el | 7 +-
lisp/mail/rmailsum.el | 6 +-
lisp/mouse-drag.el | 4 +-
lisp/mouse.el | 2 +-
lisp/net/nsm.el | 2 +-
lisp/net/tramp-adb.el | 6 +-
lisp/net/tramp-sh.el | 17 +-
lisp/net/tramp.el | 24 +-
lisp/net/trampver.el | 6 +-
lisp/pixel-scroll.el | 12 +-
lisp/progmodes/project.el | 19 +-
lisp/ruler-mode.el | 4 +-
lisp/shell.el | 1 +
lisp/simple.el | 34 ++-
lisp/startup.el | 37 ++-
lisp/strokes.el | 23 +-
lisp/subr.el | 78 ++++++-
lisp/textmodes/artist.el | 6 +-
lisp/textmodes/reftex-vars.el | 7 +-
lisp/vc/ediff-wind.el | 5 +-
lisp/vc/ediff.el | 2 +-
lisp/wid-edit.el | 14 +-
lisp/window.el | 8 +-
src/data.c | 3 +
src/dispnew.c | 16 +-
src/fns.c | 85 +++++++
src/frame.c | 59 +++--
src/keymap.c | 35 ---
src/lisp.h | 1 +
src/lread.c | 29 ++-
src/minibuf.c | 29 ++-
src/process.c | 94 +++++++-
src/term.c | 4 +-
src/termhooks.h | 2 -
src/xdisp.c | 16 +-
test/Makefile.in | 6 +
test/README | 6 +
test/file-organization.org | 5 +
test/infra/Dockerfile.emba | 71 ++++++
test/infra/gitlab-ci.yml | 217 +++++++++++++++++
test/lisp/calendar/lunar-tests.el | 38 ++-
test/lisp/calendar/solar-tests.el | 4 +-
test/lisp/cedet/semantic-utest.el | 6 +-
test/lisp/cedet/srecode-utest-getset.el | 1 -
test/lisp/cedet/srecode-utest-template.el | 6 +-
test/lisp/emacs-lisp/bytecomp-tests.el | 4 +-
test/lisp/emacs-lisp/pcase-tests.el | 4 +
test/lisp/emacs-lisp/timer-tests.el | 4 +-
test/lisp/help-tests.el | 4 +-
test/lisp/net/nsm-tests.el | 8 +-
test/lisp/net/tramp-tests.el | 140 ++++++-----
test/lisp/progmodes/elisp-mode-tests.el | 14 +-
test/lisp/progmodes/tcl-tests.el | 14 +-
test/lisp/subr-tests.el | 11 +
test/src/decompress-tests.el | 20 +-
test/src/fns-tests.el | 58 +++++
test/src/lread-tests.el | 6 +
test/src/minibuf-tests.el | 15 ++
test/src/process-tests.el | 26 ++-
test/src/xdisp-tests.el | 30 +++
test/src/xml-tests.el | 14 +-
99 files changed, 1827 insertions(+), 1023 deletions(-)
diff --git a/.gitignore b/.gitignore
index dd4eab7..7e3e434 100644
--- a/.gitignore
+++ b/.gitignore
@@ -298,3 +298,4 @@ nt/emacs.rc
nt/emacsclient.rc
src/gdb.ini
/var/
+src/fingerprint.c
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index bc18137..3138f41 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -1,4 +1,4 @@
-# Copyright (C) 2017-2021 Free Software Foundation, Inc.
+# Copyright (C) 2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
@@ -24,89 +24,5 @@
# Maintainer: Ted Zlatanov <tzz@lifelogs.com>
# URL: https://emba.gnu.org/emacs/emacs
-image: debian:stretch
-
-variables:
- GIT_STRATEGY: fetch
- EMACS_EMBA_CI: 1
-
-before_script:
- - apt update -qq
- - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq
-o=Dpkg::Use-Pty=0 libc-dev gcc g++ make autoconf automake libncurses-dev
gnutls-dev git
-
-stages:
- - test
-
-test-all:
- # This tests also file monitor libraries inotify and inotifywatch.
- stage: test
- only:
- changes:
- - "Makefile.in"
- - .gitlab-ci.yml
- - aclocal.m4
- - autogen.sh
- - configure.ac
- - lib/*.{h,c}
- - lisp/*.el
- - lisp/**/*.el
- - src/*.{h,c}
- - test/lisp/*.el
- - test/lisp/**/*.el
- - test/src/*.el
- except:
- changes:
- # gfilemonitor, kqueue
- - src/gfilenotify.c
- - src/kqueue.c
- # MS Windows
- - lisp/w32*.el
- - lisp/term/w32*.el
- - src/w32*.{h,c}
- # GNUstep
- - lisp/term/ns-win.el
- - src/ns*.{h,m}
- - src/macfont.{h,m}
- script:
- - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y
-qq -o=Dpkg::Use-Pty=0 inotify-tools
- - ./autogen.sh autoconf
- - ./configure --without-makeinfo
- - make bootstrap
- - make check-expensive
-
-test-filenotify-gio:
- stage: test
- # This tests file monitor libraries gfilemonitor and gio.
- only:
- changes:
- - .gitlab-ci.yml
- - lisp/autorevert.el
- - lisp/filenotify.el
- - lisp/net/tramp-sh.el
- - src/gfilenotify.c
- - test/lisp/autorevert-tests.el
- - test/lisp/filenotify-tests.el
- script:
- - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y
-qq -o=Dpkg::Use-Pty=0 libglib2.0-dev libglib2.0-bin libglib2.0-0
- - ./autogen.sh autoconf
- - ./configure --without-makeinfo --with-file-notification=gfile
- - make bootstrap
- - make -k -C test autorevert-tests filenotify-tests
-
-test-gnustep:
- stage: test
- # This tests the GNUstep build process
- only:
- changes:
- - .gitlab-ci.yml
- - configure.ac
- - src/ns*.{h,m}
- - src/macfont.{h,m}
- - lisp/term/ns-win.el
- - nextstep/**/*
- script:
- - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y
-qq -o=Dpkg::Use-Pty=0 gnustep-devel
- - ./autogen.sh autoconf
- - ./configure --without-makeinfo --with-ns
- - make bootstrap
- - make install
+# Just load from test/infra, to keep build automation files there.
+include: '/test/infra/gitlab-ci.yml'
diff --git a/admin/notes/elpa b/admin/notes/elpa
index ea6c132..1e9e7a9 100644
--- a/admin/notes/elpa
+++ b/admin/notes/elpa
@@ -5,17 +5,31 @@ repository named "elpa", hosted on Savannah. To check it out:
git clone git://git.sv.gnu.org/emacs/elpa
cd elpa
- git remote set-url --push origin git+ssh://git.sv.gnu.org/srv/git/emacs/elpa
- [create task branch for edits, etc.]
+ make setup
-Changes to this branch propagate to elpa.gnu.org via a "deployment" script run
-daily. This script (which is kept in elpa/admin/update-archive.sh) generates
-the content visible at https://elpa.gnu.org/packages.
+That leaves the elpa/packages directory empty; you must check out the
+ones you want.
-A new package is released as soon as the "version number" of that package is
-changed. So you can use 'elpa' to work on a package without fear of releasing
-those changes prematurely. And once the code is ready, just bump the
-version number to make a new release of the package.
+If you wish to check out all the packages into the packages directory,
+you can run the command:
+
+ make worktrees
+
+You can check out a specific package <pkgname> into the packages
+directory with:
+
+ make packages/<pkgname>
+
+
+Changes to this repository propagate to elpa.gnu.org via a
+"deployment" script run daily. This script generates the content
+visible at https://elpa.gnu.org/packages.
+
+A new package is released as soon as the "version number" of that
+package is changed. So you can use 'elpa' to work on a package
+without fear of releasing those changes prematurely. And once the
+code is ready, just bump the version number to make a new release of
+the package.
It is easy to use the elpa branch to deploy a "local" copy of the
package archive. For details, see the README file in the elpa branch.
diff --git a/admin/nt/dist-build/README-scripts
b/admin/nt/dist-build/README-scripts
index 4c3554e..f27bcd3 100644
--- a/admin/nt/dist-build/README-scripts
+++ b/admin/nt/dist-build/README-scripts
@@ -33,26 +33,21 @@ build-zips.sh file will create this for you.
A location for the dependencies. This needs to contain two zip files
with the dependencies. build-dep-zips.py will create these files for you.
-~/emacs-build/deps/libXpm/i686
-~/emacs-build/deps/libXpm/x86_64
+~/emacs-build/deps/libXpm
Contain libXpm-noX4.dll. This file is used to load images for the
splash screen, menu items and so on. Emacs runs without it, but looks
-horrible. The x86_64 comes from msys2, while the i686 comes from
-ezwinports because it itself has no dependencies. These have to be
-placed manually (but probably never need updating).
+horrible. The files came original from msys2, and contains no
+dependencies. It has to be placed manually (but probably never
+need updating).
-
-~/emacs-build/build/$version/i686
-~/emacs-build/build/$version/x86_64
+~/emacs-build/build/$version
We build Emacs out-of-source here. This directory is created by
build-zips.sh. This directory can be freely deleted after zips have
been created
-
-~/emacs-build/install/$version/i686
-~/emacs-build/install/$version/x86_64
+~/emacs-build/install/$version
We install Emacs here. This directory is created by build-zips.sh.
This directory can and *should* be deleted after zips have been
@@ -79,9 +74,9 @@ To do this:
Update msys to the latest version with `pacman -Syu`.
-Then run build-dep-zips.py, in the ~/emacs-build/deps directory. Three
-zips will be created, containing the 64bit and 32bit dependencies, as
-well as the source for these.
+Then run build-dep-zips.py, in the ~/emacs-build/deps directory. Two
+zips will be created, containing the dependencies, as well as the
+source for these.
For emacs release or pre-test version:
@@ -105,12 +100,12 @@ To do this:
Update msys to the latest version with `pacman -Syu`.
-Then run build-dep-zips.py, in ~/emacs-build/deps directory. Three
-zips will be created, containing the 64bit and 32bit dependencies, as
-well as the source for these. These deps files contain the date of
-creation in their name. The deps file can be reused as desired, or a
-new version created. Where multiple deps files exist, the most
-recent will be used.
+Then run build-dep-zips.py, in ~/emacs-build/deps directory. Two zips
+will be created, containing the dependencies, as well as the source
+for these. These deps files contain the date of creation in their
+name. The deps file can be reused as desired, or a new version
+created. Where multiple deps files exist, the most recent will be
+used.
Now, run `build-zips.sh -s` to build a snapshot release.
@@ -134,4 +129,5 @@ For snapshots from another branch
Snapshots can be build from any other branch. There is rarely a need
to do this, except where some significant, wide-ranging feature is
being added on a feature branch. In this case, the branch can be
-given using `build-zips.sh -b pdumper -s` for example.
+given using `build-zips.sh -b pdumper -s` for example. Any "/"
+characters in the branch title are replaced.
diff --git a/admin/nt/dist-build/README-windows-binaries
b/admin/nt/dist-build/README-windows-binaries
index 001bdd7..b6f6e55 100644
--- a/admin/nt/dist-build/README-windows-binaries
+++ b/admin/nt/dist-build/README-windows-binaries
@@ -4,7 +4,7 @@ See the end of the file for license conditions.
Precompiled Distributions of
Emacs for Windows
- Jan 1, 2020
+ Jan 14, 2021
This directory contains precompiled distributions for GNU Emacs on
Windows
@@ -25,51 +25,33 @@ old binaries.
Windows Binaries
================
-Currently, we provide six different binary packages for Emacs, which
+Currently, we provide three different binary packages for Emacs, which
are:
-emacs-$VERSION-x86_64-installer.exe
+emacs-$VERSION-installer.exe
-Contains a 64-bit build of Emacs with dependencies as an installer
+Contains Emacs with dependencies as an installer
package. Mostly, this is the best one to install.
-emacs-$VERSION-x86_64.zip
+emacs-$VERSION.zip
-Contains a 64-bit build of Emacs with dependencies. This contains the
-same files as the installer but as a zip file which some users may
-prefer.
+Contains Emacs with dependencies. This contains the same files as the
+installer but as a zip file which some users may prefer.
-emacs-$VERSION-x86_64-no-deps.zip
+emacs-$VERSION-no-deps.zip
-Contains a 64-bit build of Emacs without any dependencies. This may be
-useful if you wish to install where the dependencies are already
-available, or if you want the small possible Emacs.
-
-emacs-$VERSION-i686-installer.exe
-
-Contains a 32-bit build of Emacs with dependencies as an installer
-package. This is useful for running on a 32-bit machine.
-
-emacs-$VERSION-i686.zip
-
-Contains a 32-bit build of Emacs with dependencies.
-
-emacs-$VERSION-i686-no-deps.zip
-
-Contains a 32-bit build of Emacs without dependencies
+Contains Emacs without any dependencies. This may be useful if you
+wish to install where the dependencies are already available, or if
+you want the small possible Emacs.
In addition, we provide the following files which will not be useful
for most end-users.
-emacs-$VERSION-x86_64-deps.zip
+emacs-$VERSION-deps.zip
The dependencies. Unzipping this file on top of
-emacs-$VERSION-x86_64-no-deps.zip should result in the same install as
-emacs-$VERSION-x86_64.zip.
-
-emacs-$VERSION-i686-deps.zip
-
-The 32-bit version of the dependencies.
+emacs-$VERSION-no-deps.zip should result in the same install as
+emacs-$VERSION.zip.
emacs-$VERSION-deps-mingw-w64-src.zip
@@ -85,7 +67,8 @@ Snapshots
We also distribute "snapshots" of Emacs built at points throughout the
development cycle, for those interested in following this cycle. They
-are not recommended for normal users.
+are not recommended for normal users; however, they are useful for
+people who want to report bugs against the current master.
The files follow the same naming convention, but also include a date
(and sometimes information about their branch). The Emacs source at
diff --git a/admin/nt/dist-build/build-dep-zips.py
b/admin/nt/dist-build/build-dep-zips.py
index 47185db..19168e7 100755
--- a/admin/nt/dist-build/build-dep-zips.py
+++ b/admin/nt/dist-build/build-dep-zips.py
@@ -17,7 +17,6 @@
## You should have received a copy of the GNU General Public License
## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
import argparse
-import multiprocessing as mp
import os
import shutil
import re
@@ -40,21 +39,84 @@ mingw-w64-x86_64-libtiff
mingw-w64-x86_64-libxml2
mingw-w64-x86_64-xpm-nox'''.split()
+DLL_REQ='''libgif
+libgnutls
+libharfbuzz
+libjansson
+liblcms2
+libturbojpeg
+libpng
+librsvg
+libtiff
+libxml
+libXpm'''.split()
+
## Options
DRY_RUN=False
+
+def check_output_maybe(*args,**kwargs):
+ if(DRY_RUN):
+ print("Calling: {}{}".format(args,kwargs))
+ else:
+ return check_output(*args,**kwargs)
+
+## DLL Capture
+def gather_deps():
+
+ os.mkdir("x86_64")
+ os.chdir("x86_64")
+
+ for dep in full_dll_dependency():
+ check_output_maybe(["cp /mingw64/bin/{}*.dll .".format(dep)],
+ shell=True)
+
+ print("Zipping")
+ check_output_maybe("zip -9r ../emacs-{}-{}deps.zip *"
+ .format(EMACS_MAJOR_VERSION, DATE),
+ shell=True)
+ os.chdir("../")
+
+## Return all Emacs dependencies
+def full_dll_dependency():
+ deps = [dll_dependency(dep) for dep in DLL_REQ]
+ return set(sum(deps, []) + DLL_REQ)
+
+## Dependencies for a given DLL
+def dll_dependency(dll):
+ output = check_output(["/mingw64/bin/ntldd", "--recursive",
+ "/mingw64/bin/{}*.dll".format(dll)]).decode("utf-8")
+ ## munge output
+ return ntldd_munge(output)
+
+def ntldd_munge(out):
+ deps = out.splitlines()
+ rtn = []
+ for dep in deps:
+ ## Output looks something like this
+
+ ## KERNEL32.dll => C:\Windows\SYSTEM32\KERNEL32.dll
(0x0000000002a30000)
+ ## libwinpthread-1.dll => C:\msys64\mingw64\bin\libwinpthread-1.dll
(0x0000000000090000)
+
+ ## if it's the former, we want it, if its the later we don't
+ splt = dep.split()
+ if len(splt) > 2 and "msys64" in splt[2]:
+ print("Adding dep", splt[0])
+ rtn.append(splt[0].split(".")[0])
+
+ return rtn
+
+#### Source Capture
+
## Packages to fiddle with
## Source for gcc-libs is part of gcc
SKIP_SRC_PKGS=["mingw-w64-gcc-libs"]
-SKIP_DEP_PKGS=["mingw-w64-x86_64-glib2"]
+SKIP_DEP_PKGS=["mingw-w64-glib2"]
MUNGE_SRC_PKGS={"mingw-w64-libwinpthread-git":"mingw-w64-winpthreads-git"}
MUNGE_DEP_PKGS={
- "mingw-w64-i686-libwinpthread":"mingw-w64-i686-libwinpthread-git",
"mingw-w64-x86_64-libwinpthread":"mingw-w64-x86_64-libwinpthread-git",
-
"mingw-w64-x86_64-libtre": "mingw-w64-x86_64-libtre-git",
- "mingw-w64-i686-libtre": "mingw-w64-i686-libtre-git"
}
## Currently no packages seem to require this!
@@ -62,12 +124,6 @@ ARCH_PKGS=[]
SRC_REPO="https://sourceforge.net/projects/msys2/files/REPOS/MINGW/Sources";
-def check_output_maybe(*args,**kwargs):
- if(DRY_RUN):
- print("Calling: {}{}".format(args,kwargs))
- else:
- return check_output(*args,**kwargs)
-
def immediate_deps(pkg):
package_info = check_output(["pacman", "-Si",
pkg]).decode("utf-8").split("\n")
@@ -87,92 +143,50 @@ def immediate_deps(pkg):
return dependencies
+## Extract all the msys2 packages that are dependencies of our direct
dependencies
def extract_deps():
print( "Extracting deps" )
# Get a list of all dependencies needed for packages mentioned above.
pkgs = PKG_REQ[:]
- print("Initial pkgs", pkgs)
n = 0
while n < len(pkgs):
subdeps = immediate_deps(pkgs[n])
for p in subdeps:
if not (p in pkgs or p in SKIP_DEP_PKGS):
- print("adding", p)
pkgs.append(p)
n = n + 1
return sorted(pkgs)
-def gather_deps(deps, arch, directory):
-
- os.mkdir(arch)
- os.chdir(arch)
-
- ## Replace the architecture with the correct one
- deps = [re.sub(r"x86_64",arch,x) for x in deps]
-
- ## find all files the transitive dependencies
- deps_files = check_output(
- ["pacman", "-Ql"] + deps
- ).decode("utf-8").split("\n")
-
- ## Produces output like
- ## mingw-w64-x86_64-zlib /mingw64/lib/libminizip.a
-
- ## drop the package name
- tmp = deps_files.copy()
- deps_files=[]
- for d in tmp:
- slt = d.split()
- if(not slt==[]):
- deps_files.append(slt[1])
-
- ## sort uniq
- deps_files = sorted(list(set(deps_files)))
- ## copy all files into local
- print("Copying dependencies: {}".format(arch))
- check_output_maybe(["rsync", "-R"] + deps_files + ["."])
-
- ## And package them up
- os.chdir(directory)
- print("Zipping: {}".format(arch))
- check_output_maybe("zip -9r ../../emacs-{}-{}{}-deps.zip *"
- .format(EMACS_MAJOR_VERSION, DATE, arch),
- shell=True)
- os.chdir("../../")
-
def download_source(tarball):
print("Acquiring {}...".format(tarball))
- if os.path.exists("../emacs-src-cache/{}".format(tarball)):
- print("Copying {} from local".format(tarball))
- shutil.copyfile("../emacs-src-cache/{}".format(tarball),
- "{}".format(tarball))
- else:
+ if not os.path.exists("../emacs-src-cache/{}".format(tarball)):
print("Downloading {}...".format(tarball))
check_output_maybe(
- "wget -a ../download.log -O {} {}/{}/download"
+ "wget -a ../download.log -O ../emacs-src-cache/{} {}/{}/download"
.format(tarball, SRC_REPO, tarball),
shell=True
)
print("Downloading {}... done".format(tarball))
-def gather_source(deps):
+ print("Copying {} from local".format(tarball))
+ shutil.copyfile("../emacs-src-cache/{}".format(tarball),
+ "{}".format(tarball))
- ## Source for gcc-libs is part of gcc
- ## Source for libwinpthread is in libwinpthreads
- ## mpc, termcap, xpm -- has x86_64, and i686 versions
+## Fetch all the source code
+def gather_source(deps):
+
+ if not os.path.exists("emacs-src-cache"):
+ os.mkdir("emacs-src-cache")
- ## This needs to have been run first at the same time as the
- ## system was updated.
os.mkdir("emacs-src")
os.chdir("emacs-src")
- to_download = []
for pkg in deps:
pkg_name_and_version= \
check_output(["pacman","-Q", pkg]).decode("utf-8").strip()
@@ -183,31 +197,18 @@ def gather_source(deps):
pkg_name=pkg_name_components[0]
pkg_version=pkg_name_components[1]
- ## make a simple name to make lookup easier
- simple_pkg_name = re.sub(r"x86_64-","",pkg_name)
+ ## source pkgs don't have an architecture in them
+ pkg_name = re.sub(r"x86_64-","",pkg_name)
- if(simple_pkg_name in SKIP_SRC_PKGS):
+ if(pkg_name in SKIP_SRC_PKGS):
continue
- ## Some packages have different source files for different
- ## architectures. For these we need two downloads.
- if(simple_pkg_name in ARCH_PKGS):
- downloads = [pkg_name,
- re.sub(r"x86_64","i686",pkg_name)]
- else:
- downloads = [simple_pkg_name]
-
- for d in downloads:
- ## Switch names if necessary
- d = MUNGE_SRC_PKGS.get(d,d)
+ ## Switch names if necessary
+ pkg_name = MUNGE_SRC_PKGS.get(pkg_name,pkg_name)
- tarball = "{}-{}.src.tar.gz".format(d,pkg_version)
+ tarball = "{}-{}.src.tar.gz".format(pkg_name,pkg_version)
- to_download.append(tarball)
-
- ## Download in parallel or it is just too slow
- p = mp.Pool(16)
- p.map(download_source,to_download)
+ download_source(tarball)
print("Zipping")
check_output_maybe("zip -9 ../emacs-{}-{}deps-mingw-w64-src.zip *"
@@ -220,7 +221,6 @@ def gather_source(deps):
def clean():
print("Cleaning")
os.path.isdir("emacs-src") and shutil.rmtree("emacs-src")
- os.path.isdir("i686") and shutil.rmtree("i686")
os.path.isdir("x86_64") and shutil.rmtree("x86_64")
os.path.isfile("download.log") and os.remove("download.log")
@@ -234,12 +234,6 @@ parser = argparse.ArgumentParser()
parser.add_argument("-s", help="snapshot build",
action="store_true")
-parser.add_argument("-t", help="32 bit deps only",
- action="store_true")
-
-parser.add_argument("-f", help="64 bit deps only",
- action="store_true")
-
parser.add_argument("-r", help="source code only",
action="store_true")
@@ -253,9 +247,9 @@ parser.add_argument("-l", help="list dependencies only",
action="store_true")
args = parser.parse_args()
-do_all=not (args.c or args.r or args.f or args.t)
+do_all=not (args.c or args.r)
+
-deps=extract_deps()
DRY_RUN=args.d
@@ -269,13 +263,11 @@ if args.s:
else:
DATE=""
-if( do_all or args.t ):
- gather_deps(deps,"i686","mingw32")
-
-if( do_all or args.f ):
- gather_deps(deps,"x86_64","mingw64")
+if( do_all):
+ gather_deps()
if( do_all or args.r ):
+ deps=extract_deps()
gather_source(deps)
if( args.c ):
diff --git a/admin/nt/dist-build/build-zips.sh
b/admin/nt/dist-build/build-zips.sh
index 4a9a7b5..7bc6ea6 100755
--- a/admin/nt/dist-build/build-zips.sh
+++ b/admin/nt/dist-build/build-zips.sh
@@ -29,72 +29,62 @@ function git_up {
}
function build_zip {
-
- ARCH=$1
- PKG=$2
- HOST=$3
-
- echo [build] Building Emacs-$VERSION for $ARCH
- if [ $ARCH == "i686" ]
- then
- PATH=/mingw32/bin:$PATH
- MSYSTEM=MINGW32
- fi
+ echo [build] Building Emacs-$VERSION
## Clean the install location because we use it twice
- rm -rf $HOME/emacs-build/install/emacs-$VERSION/$ARCH
- mkdir --parents $HOME/emacs-build/build/emacs-$VERSION/$ARCH
- cd $HOME/emacs-build/build/emacs-$VERSION/$ARCH
+ rm -rf $HOME/emacs-build/install/emacs-$VERSION
+ mkdir --parents $HOME/emacs-build/build/emacs-$VERSION
+ cd $HOME/emacs-build/build/emacs-$VERSION
+
+ ## Do we need this or is it the default?
+ export PKG_CONFIG_PATH=/mingw64/lib/pkgconfig
- export PKG_CONFIG_PATH=$PKG
## Running configure forces a rebuild of the C core which takes
## time that is not always needed, so do not do it unless we have
## to.
if [ ! -f Makefile ] || (($CONFIG))
then
- echo [build] Configuring Emacs $ARCH
+ echo [build] Configuring Emacs
$REPO_DIR/$BRANCH/configure \
--without-dbus \
- --host=$HOST --without-compress-install \
+ --without-compress-install \
$CACHE \
CFLAGS="$CFLAGS"
fi
make -j 4 $INSTALL_TARGET \
- prefix=$HOME/emacs-build/install/emacs-$VERSION/$ARCH
- cd $HOME/emacs-build/install/emacs-$VERSION/$ARCH
- cp $HOME/emacs-build/deps/libXpm/$ARCH/libXpm-noX4.dll bin
- zip -r -9 emacs-$OF_VERSION-$ARCH-no-deps.zip *
- mv emacs-$OF_VERSION-$ARCH-no-deps.zip $HOME/emacs-upload
- rm bin/libXpm-noX4.dll
+ prefix=$HOME/emacs-build/install/emacs-$VERSION
+ cd $HOME/emacs-build/install/emacs-$VERSION
+ zip -r -9 emacs-$OF_VERSION-no-deps.zip *
+ mv emacs-$OF_VERSION-no-deps.zip $HOME/emacs-upload
if [ -z $SNAPSHOT ];
then
- DEPS_FILE=$HOME/emacs-build/deps/emacs-$MAJOR_VERSION-$ARCH-deps.zip
+ DEPS_FILE=$HOME/emacs-build/deps/emacs-$MAJOR_VERSION-deps.zip
else
## Pick the most recent snapshot whatever that is
- DEPS_FILE=`ls
$HOME/emacs-build/deps/emacs-$MAJOR_VERSION-*-$ARCH-deps.zip | tail -n 1`
+ DEPS_FILE=`ls $HOME/emacs-build/deps/emacs-$MAJOR_VERSION-*-deps.zip |
tail -n 1`
fi
echo [build] Using $DEPS_FILE
- unzip $DEPS_FILE
+ unzip -d bin $DEPS_FILE
- zip -r -9 emacs-$OF_VERSION-$ARCH.zip *
- mv emacs-$OF_VERSION-$ARCH.zip ~/emacs-upload
+ zip -r -9 emacs-$OF_VERSION.zip *
+ mv emacs-$OF_VERSION.zip ~/emacs-upload
}
function build_installer {
- ARCH=$1
- cd $HOME/emacs-build/install/emacs-$VERSION
+ cd $HOME/emacs-build/install/
echo [build] Calling makensis in `pwd`
cp $REPO_DIR/$BRANCH/admin/nt/dist-build/emacs.nsi .
makensis -v4 \
- -DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \
+ -DEMACS_VERSION=$ACTUAL_VERSION \
+ -DVERSION_BRANCH=$VERSION \
-DOUT_VERSION=$OF_VERSION emacs.nsi
rm emacs.nsi
- mv emacs-$OF_VERSION-$ARCH-installer.exe ~/emacs-upload
+ mv emacs-$OF_VERSION-installer.exe ~/emacs-upload
}
set -o errexit
@@ -103,7 +93,6 @@ SNAPSHOT=
CACHE=
BUILD=1
-BUILD_32=1
BUILD_64=1
GIT_UP=0
CONFIG=1
@@ -114,19 +103,8 @@ INSTALL_TARGET="install-strip"
REPO_DIR=$HOME/emacs-build/git/
-while getopts "36gb:hnsiV:" opt; do
+while getopts "gb:hnsiV:" opt; do
case $opt in
- 3)
- BUILD_32=1
- BUILD_64=0
- GIT_UP=0
- ;;
- 6)
- BUILD_32=0
- BUILD_64=1
- GIT_UP=0
- ;;
-
g)
BUILD_32=0
BUILD_64=0
@@ -152,10 +130,11 @@ while getopts "36gb:hnsiV:" opt; do
;;
h)
echo "build-zips.sh"
- echo " -3 32 bit build only"
- echo " -6 64 bit build only"
+ echo " -b args -- build args branch"
echo " -g git update and worktree only"
echo " -i build installer only"
+ echo " -n do not configure"
+ echo " -s snaphot build"
exit 0
;;
\?)
@@ -208,7 +187,7 @@ then
else
BRANCH=$REQUIRED_BRANCH
echo [build] Building from Branch $BRANCH
- VERSION=$VERSION-$BRANCH
+ VERSION=$VERSION-${BRANCH/\//_}
OF_VERSION="$VERSION-`date +%Y-%m-%d`"
## Use snapshot dependencies
SNAPSHOT=1
@@ -225,18 +204,7 @@ if (($BUILD_64))
then
if (($BUILD))
then
- build_zip x86_64 /mingw64/lib/pkgconfig x86_64-w64-mingw32
- fi
- build_installer x86_64
-fi
-
-## Do the 64 bit build first, because we reset some environment
-## variables during the 32 bit which will break the build.
-if (($BUILD_32))
-then
- if (($BUILD))
- then
- build_zip i686 /mingw32/lib/pkgconfig i686-w64-mingw32
+ build_zip
fi
- build_installer i686
+ build_installer
fi
diff --git a/admin/nt/dist-build/emacs.nsi b/admin/nt/dist-build/emacs.nsi
index dce8f3d..557bb10 100644
--- a/admin/nt/dist-build/emacs.nsi
+++ b/admin/nt/dist-build/emacs.nsi
@@ -2,7 +2,7 @@
!include LogicLib.nsh
!include x64.nsh
-Outfile "emacs-${OUT_VERSION}-${ARCH}-installer.exe"
+Outfile "emacs-${OUT_VERSION}-installer.exe"
SetCompressor /solid lzma
@@ -14,15 +14,15 @@ Var StartMenuFolder
!define MUI_WELCOMEPAGE_TITLE_3LINES
!define MUI_WELCOMEPAGE_TEXT "Welcome to Emacs -- the editor of a lifetime."
-!define MUI_WELCOMEFINISHPAGE_BITMAP
"${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\splash.bmp"
-!define MUI_ICON
"${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
-!define MUI_UNICON
"${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
+!define MUI_WELCOMEFINISHPAGE_BITMAP
"emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\etc\images\splash.bmp"
+!define MUI_ICON
"emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
+!define MUI_UNICON
"emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
!insertmacro MUI_PAGE_WELCOME
!define MUI_LICENSEPAGE_TEXT_TOP "The GNU General Public License"
-!insertmacro MUI_PAGE_LICENSE
"${ARCH}\share\emacs\${EMACS_VERSION}\lisp\COPYING"
+!insertmacro MUI_PAGE_LICENSE
"emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\lisp\COPYING"
!insertmacro MUI_PAGE_DIRECTORY
!insertmacro MUI_PAGE_INSTFILES
@@ -36,19 +36,7 @@ Var StartMenuFolder
Name Emacs-${EMACS_VERSION}
function .onInit
- ${If} ${RunningX64}
- ${If} ${ARCH} == "x86_64"
- StrCpy $INSTDIR "$PROGRAMFILES64\Emacs"
- ${Else}
- StrCpy $INSTDIR "$PROGRAMFILES32\Emacs"
- ${Endif}
- ${Else}
- ${If} ${ARCH} == "x86_64"
- Quit
- ${Else}
- StrCpy $INSTDIR "$PROGRAMFILES\Emacs"
- ${Endif}
- ${EndIf}
+ StrCpy $INSTDIR "$PROGRAMFILES64\Emacs"
functionend
@@ -56,7 +44,8 @@ Section
SetOutPath $INSTDIR
- File /r ${ARCH}
+ File /r emacs-${VERSION_BRANCH}
+
# define uninstaller name
WriteUninstaller $INSTDIR\Uninstall.exe
@@ -66,7 +55,7 @@ Section
CreateShortcut "$SMPROGRAMS\$StartMenuFolder\Uninstall.lnk"
"$INSTDIR\Uninstall.exe"
!insertmacro MUI_STARTMENU_WRITE_END
- CreateShortCut "$SMPROGRAMS\$StartMenuFolder\Emacs.lnk"
"$INSTDIR\${ARCH}\bin\runemacs.exe"
+ CreateShortCut "$SMPROGRAMS\$StartMenuFolder\Emacs.lnk"
"$INSTDIR\emacs-${VERSION_BRANCH}\bin\runemacs.exe"
SectionEnd
@@ -78,7 +67,7 @@ Section "Uninstall"
Delete "$INSTDIR\Uninstall.exe"
# now delete installed directory
- RMDir /r "$INSTDIR\${ARCH}"
+ RMDir /r "$INSTDIR"
RMDir "$INSTDIR"
!insertmacro MUI_STARTMENU_GETFOLDER Application $StartMenuFolder
diff --git a/configure.ac b/configure.ac
index 66c6606..bea2833 100644
--- a/configure.ac
+++ b/configure.ac
@@ -5657,6 +5657,12 @@ else
ACL_SUMMARY=no
fi
+if test -z "$GMP_H"; then
+ HAVE_GMP=yes
+else
+ HAVE_GMP=no
+fi
+
emacs_standard_dirs='Standard dirs'
AS_ECHO(["
Configured for '${canonical}'.
@@ -5671,12 +5677,14 @@ Configured for '${canonical}'.
Where do we find X Windows header files?
${x_includes:-$emacs_standard_dirs}
Where do we find X Windows libraries?
${x_libraries:-$emacs_standard_dirs}"])
+#### Please respect alphabetical ordering when making additions.
optsep=
emacs_config_features=
-for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \
- GCONF GSETTINGS GLIB NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE HARFBUZZ
M17N_FLT \
- LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 XDBE XIM \
- NS MODULES THREADS XWIDGETS LIBSYSTEMD JSON PDUMPER UNEXEC LCMS2 GMP; do
+for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \
+ HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \
+ M17N_FLT MODULES NOTIFY NS OLDXMENU PDUMPER PNG RSVG SOUND THREADS TIFF \
+ TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \
+ ZLIB; do
case $opt in
PDUMPER) val=${with_pdumper} ;;
@@ -5713,11 +5721,6 @@ done
AC_DEFINE_UNQUOTED(EMACS_CONFIG_FEATURES, "${emacs_config_features}",
[Summary of some of the main features enabled by configure.])
-if test -z "$GMP_H"; then
- HAVE_GMP=yes
-else
- HAVE_GMP=no
-fi
AS_ECHO([" Does Emacs use -lXaw3d?
${HAVE_XAW3D}
Does Emacs use -lXpm? ${HAVE_XPM}
Does Emacs use -ljpeg? ${HAVE_JPEG}
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 6c68f70..3a2c7d0 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -2696,9 +2696,11 @@ from the terminal---not counting those generated by
keyboard macros.
@code{read-event}, @code{read-char}, and @code{read-char-exclusive} do
not perform the translations described in @ref{Translation Keymaps}.
If you wish to read a single key taking these translations into
-account, use the function @code{read-key}:
+account (for example, to read @ref{Function Keys} in a terminal or
+@ref{Mouse Events} from @code{xterm-mouse-mode}), use the function
+@code{read-key}:
-@defun read-key &optional prompt
+@defun read-key &optional prompt disable-fallbacks
This function reads a single key. It is intermediate between
@code{read-key-sequence} and @code{read-event}. Unlike the former, it
reads a single key, not a key sequence. Unlike the latter, it does
@@ -2708,6 +2710,14 @@ and @code{key-translation-map} (@pxref{Translation
Keymaps}).
The argument @var{prompt} is either a string to be displayed in the
echo area as a prompt, or @code{nil}, meaning not to display a prompt.
+
+If argument @var{disable-fallbacks} is non-@code{nil} then the usual
+fallback logic for unbound keys in @code{read-key-sequence} is not
+applied. This means that mouse button-down and multi-click events
+will not be discarded and @code{local-function-key-map} and
+@code{key-translation-map} will not get applied. If @code{nil} or
+unspecified, the only fallback disabled is downcasing of the last
+event.
@end defun
@defun read-char-choice prompt chars &optional inhibit-quit
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 55bcddb..80e9eb7 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -557,8 +557,9 @@ Likewise, it makes no sense to bind keyword symbols
@item (pred @var{function})
Matches if the predicate @var{function} returns non-@code{nil}
-when called on @var{expval}.
-the predicate @var{function} can have one of the following forms:
+when called on @var{expval}. The test can be negated with the syntax
+@code{(pred (not @var{function}))}.
+The predicate @var{function} can have one of the following forms:
@table @asis
@item function name (a symbol)
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index fa548b5..12255d1 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -739,6 +739,7 @@ Minibuffers
* Minibuffer Windows:: Operating on the special minibuffer windows.
* Minibuffer Contents:: How such commands access the minibuffer text.
* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
+* Inhibiting Interaction:: Running Emacs when no interaction is possible.
* Minibuffer Misc:: Various customization hooks and variables.
Completion
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index 9ec1271..fb393b9 100644
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -230,6 +230,11 @@ The message is @samp{Wrong type argument}. @xref{Type
Predicates}.
@item unknown-image-type
The message is @samp{Cannot determine image type}. @xref{Images}.
+
+@item inhibited-interaction
+The message is @samp{User interaction while inhibited}. This error is
+signalled when @code{inhibit-interaction} is non-@code{nil} and a user
+interaction function (like @code{read-from-minibuffer}) is called.
@end table
@ignore The following seem to be unused now.
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index d316c1f..0ce17ed 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -32,6 +32,7 @@ argument.
* Minibuffer Windows:: Operating on the special minibuffer windows.
* Minibuffer Contents:: How such commands access the minibuffer text.
* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
+* Inhibiting Interaction:: Running Emacs when no interaction is possible.
* Minibuffer Misc:: Various customization hooks and variables.
@end menu
@@ -2617,6 +2618,38 @@ to @code{t} in the interactive declaration (@pxref{Using
Interactive}).
The minibuffer command @code{next-matching-history-element} (normally
@kbd{M-s} in the minibuffer) does the latter.
+@node Inhibiting Interaction
+@section Inhibiting Interaction
+
+It's sometimes useful to be able to run Emacs as a headless server
+process that responds to commands given over a network connection.
+However, Emacs is primarily a platform for interactive usage, so many
+commands prompt the user for feedback in certain anomalous situations.
+This makes this use case more difficult, since the server process will
+just hang waiting for user input.
+
+@vindex inhibit-interaction
+Binding the @code{inhibit-interaction} variable to something
+non-@code{nil} makes Emacs signal a @code{inhibited-interaction} error
+instead of prompting, which can then be used by the server process to
+handle these situations.
+
+Here's a typical use case:
+
+@lisp
+(let ((inhibit-interaction t))
+ (respond-to-client
+ (condition-case err
+ (my-client-handling-function)
+ (inhibited-interaction err))))
+@end lisp
+
+If @code{my-client-handling-function} ends up calling something that
+asks the user for something (via @code{y-or-n-p} or
+@code{read-from-minibuffer} or the like), an
+@code{inhibited-interaction} error is signalled instead. The server
+code then catches that error and reports it to the client.
+
@node Minibuffer Misc
@section Minibuffer Miscellany
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 9d38fe6..abc1254 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -4241,7 +4241,7 @@ Here is an example of an indentation function:
(`(:elem . basic) sample-indent-basic)
(`(,_ . ",") (smie-rule-separator kind))
(`(:after . ":=") sample-indent-basic)
- (`(:before . ,(or `"begin" `"(" `"@{")))
+ (`(:before . ,(or `"begin" `"(" `"@{"))
(if (smie-rule-hanging-p) (smie-rule-parent)))
(`(:before . "if")
(and (not (smie-rule-bolp)) (smie-rule-prev-p "else")
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 358f6fc..2c4b792 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -443,7 +443,7 @@ are optional, in case of a missing part a default value is
assumed.
The default value for an empty local file name part is the remote
user's home directory. The shortest remote file name is
@file{@trampfn{-,,}}, therefore. The @samp{-} notation for the
-default host is used for syntactical reasons, @ref{Default Host}.
+default method is used for syntactical reasons, @ref{Default Method}.
The @code{method} part describes the connection method used to reach
the remote host, see below.
@@ -1622,6 +1622,7 @@ support this command.
@subsection Tunneling with ssh
+@vindex ProxyCommand@r{, ssh option}
With @command{ssh}, you could use the @option{ProxyCommand} entry in
@file{~/.ssh/config}:
@@ -2056,9 +2057,11 @@ default value is @t{"/data/local/tmp"} for the
@option{adb} method,
@item @t{"direct-async-process"}
When this property is non-@code{nil}, an alternative, more performant
-implementation of @code{make-process} and
-@code{start-file-process} is applied. @ref{Improving performance of
-asynchronous remote processes} for a discussion of constraints.
+implementation of @code{make-process} and @code{start-file-process} is
+applied. The connection method must also be marked with a
+non-@code{nil} @code{tramp-direct-async} parameter in
+@code{tramp-methods}. @ref{Improving performance of asynchronous
+remote processes} for a discussion of constraints.
@item @t{"posix"}
@@ -2214,6 +2217,11 @@ overwrite this, you might apply
This uses also the settings in @code{tramp-sh-extra-args}.
+@vindex RemoteCommand@r{, ssh option}
+@strong{Note}: If you use an @option{ssh}-based method for connection,
+do @emph{not} set the @option{RemoteCommand} option in your
+@command{ssh} configuration, for example to @command{screen}.
+
@subsection Other remote shell setup hints
@cindex remote shell setup
@@ -3304,6 +3312,8 @@ whatever reason, then replace @code{(getenv "DISPLAY")}
with a
hard-coded, fixed name. Note that using @code{:0} for X11 display name
here will not work as expected.
+@vindex ForwardX11@r{, ssh option}
+@vindex ForwardX11Trusted@r{, ssh option}
An alternate approach is specify @option{ForwardX11 yes} or
@option{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local
host.
@@ -3566,6 +3576,7 @@ Furthermore, this approach has the following limitations:
It works only for connection methods defined in @file{tramp-sh.el} and
@file{tramp-adb.el}.
+@vindex ControlMaster@r{, ssh option}
@item
It does not support interactive user authentication. With
@option{ssh}-based methods, this can be avoided by using a password
@@ -4269,6 +4280,7 @@ In order to disable those optimizations, set user option
@item
@value{tramp} does not recognize if a @command{ssh} session hangs
+@vindex ServerAliveInterval@r{, ssh option}
@command{ssh} sessions on the local host hang when the network is
down. @value{tramp} cannot safely detect such hangs. The network
configuration for @command{ssh} can be configured to kill such hangs
@@ -4285,6 +4297,8 @@ Host *
@item
@value{tramp} does not use default @command{ssh} @option{ControlPath}
+@vindex ControlPath@r{, ssh option}
+@vindex ControlPersist@r{, ssh option}
@value{tramp} overwrites @option{ControlPath} settings when initiating
@command{ssh} sessions. @value{tramp} does this to fend off a stall
if a master session opened outside the Emacs session is no longer
@@ -4306,8 +4320,8 @@ which allows you to set the @option{ControlPath} provided
the variable
@end group
@end lisp
-Note how "%r", "%h" and "%p" must be encoded as "%%r", "%%h" and
-"%%p".
+Note how @samp{%r}, @samp{%h} and @samp{%p} must be encoded as
+@samp{%%r}, @samp{%%h} and @samp{%%p}.
@vindex tramp-use-ssh-controlmaster-options
If the @file{~/.ssh/config} is configured appropriately for the above
@@ -4318,6 +4332,8 @@ this @code{nil} setting:
(customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
@end lisp
+@vindex ProxyCommand@r{, ssh option}
+@vindex ProxyJump@r{, ssh option}
This shall also be set to @code{nil} if you use the
@option{ProxyCommand} or @option{ProxyJump} options in your
@command{ssh} configuration.
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index 6970c46..827c477 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -8,7 +8,7 @@
@c In the Tramp GIT, the version numbers are auto-frobbed from
@c tramp.el, and the bug report address is auto-frobbed from
@c configure.ac.
-@set trampver 2.5.0
+@set trampver 2.5.1-pre
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 25.1
diff --git a/etc/HELLO b/etc/HELLO
index dec3a77..9a1f5d3 100644
--- a/etc/HELLO
+++ b/etc/HELLO
@@ -30,6 +30,8 @@ Bengali (বাংলা) নমস্কার
Braille ⠓⠑⠇⠇⠕
Burmese (မြန်မာ) မင်္ဂလာပါ
C printf ("Hello, world!\n");
+Cham (ꨌꩌ) ꨦꨤꩌ ꨦꨰꨁ
+
Cherokee (ᏣᎳᎩ ᎦᏬᏂᎯᏍᏗ) ᎣᏏᏲ / ᏏᏲ
Comanche /kəˈmæntʃiː/ Haa marʉ́awe
diff --git a/etc/NEWS b/etc/NEWS
index 7e84d69..359d308 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -326,6 +326,12 @@ the buffer cycles the whole buffer between "only top-level
headings",
* Changes in Specialized Modes and Packages in Emacs 28.1
+** pcase
++++
+*** The `pred` pattern can now take the form (pred (not FUN)).
+This is like (pred (lambda (x) (not (FUN x)))) but results
+in better code.
+
+++
** profiler.el
The results displayed by 'profiler-report' now have the usage figures
@@ -1372,6 +1378,15 @@ https://www.w3.org/TR/xml/#charsets). Now it rejects
such strings.
** erc
---
+*** erc-services.el now supports NickServ passwords from auth-source.
+The 'erc-use-auth-source-for-nickserv-password' variable enables querying
+auth-source for NickServ passwords. To enable this, add the following
+to your init file:
+
+ (setq erc-prompt-for-nickserv-password nil
+ erc-use-auth-source-for-nickserv-password t)
+
+---
*** The '/ignore' command will now ask for a timeout to stop ignoring the user.
Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m".
@@ -1528,6 +1543,15 @@ that makes it a valid button.
** Miscellaneous
+*** New function 'buffer-line-statistics'.
+This function returns some statistics about the line lengths in a buffer.
+
++++
+*** New variable 'inhibit-interaction' to make user prompts signal an error.
+If this is bound to something non-nil, functions like
+`read-from-minibuffer', `read-char' (and related) will signal an
+`inhibited-interaction' error.
+
---
*** 'process-attributes' now works under OpenBSD, too.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 25e129b..15e34ea 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -746,6 +746,11 @@ versions of gnutls-cli, or use Emacs's built-in gnutls
support.
** Characters are displayed as empty boxes or with wrong font under X.
+*** This may be due to your local fontconfig customization.
+Try removing or moving aside "$XDG_CONFIG_HOME/fontconfig/conf.d" and
+"$XDG_CONFIG_HOME/fontconfig/fonts.conf"
+($XDG_CONFIG_HOME is treated as "~/.config" if not set)
+
*** This can occur when two different versions of FontConfig are used.
For example, XFree86 4.3.0 has one version and Gnome usually comes
with a newer version. Emacs compiled with Gtk+ will then use the
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 68ae468..d684c7b 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1095,15 +1095,7 @@ Used by `calc-user-invocation'.")
(ignore-errors
(define-key calc-digit-map x 'calcDigit-delchar)
(define-key calc-mode-map x 'calc-pop)
- (define-key calc-mode-map
- (if (and (vectorp x) (featurep 'xemacs))
- (if (= (length x) 1)
- (vector (if (consp (aref x 0))
- (cons 'meta (aref x 0))
- (list 'meta (aref x 0))))
- "\e\C-d")
- (vconcat "\e" x))
- 'calc-pop-above)))
+ (define-key calc-mode-map (vconcat "\e" x) 'calc-pop-above)))
(if calc-scan-for-dels
(append (where-is-internal 'delete-forward-char global-map)
'("\C-d"))
diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el
index ee75e29..e1417d7 100644
--- a/lisp/cedet/ede/auto.el
+++ b/lisp/cedet/ede/auto.el
@@ -64,24 +64,22 @@ location is varied dependent on other complex criteria,
this class
can be used to define that match without loading the specific project
into memory.")
+(cl-defmethod ede-calc-fromconfig ((dirmatch ede-project-autoload-dirmatch))
+ "Calculate the value of :fromconfig from DIRMATCH."
+ (let* ((fc (oref dirmatch fromconfig))
+ (found (cond ((stringp fc) fc)
+ ((functionp fc) (funcall fc))
+ (t (error "Unknown dirmatch object match style.")))))
+ (expand-file-name found)
+ ))
+
(cl-defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
"Return non-nil if the tool DIRMATCH might match is installed on the system."
- (let ((fc (oref dirmatch fromconfig)))
-
- (cond
- ;; If the thing to match is stored in a config file.
- ((stringp fc)
- (file-exists-p fc))
-
- ;; Add new types of dirmatches here.
-
- ;; Error for weird stuff
- (t (error "Unknown dirmatch type.")))))
-
+ (file-exists-p (ede-calc-fromconfig dirmatch)))
(cl-defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
"Does DIRMATCH match the filename FILE."
- (let ((fc (oref dirmatch fromconfig)))
+ (let ((fc (ede-calc-fromconfig dirmatch)))
(cond
;; If the thing to match is stored in a config file.
diff --git a/lisp/comint.el b/lisp/comint.el
index 2e683a7..53153af 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -979,6 +979,7 @@ See also `comint-input-ignoredups' and
`comint-write-input-ring'."
(ring (make-ring ring-size))
;; Use possibly buffer-local values of these variables.
(ring-separator comint-input-ring-separator)
+ (ring-file-prefix comint-input-ring-file-prefix)
(history-ignore comint-input-history-ignore)
(ignoredups comint-input-ignoredups))
(with-temp-buffer
@@ -990,24 +991,15 @@ See also `comint-input-ignoredups' and
`comint-write-input-ring'."
(while (and (< count comint-input-ring-size)
(re-search-backward ring-separator nil t)
(setq end (match-beginning 0)))
- (setq start
- (if (re-search-backward ring-separator nil t)
- (progn
- (when (and comint-input-ring-file-prefix
- (looking-at
- comint-input-ring-file-prefix))
- ;; Skip zsh extended_history stamps
- (goto-char (match-end 0)))
- (match-end 0))
- (progn
- (goto-char (point-min))
- (when (and comint-input-ring-file-prefix
- (looking-at
- comint-input-ring-file-prefix))
- (goto-char (match-end 0)))
- (point))))
+ (goto-char (if (re-search-backward ring-separator nil t)
+ (match-end 0)
+ (point-min)))
+ (when (and ring-file-prefix
+ (looking-at ring-file-prefix))
+ ;; Skip zsh extended_history stamps
+ (goto-char (match-end 0)))
+ (setq start (point))
(setq history (buffer-substring start end))
- (goto-char start)
(when (and (not (string-match history-ignore history))
(or (null ignoredups)
(ring-empty-p ring)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 5dcb284..21fe89c 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -175,6 +175,7 @@
(choice :tag "Style"
(const :tag "Raised" released-button)
(const :tag "Sunken" pressed-button)
+ (const :tag "Flat" flat-button)
(const :tag "None" nil))))
;; filter to make value suitable for customize
(lambda (real-value)
diff --git a/lisp/custom.el b/lisp/custom.el
index 0c82df9..58ecd04 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -136,6 +136,9 @@ to include all of it." ; see eg
vc-sccs-search-project-dir
;; No longer true:
;; "See `send-mail-function' in sendmail.el for an example."
+ ;; Defvar it so as to mark it special, etc (bug#25770).
+ (internal--define-uninitialized-variable symbol)
+
;; Until the var is actually initialized, it is kept unbound.
;; This seemed to be at least as good as setting it to an arbitrary
;; value like nil (evaluating `value' is not an option because it
@@ -780,8 +783,7 @@ Return non-nil if the `customized-value' property actually
changed."
Use the :set function to do so. This is useful for customizable options
that are defined before their standard value can really be computed.
E.g. dumped variables whose default depends on run-time information."
- ;; If it has never been set at all, defvar it so as to mark it
- ;; special, etc (bug#25770). This means we are initializing
+ ;; We are initializing
;; the variable, and normally any :set function would not apply.
;; For custom-initialize-delay, however, it is documented that "the
;; (delayed) initialization is performed with the :set function".
@@ -789,11 +791,10 @@ E.g. dumped variables whose default depends on run-time
information."
;; custom-initialize-delay but needs the :set function custom-set-minor-mode
;; to also run during initialization. So, long story short, we
;; always do the funcall step, even if symbol was not bound before.
- (or (default-boundp symbol)
- (eval `(defvar ,symbol nil))) ; reset below, so any value is fine
(funcall (or (get symbol 'custom-set) #'set-default)
symbol
- (eval (car (or (get symbol 'saved-value) (get symbol
'standard-value))))))
+ (eval (car (or (get symbol 'saved-value)
+ (get symbol 'standard-value))))))
;;; Custom Themes
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 5a52ecc..aebffe3 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -1483,7 +1483,7 @@ a prefix argument, when it offers the filename near point
as a default."
;;; Internal functions.
;; Fixme: This should probably use `thing-at-point'. -- fx
-(define-obsolete-function-alias 'dired-filename-at-point
+(define-obsolete-function-alias 'dired-file-name-at-point
#'dired-x-guess-file-name-at-point "28.1")
(defun dired-x-guess-file-name-at-point ()
"Return the filename closest to point, expanded.
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index cf89456..f29f85b 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -374,185 +374,184 @@
;; the important aspect is that they are subrs that don't evaluate all of
;; their args.)
;;
- (let ((fn (car-safe form))
- tmp)
- (cond ((not (consp form))
- (if (not (and for-effect
- (or byte-compile-delete-errors
- (not (symbolp form))
- (eq form t))))
- form))
- ((eq fn 'quote)
- (if (cdr (cdr form))
- (byte-compile-warn "malformed quote form: `%s'"
- (prin1-to-string form)))
- ;; map (quote nil) to nil to simplify optimizer logic.
- ;; map quoted constants to nil if for-effect (just because).
- (and (nth 1 form)
- (not for-effect)
- form))
- ((memq fn '(let let*))
- ;; recursively enter the optimizer for the bindings and body
- ;; of a let or let*. This for depth-firstness: forms that
- ;; are more deeply nested are optimized first.
- (cons fn
+ ;; FIXME: There are a bunch of `byte-compile-warn' here which arguably
+ ;; have no place in an optimizer: the corresponding tests should be
+ ;; performed in `macroexpand-all', or in `cconv', or in `bytecomp'.
+ (let ((fn (car-safe form)))
+ (pcase form
+ ((pred (not consp))
+ (if (not (and for-effect
+ (or byte-compile-delete-errors
+ (not (symbolp form))
+ (eq form t))))
+ form))
+ (`(quote . ,v)
+ (if (cdr v)
+ (byte-compile-warn "malformed quote form: `%s'"
+ (prin1-to-string form)))
+ ;; Map (quote nil) to nil to simplify optimizer logic.
+ ;; Map quoted constants to nil if for-effect (just because).
+ (and (car v)
+ (not for-effect)
+ form))
+ (`(,(or 'let 'let*) . ,(or `(,bindings . ,exps) pcase--dontcare))
+ ;; Recursively enter the optimizer for the bindings and body
+ ;; of a let or let*. This for depth-firstness: forms that
+ ;; are more deeply nested are optimized first.
+ (cons fn
(cons
(mapcar (lambda (binding)
- (if (symbolp binding)
- binding
- (if (cdr (cdr binding))
- (byte-compile-warn "malformed let binding: `%s'"
- (prin1-to-string binding)))
- (list (car binding)
- (byte-optimize-form (nth 1 binding) nil))))
- (nth 1 form))
- (byte-optimize-body (cdr (cdr form)) for-effect))))
- ((eq fn 'cond)
- (cons fn
- (mapcar (lambda (clause)
- (if (consp clause)
- (cons
- (byte-optimize-form (car clause) nil)
- (byte-optimize-body (cdr clause) for-effect))
- (byte-compile-warn "malformed cond form: `%s'"
- (prin1-to-string clause))
- clause))
- (cdr form))))
- ((eq fn 'progn)
- ;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
- (if (cdr (cdr form))
- (macroexp-progn (byte-optimize-body (cdr form) for-effect))
- (byte-optimize-form (nth 1 form) for-effect)))
- ((eq fn 'prog1)
- (if (cdr (cdr form))
- (cons 'prog1
- (cons (byte-optimize-form (nth 1 form) for-effect)
- (byte-optimize-body (cdr (cdr form)) t)))
- (byte-optimize-form (nth 1 form) for-effect)))
-
- ((memq fn '(save-excursion save-restriction save-current-buffer))
- ;; those subrs which have an implicit progn; it's not quite good
- ;; enough to treat these like normal function calls.
- ;; This can turn (save-excursion ...) into (save-excursion) which
- ;; will be optimized away in the lap-optimize pass.
- (cons fn (byte-optimize-body (cdr form) for-effect)))
-
- ((eq fn 'if)
- (when (< (length form) 3)
- (byte-compile-warn "too few arguments for `if'"))
- (cons fn
- (cons (byte-optimize-form (nth 1 form) nil)
- (cons
- (byte-optimize-form (nth 2 form) for-effect)
- (byte-optimize-body (nthcdr 3 form) for-effect)))))
-
- ((memq fn '(and or)) ; Remember, and/or are control structures.
- ;; Take forms off the back until we can't any more.
- ;; In the future it could conceivably be a problem that the
- ;; subexpressions of these forms are optimized in the reverse
- ;; order, but it's ok for now.
- (if for-effect
- (let ((backwards (reverse (cdr form))))
- (while (and backwards
- (null (setcar backwards
- (byte-optimize-form (car backwards)
- for-effect))))
- (setq backwards (cdr backwards)))
- (if (and (cdr form) (null backwards))
- (byte-compile-log
- " all subforms of %s called for effect; deleted" form))
- (and backwards
- (cons fn (nreverse (mapcar 'byte-optimize-form
- backwards)))))
- (cons fn (mapcar 'byte-optimize-form (cdr form)))))
-
- ((eq fn 'while)
- (unless (consp (cdr form))
- (byte-compile-warn "too few arguments for `while'"))
- (cons fn
- (cons (byte-optimize-form (cadr form) nil)
- (byte-optimize-body (cddr form) t))))
-
- ((eq fn 'interactive)
- (byte-compile-warn "misplaced interactive spec: `%s'"
- (prin1-to-string form))
- nil)
-
- ((eq fn 'function)
- ;; This forms is compiled as constant or by breaking out
- ;; all the subexpressions and compiling them separately.
- form)
-
- ((eq fn 'condition-case)
- `(condition-case ,(nth 1 form) ;Not evaluated.
- ,(byte-optimize-form (nth 2 form) for-effect)
- ,@(mapcar (lambda (clause)
- `(,(car clause)
- ,@(byte-optimize-body (cdr clause) for-effect)))
- (nthcdr 3 form))))
-
- ((eq fn 'unwind-protect)
- ;; the "protected" part of an unwind-protect is compiled (and thus
- ;; optimized) as a top-level form, so don't do it here. But the
- ;; non-protected part has the same for-effect status as the
- ;; unwind-protect itself. (The protected part is always for effect,
- ;; but that isn't handled properly yet.)
- (cons fn
- (cons (byte-optimize-form (nth 1 form) for-effect)
- (cdr (cdr form)))))
-
- ((eq fn 'catch)
- (cons fn
- (cons (byte-optimize-form (nth 1 form) nil)
- (byte-optimize-body (cdr form) for-effect))))
-
- ((eq fn 'ignore)
- ;; Don't treat the args to `ignore' as being
- ;; computed for effect. We want to avoid the warnings
- ;; that might occur if they were treated that way.
- ;; However, don't actually bother calling `ignore'.
- `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form))))
-
- ;; Needed as long as we run byte-optimize-form after cconv.
- ((eq fn 'internal-make-closure) form)
-
- ((eq (car-safe fn) 'lambda)
- (let ((newform (byte-compile-unfold-lambda form)))
- (if (eq newform form)
- ;; Some error occurred, avoid infinite recursion
- form
- (byte-optimize-form newform for-effect))))
-
- ((eq (car-safe fn) 'closure) form)
-
- ((byte-code-function-p fn)
- (cons fn (mapcar #'byte-optimize-form (cdr form))))
-
- ((not (symbolp fn))
- (byte-compile-warn "`%s' is a malformed function"
- (prin1-to-string fn))
- form)
-
- ((and for-effect (setq tmp (get fn 'side-effect-free))
- (or byte-compile-delete-errors
- (eq tmp 'error-free)
- (progn
- (byte-compile-warn "value returned from %s is unused"
- (prin1-to-string form))
- nil)))
- (byte-compile-log " %s called for effect; deleted" fn)
- ;; appending a nil here might not be necessary, but it can't hurt.
- (byte-optimize-form
- (cons 'progn (append (cdr form) '(nil))) t))
+ (if (symbolp binding)
+ binding
+ (if (cdr (cdr binding))
+ (byte-compile-warn "malformed let binding: `%s'"
+ (prin1-to-string binding)))
+ (list (car binding)
+ (byte-optimize-form (nth 1 binding) nil))))
+ bindings)
+ (byte-optimize-body exps for-effect))))
+ (`(cond . ,clauses)
+ (cons fn
+ (mapcar (lambda (clause)
+ (if (consp clause)
+ (cons
+ (byte-optimize-form (car clause) nil)
+ (byte-optimize-body (cdr clause) for-effect))
+ (byte-compile-warn "malformed cond form: `%s'"
+ (prin1-to-string clause))
+ clause))
+ clauses)))
+ (`(progn . ,exps)
+ ;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
+ (if (cdr exps)
+ (macroexp-progn (byte-optimize-body exps for-effect))
+ (byte-optimize-form (car exps) for-effect)))
+ (`(prog1 . ,(or `(,exp . ,exps) pcase--dontcare))
+ (if exps
+ `(prog1 ,(byte-optimize-form exp for-effect)
+ . ,(byte-optimize-body exps t))
+ (byte-optimize-form exp for-effect)))
+
+ (`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps)
+ ;; Those subrs which have an implicit progn; it's not quite good
+ ;; enough to treat these like normal function calls.
+ ;; This can turn (save-excursion ...) into (save-excursion) which
+ ;; will be optimized away in the lap-optimize pass.
+ (cons fn (byte-optimize-body exps for-effect)))
+
+ (`(if ,test ,then . ,else)
+ `(if ,(byte-optimize-form test nil)
+ ,(byte-optimize-form then for-effect)
+ . ,(byte-optimize-body else for-effect)))
+ (`(if . ,_)
+ (byte-compile-warn "too few arguments for `if'"))
+
+ (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures.
+ ;; Take forms off the back until we can't any more.
+ ;; In the future it could conceivably be a problem that the
+ ;; subexpressions of these forms are optimized in the reverse
+ ;; order, but it's ok for now.
+ (if for-effect
+ (let ((backwards (reverse exps)))
+ (while (and backwards
+ (null (setcar backwards
+ (byte-optimize-form (car backwards)
+ for-effect))))
+ (setq backwards (cdr backwards)))
+ (if (and exps (null backwards))
+ (byte-compile-log
+ " all subforms of %s called for effect; deleted" form))
+ (and backwards
+ (cons fn (nreverse (mapcar #'byte-optimize-form
+ backwards)))))
+ (cons fn (mapcar #'byte-optimize-form exps))))
+
+ (`(while ,exp . ,exps)
+ `(while ,(byte-optimize-form exp nil)
+ . ,(byte-optimize-body exps t)))
+ (`(while . ,_)
+ (byte-compile-warn "too few arguments for `while'"))
+
+ (`(interactive . ,_)
+ (byte-compile-warn "misplaced interactive spec: `%s'"
+ (prin1-to-string form))
+ nil)
+
+ (`(function . ,_)
+ ;; This forms is compiled as constant or by breaking out
+ ;; all the subexpressions and compiling them separately.
+ form)
- (t
- ;; Otherwise, no args can be considered to be for-effect,
- ;; even if the called function is for-effect, because we
- ;; don't know anything about that function.
- (let ((form (cons fn (mapcar #'byte-optimize-form (cdr form)))))
- (if (get fn 'pure)
- (byte-optimize-constant-args form)
- form))))))
+ (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare))
+ `(condition-case ,var ;Not evaluated.
+ ,(byte-optimize-form exp for-effect)
+ ,@(mapcar (lambda (clause)
+ `(,(car clause)
+ ,@(byte-optimize-body (cdr clause) for-effect)))
+ clauses)))
+
+ (`(unwind-protect . ,(or `(,exp . ,exps) pcase--dontcare))
+ ;; The "protected" part of an unwind-protect is compiled (and thus
+ ;; optimized) as a top-level form, so don't do it here. But the
+ ;; non-protected part has the same for-effect status as the
+ ;; unwind-protect itself. (The protected part is always for effect,
+ ;; but that isn't handled properly yet.)
+ `(unwind-protect ,(byte-optimize-form exp for-effect) . ,exps))
+
+ (`(catch . ,(or `(,tag . ,exps) pcase--dontcare))
+ `(catch ,(byte-optimize-form tag nil)
+ . ,(byte-optimize-body exps for-effect)))
+
+ (`(ignore . ,exps)
+ ;; Don't treat the args to `ignore' as being
+ ;; computed for effect. We want to avoid the warnings
+ ;; that might occur if they were treated that way.
+ ;; However, don't actually bother calling `ignore'.
+ `(prog1 nil . ,(mapcar #'byte-optimize-form exps)))
+
+ ;; Needed as long as we run byte-optimize-form after cconv.
+ (`(internal-make-closure . ,_) form)
+
+ (`((lambda . ,_) . ,_)
+ (let ((newform (byte-compile-unfold-lambda form)))
+ (if (eq newform form)
+ ;; Some error occurred, avoid infinite recursion.
+ form
+ (byte-optimize-form newform for-effect))))
+
+ ;; FIXME: Strictly speaking, I think this is a bug: (closure...)
+ ;; is a *value* and shouldn't appear in the car.
+ (`((closure . ,_) . ,_) form)
+
+ (`(,(pred byte-code-function-p) . ,exps)
+ (cons fn (mapcar #'byte-optimize-form exps)))
+
+ (`(,(pred (not symbolp)) . ,_)
+ (byte-compile-warn "`%s' is a malformed function"
+ (prin1-to-string fn))
+ form)
+
+ ((guard (when for-effect
+ (if-let ((tmp (get fn 'side-effect-free)))
+ (or byte-compile-delete-errors
+ (eq tmp 'error-free)
+ (progn
+ (byte-compile-warn "value returned from %s is unused"
+ (prin1-to-string form))
+ nil)))))
+ (byte-compile-log " %s called for effect; deleted" fn)
+ ;; appending a nil here might not be necessary, but it can't hurt.
+ (byte-optimize-form
+ (cons 'progn (append (cdr form) '(nil))) t))
+
+ (_
+ ;; Otherwise, no args can be considered to be for-effect,
+ ;; even if the called function is for-effect, because we
+ ;; don't know anything about that function.
+ (let ((form (cons fn (mapcar #'byte-optimize-form (cdr form)))))
+ (if (get fn 'pure)
+ (byte-optimize-constant-args form)
+ form))))))
(defun byte-optimize-form (form &optional for-effect)
"The source-level pass of the optimizer."
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 4ba72ae..ec1077d 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -162,6 +162,59 @@ only one object ever exists."
old)))
+;;; Named object
+
+(defclass eieio-named ()
+ ((object-name :initarg :object-name :initform nil))
+ "Object with a name."
+ :abstract t)
+
+(cl-defmethod eieio-object-name-string ((obj eieio-named))
+ "Return a string which is OBJ's name."
+ (or (slot-value obj 'object-name)
+ (cl-call-next-method)))
+
+(cl-defgeneric eieio-object-set-name-string (obj name)
+ "Set the string which is OBJ's NAME."
+ (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ
\\='object-name) NAME) instead" "25.1"))
+ (cl-check-type name string)
+ (setf (gethash obj eieio--object-names) name))
+(define-obsolete-function-alias
+ 'object-set-name-string 'eieio-object-set-name-string "24.4")
+
+(with-suppressed-warnings ((obsolete eieio-object-set-name-string))
+ (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
+ "Set the string which is OBJ's NAME."
+ (cl-check-type name string)
+ (eieio-oset obj 'object-name name)))
+
+(cl-defmethod clone ((obj eieio-named) &rest params)
+ "Clone OBJ, initializing `:parent' to OBJ.
+All slots are unbound, except those initialized with PARAMS."
+ (let* ((newname (and (stringp (car params)) (pop params)))
+ (nobj (apply #'cl-call-next-method obj params))
+ (nm (slot-value nobj 'object-name)))
+ (eieio-oset nobj 'object-name
+ (or newname
+ (if (equal nm (slot-value obj 'object-name))
+ (save-match-data
+ (if (and nm (string-match "-\\([0-9]+\\)" nm))
+ (let ((num (1+ (string-to-number
+ (match-string 1 nm)))))
+ (concat (substring nm 0 (match-beginning 0))
+ "-" (int-to-string num)))
+ (concat nm "-1")))
+ nm)))
+ nobj))
+
+(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
+ (if (not (stringp (car args)))
+ (cl-call-next-method)
+ (funcall (if eieio-backward-compatibility #'ignore #'message)
+ "Obsolete: name passed without :object-name to %S constructor"
+ class)
+ (apply #'cl-call-next-method class :object-name args)))
+
;;; eieio-persistent
;;
;; For objects which must save themselves to disk. Provides an
@@ -264,12 +317,17 @@ objects found there."
(:method
((objclass (subclass eieio-default-superclass)) inputlist)
- (let ((slots (if (stringp (car inputlist))
- ;; Earlier versions of `object-write' added a
- ;; string name for the object, now obsolete.
- (cdr inputlist)
- inputlist))
- (createslots nil))
+ (let* ((name nil)
+ (slots (if (stringp (car inputlist))
+ (progn
+ ;; Earlier versions of `object-write' added a
+ ;; string name for the object, now obsolete.
+ ;; Save as 'name' in case this object is subclass
+ ;; of eieio-named with no :object-name slot specified.
+ (setq name (car inputlist))
+ (cdr inputlist))
+ inputlist))
+ (createslots nil))
;; If OBJCLASS is an eieio autoload object, then we need to
;; load it (we don't need the return value).
(eieio--full-class-object objclass)
@@ -286,7 +344,17 @@ objects found there."
(setq slots (cdr (cdr slots))))
- (apply #'make-instance objclass (nreverse createslots)))))
+ (let ((newobj (apply #'make-instance objclass (nreverse createslots))))
+
+ ;; Check for special case of subclass of `eieio-named', and do
+ ;; name assignment.
+ (when (and eieio-backward-compatibility
+ (object-of-class-p newobj 'eieio-named)
+ (not (oref newobj object-name))
+ name)
+ (oset newobj object-name name))
+
+ newobj))))
(defun eieio-persistent-fix-value (proposed-value)
"Fix PROPOSED-VALUE.
@@ -408,59 +476,6 @@ instance."
;; It should also set up some hooks to help it keep itself up to date.
-;;; Named object
-
-(defclass eieio-named ()
- ((object-name :initarg :object-name :initform nil))
- "Object with a name."
- :abstract t)
-
-(cl-defmethod eieio-object-name-string ((obj eieio-named))
- "Return a string which is OBJ's name."
- (or (slot-value obj 'object-name)
- (cl-call-next-method)))
-
-(cl-defgeneric eieio-object-set-name-string (obj name)
- "Set the string which is OBJ's NAME."
- (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ
\\='object-name) NAME) instead" "25.1"))
- (cl-check-type name string)
- (setf (gethash obj eieio--object-names) name))
-(define-obsolete-function-alias
- 'object-set-name-string 'eieio-object-set-name-string "24.4")
-
-(with-suppressed-warnings ((obsolete eieio-object-set-name-string))
- (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
- "Set the string which is OBJ's NAME."
- (cl-check-type name string)
- (eieio-oset obj 'object-name name)))
-
-(cl-defmethod clone ((obj eieio-named) &rest params)
- "Clone OBJ, initializing `:parent' to OBJ.
-All slots are unbound, except those initialized with PARAMS."
- (let* ((newname (and (stringp (car params)) (pop params)))
- (nobj (apply #'cl-call-next-method obj params))
- (nm (slot-value nobj 'object-name)))
- (eieio-oset nobj 'object-name
- (or newname
- (if (equal nm (slot-value obj 'object-name))
- (save-match-data
- (if (and nm (string-match "-\\([0-9]+\\)" nm))
- (let ((num (1+ (string-to-number
- (match-string 1 nm)))))
- (concat (substring nm 0 (match-beginning 0))
- "-" (int-to-string num)))
- (concat nm "-1")))
- nm)))
- nobj))
-
-(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
- (if (not (stringp (car args)))
- (cl-call-next-method)
- (funcall (if eieio-backward-compatibility #'ignore #'message)
- "Obsolete: name passed without :object-name to %S constructor"
- class)
- (apply #'cl-call-next-method class :object-name args)))
-
(provide 'eieio-base)
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 5851754..fdbf953 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -487,7 +487,7 @@ Errors during evaluation are caught and handled like nil."
Returns nil if they are."
(if (not (eq (type-of a) (type-of b)))
`(different-types ,a ,b)
- (pcase-exhaustive a
+ (pcase a
((pred consp)
(let ((a-length (proper-list-p a))
(b-length (proper-list-p b)))
@@ -538,7 +538,7 @@ Returns nil if they are."
for xi = (ert--explain-equal-rec ai bi)
do (when xi (cl-return `(array-elt ,i ,xi)))
finally (cl-assert (equal a b) t))))
- ((pred atom)
+ (_
(if (not (equal a b))
(if (and (symbolp a) (symbolp b) (string= a b))
`(different-symbols-with-the-same-name ,a ,b)
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 72ea1ba..bfd577c 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -39,10 +39,10 @@
;; - along these lines, provide patterns to match CL structs.
;; - provide something like (setq VAR) so a var can be set rather than
;; let-bound.
-;; - provide a way to fallthrough to subsequent cases (not sure what I meant by
-;; this :-()
+;; - provide a way to fallthrough to subsequent cases
+;; (e.g. Like Racket's (=> ID).
;; - try and be more clever to reduce the size of the decision tree, and
-;; to reduce the number of leaves that need to be turned into function:
+;; to reduce the number of leaves that need to be turned into functions:
;; - first, do the tests shared by all remaining branches (it will have
;; to be performed anyway, so better do it first so it's shared).
;; - then choose the test that discriminates more (?).
@@ -97,11 +97,15 @@
(declare-function get-edebug-spec "edebug" (symbol))
(declare-function edebug-match "edebug" (cursor specs))
+(defun pcase--get-macroexpander (s)
+ "Return the macroexpander for pcase pattern head S, or nil"
+ (get s 'pcase-macroexpander))
+
(defun pcase--edebug-match-macro (cursor)
(let (specs)
(mapatoms
(lambda (s)
- (let ((m (get s 'pcase-macroexpander)))
+ (let ((m (pcase--get-macroexpander s)))
(when (and m (get-edebug-spec m))
(push (cons (symbol-name s) (get-edebug-spec m))
specs)))))
@@ -128,6 +132,7 @@ PATTERN matches. PATTERN can take one of the forms:
If a SYMBOL is used twice in the same pattern
the second occurrence becomes an `eq'uality test.
(pred FUN) matches if FUN called on EXPVAL returns non-nil.
+ (pred (not FUN)) matches if FUN called on EXPVAL returns nil.
(app FUN PAT) matches if FUN called on EXPVAL matches PAT.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
(let PAT EXPR) matches if EXPR matches PAT.
@@ -193,7 +198,7 @@ Emacs Lisp manual for more information and examples."
(let (more)
;; Collect all the extensions.
(mapatoms (lambda (symbol)
- (let ((me (get symbol 'pcase-macroexpander)))
+ (let ((me (pcase--get-macroexpander symbol)))
(when me
(push (cons symbol me)
more)))))
@@ -424,7 +429,7 @@ of the elements of LIST is performed as if by `pcase-let'.
((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat)))
((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
(t
- (let* ((expander (get head 'pcase-macroexpander))
+ (let* ((expander (pcase--get-macroexpander head))
(npat (if expander (apply expander (cdr pat)))))
(if (null npat)
(error (if expander
@@ -658,6 +663,14 @@ MATCH is the pattern that needs to be matched, of the form:
'(:pcase--succeed . nil))))
(defun pcase--split-pred (vars upat pat)
+ "Indicate the overlap or mutual-exclusion between UPAT and PAT.
+More specifically retuns a pair (A . B) where A indicates whether PAT
+can match when UPAT has matched, and B does the same for the case
+where UPAT failed to match.
+A and B can be one of:
+- nil if we don't know
+- `:pcase--fail' if UPAT match's result implies that PAT can't match
+- `:pcase--succeed' if UPAT match's result implies that PAT matches"
(let (test)
(cond
((and (equal upat pat)
@@ -670,6 +683,19 @@ MATCH is the pattern that needs to be matched, of the form:
;; and catch at least the easy cases such as (bug#14773).
(not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
'(:pcase--succeed . :pcase--fail))
+ ;; In case UPAT is of the form (pred (not PRED))
+ ((and (eq 'pred (car upat)) (eq 'not (car-safe (cadr upat))))
+ (let* ((test (cadr (cadr upat)))
+ (res (pcase--split-pred vars `(pred ,test) pat)))
+ (cons (cdr res) (car res))))
+ ;; In case PAT is of the form (pred (not PRED))
+ ((and (eq 'pred (car-safe pat)) (eq 'not (car-safe (cadr pat))))
+ (let* ((test (cadr (cadr pat)))
+ (res (pcase--split-pred vars upat `(pred ,test)))
+ (reverse (lambda (x) (cond ((eq x :pcase--succeed) :pcase--fail)
+ ((eq x :pcase--fail) :pcase--succeed)))))
+ (cons (funcall reverse (car res))
+ (funcall reverse (cdr res)))))
((and (eq 'pred (car upat))
(let ((otherpred
(cond ((eq 'pred (car-safe pat)) (cadr pat))
@@ -728,8 +754,10 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--funcall (fun arg vars)
"Build a function call to FUN with arg ARG."
- (if (symbolp fun)
- `(,fun ,arg)
+ (cond
+ ((symbolp fun) `(,fun ,arg))
+ ((eq 'not (car-safe fun)) `(not ,(pcase--funcall (cadr fun) arg vars)))
+ (t
(let* (;; `env' is an upper bound on the bindings we need.
(env (mapcar (lambda (x) (list (car x) (cdr x)))
(macroexp--fgrep vars fun)))
@@ -747,7 +775,7 @@ MATCH is the pattern that needs to be matched, of the form:
;; Let's not replace `vars' in `fun' since it's
;; too difficult to do it right, instead just
;; let-bind `vars' around `fun'.
- `(let* ,env ,call)))))
+ `(let* ,env ,call))))))
(defun pcase--eval (exp vars)
"Build an expression that will evaluate EXP."
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
index 6a483a6..0905ac6 100644
--- a/lisp/emacs-lisp/radix-tree.el
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -198,9 +198,10 @@ If not found, return nil."
(pcase-defmacro radix-tree-leaf (vpat)
"Pattern which matches a radix-tree leaf.
The pattern VPAT is matched against the leaf's carried value."
- ;; FIXME: We'd like to use a negative pattern (not consp), but pcase
- ;; doesn't support it. Using `atom' works but generates sub-optimal code.
- `(or `(t . ,,vpat) (and (pred atom) ,vpat))))
+ ;; We used to use `(pred atom)', but `pcase' doesn't understand that
+ ;; `atom' is equivalent to the negation of `consp' and hence generates
+ ;; suboptimal code.
+ `(or `(t . ,,vpat) (and (pred (not consp)) ,vpat))))
(defun radix-tree-iter-subtrees (tree fun)
"Apply FUN to every immediate subtree of radix TREE.
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 4f9b0b1..9ef8b7f 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -168,8 +168,19 @@ You can also use \\[erc-nickserv-identify-mode] to change
modes."
:group 'erc-services
:type 'boolean)
+(defcustom erc-use-auth-source-for-nickserv-password nil
+ "Query auth-source for a password when identifiying to NickServ.
+This option has an no effect if `erc-prompt-for-nickserv-password'
+is non-nil, and passwords from `erc-nickserv-passwords' take
+precedence."
+ :version "28.1"
+ :group 'erc-services
+ :type 'boolean)
+
(defcustom erc-nickserv-passwords nil
"Passwords used when identifying to NickServ automatically.
+`erc-prompt-for-nickserv-password' must be nil for these
+passwords to be used.
Example of use:
(setq erc-nickserv-passwords
@@ -375,7 +386,8 @@ Make sure it is the real NickServ for this network.
If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the
password for this nickname, otherwise try to send it automatically."
(unless (and (null erc-nickserv-passwords)
- (null erc-prompt-for-nickserv-password))
+ (null erc-prompt-for-nickserv-password)
+ (null erc-use-auth-source-for-nickserv-password))
(let* ((network (erc-network))
(sender (erc-nickserv-alist-sender network))
(identify-regex (erc-nickserv-alist-regexp network))
@@ -394,30 +406,49 @@ password for this nickname, otherwise try to send it
automatically."
(defun erc-nickserv-identify-on-connect (_server nick)
"Identify to Nickserv after the connection to the server is established."
(unless (or (and (null erc-nickserv-passwords)
- (null erc-prompt-for-nickserv-password))
- (and (eq erc-nickserv-identify-mode 'both)
- (erc-nickserv-alist-regexp (erc-network))))
+ (null erc-prompt-for-nickserv-password)
+ (null erc-use-auth-source-for-nickserv-password))
+ (and (eq erc-nickserv-identify-mode 'both)
+ (erc-nickserv-alist-regexp (erc-network))))
(erc-nickserv-call-identify-function nick)))
(defun erc-nickserv-identify-on-nick-change (nick _old-nick)
"Identify to Nickserv whenever your nick changes."
(unless (or (and (null erc-nickserv-passwords)
- (null erc-prompt-for-nickserv-password))
- (and (eq erc-nickserv-identify-mode 'both)
- (erc-nickserv-alist-regexp (erc-network))))
+ (null erc-prompt-for-nickserv-password)
+ (null erc-use-auth-source-for-nickserv-password))
+ (and (eq erc-nickserv-identify-mode 'both)
+ (erc-nickserv-alist-regexp (erc-network))))
(erc-nickserv-call-identify-function nick)))
+(defun erc-nickserv-get-password (nickname)
+ "Return the password for NICKNAME from configured sources.
+
+It uses `erc-nickserv-passwords' and additionally auth-source
+when `erc-use-auth-source-for-nickserv-password' is not nil."
+ (or
+ (when erc-nickserv-passwords
+ (cdr (assoc nickname
+ (nth 1 (assoc (erc-network)
+ erc-nickserv-passwords)))))
+ (when erc-use-auth-source-for-nickserv-password
+ (let* ((secret (nth 0 (auth-source-search
+ :max 1 :require '(:secret)
+ :host (erc-with-server-buffer erc-session-server)
+ :port (format ; ensure we have a string
+ "%s" (erc-with-server-buffer
erc-session-port))
+ :user nickname))))
+ (when secret
+ (let ((passwd (plist-get secret :secret)))
+ (if (functionp passwd) (funcall passwd) passwd)))))))
+
(defun erc-nickserv-call-identify-function (nickname)
"Call `erc-nickserv-identify'.
Either call it interactively or run it with NICKNAME's password,
depending on the value of `erc-prompt-for-nickserv-password'."
(if erc-prompt-for-nickserv-password
(call-interactively 'erc-nickserv-identify)
- (when erc-nickserv-passwords
- (erc-nickserv-identify
- (cdr (assoc nickname
- (nth 1 (assoc (erc-network)
- erc-nickserv-passwords))))))))
+ (erc-nickserv-identify (erc-nickserv-get-password nickname))))
(defvar erc-auto-discard-away)
@@ -451,6 +482,7 @@ When called interactively, read the password using
`read-passwd'."
(provide 'erc-services)
+
;;; erc-services.el ends here
;;
;; Local Variables:
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 771b81e..4c479d6 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -487,7 +487,7 @@ What happens depends on the number of mouse clicks:-
Signal an error if the final event isn't the same type as the first one."
(let ((initial-event-type (event-basic-type event)))
(while (null (sit-for (/ double-click-time 1000.0) 'nodisplay))
- (setq event (read-event)))
+ (setq event (read--potential-mouse-event)))
(or (eq initial-event-type (event-basic-type event))
(error "")))
event)
diff --git a/lisp/frame.el b/lisp/frame.el
index c712762..e2d7f21 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -2557,7 +2557,7 @@ command starts, by installing a pre-command hook."
;; blink-cursor-end is not added to pre-command-hook.
(setq blink-cursor-blinks-done 1)
(blink-cursor--start-timer)
- (add-hook 'pre-command-hook 'blink-cursor-end)
+ (add-hook 'pre-command-hook #'blink-cursor-end)
(internal-show-cursor nil nil)))
(defun blink-cursor-timer-function ()
@@ -2572,14 +2572,14 @@ command starts, by installing a pre-command hook."
(when (and (> blink-cursor-blinks 0)
(<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
(blink-cursor-suspend)
- (add-hook 'post-command-hook 'blink-cursor-check)))
+ (add-hook 'post-command-hook #'blink-cursor-check)))
(defun blink-cursor-end ()
"Stop cursor blinking.
This is installed as a pre-command hook by `blink-cursor-start'.
When run, it cancels the timer `blink-cursor-timer' and removes
itself as a pre-command hook."
- (remove-hook 'pre-command-hook 'blink-cursor-end)
+ (remove-hook 'pre-command-hook #'blink-cursor-end)
(internal-show-cursor nil t)
(when blink-cursor-timer
(cancel-timer blink-cursor-timer)
@@ -2648,7 +2648,7 @@ terminals, cursor blinking is controlled by the terminal."
(when blink-cursor-mode
(add-function :after after-focus-change-function
#'blink-cursor--rescan-frames)
(add-hook 'after-delete-frame-functions #'blink-cursor--rescan-frames)
- (blink-cursor--start-idle-timer)))
+ (blink-cursor-check)))
;; Frame maximization/fullscreen
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 44f43b0..5c6a5b9 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -1036,7 +1036,7 @@ Responsible for handling and, or, and parenthetical
expressions.")
'(body cc bcc from header keyword larger smaller subject text to uid x-gm-raw
answered before deleted draft flagged on since recent seen sentbefore
senton sentsince unanswered undeleted undraft unflagged unkeyword
- unseen all)
+ unseen all old new or not)
"Known IMAP search keys.")
;; imap interface
@@ -1072,10 +1072,11 @@ Responsible for handling and, or, and parenthetical
expressions.")
;; A bit of backward-compatibility slash convenience: if the
;; query string doesn't start with any known IMAP search
;; keyword, assume it is a "TEXT" search.
- (unless (and (string-match "\\`[^[:blank:]]+" q-string)
- (memql (intern-soft (downcase
- (match-string 0 q-string)))
- gnus-search-imap-search-keys))
+ (unless (or (looking-at "(")
+ (and (string-match "\\`[^[:blank:]]+" q-string)
+ (memql (intern-soft (downcase
+ (match-string 0 q-string)))
+ gnus-search-imap-search-keys)))
(setq q-string (concat "TEXT " q-string)))
;; If it's a thread query, make sure that all message-id
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index e4fd976..2a4c74d 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1351,7 +1351,8 @@ This variable is set by `nnmaildir-request-article'.")
(throw 'return nil))
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
- (nnheader-insert-file-contents nnmaildir-article-file-name))
+ (let ((coding-system-for-read mm-text-coding-system))
+ (mm-insert-file-contents nnmaildir-article-file-name)))
(cons gname num-msgid))))
(defun nnmaildir-request-post (&optional _server)
diff --git a/lisp/info.el b/lisp/info.el
index 62d7b58..dec9392 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1973,7 +1973,6 @@ If DIRECTION is `backward', search in the reverse
direction."
"Regexp search%s" (car Info-search-history)
(if case-fold-search "" " case-sensitively"))
nil 'Info-search-history)))
- (deactivate-mark)
(when (equal regexp "")
(setq regexp (car Info-search-history)))
(when regexp
@@ -2066,6 +2065,7 @@ If DIRECTION is `backward', search in the reverse
direction."
(< found opoint-max))
;; Search landed in the same node
(goto-char found)
+ (deactivate-mark)
(widen)
(goto-char found)
(save-match-data (Info-select-node)))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 67cc7be..c6f7fe7 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -838,10 +838,6 @@ This is like `describe-bindings', but displays only
Isearch keys."
:image '(isearch-tool-bar-image "left-arrow")))
map))
-;; Note: Before adding more key bindings to this map, please keep in
-;; mind that any unbound key exits Isearch and runs the command bound
-;; to it in the local or global map. So in effect every key unbound
-;; in this map is implicitly bound.
(defvar minibuffer-local-isearch-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
@@ -2498,6 +2494,21 @@ If search string is empty, just beep."
(unless isearch-mode (isearch-mode t))
(isearch-yank-string (current-kill 0)))
+(defun isearch-yank-from-kill-ring ()
+ "Read a string from the `kill-ring' and append it to the search string."
+ (interactive)
+ (with-isearch-suspended
+ (let ((string (read-from-kill-ring)))
+ (if (and isearch-case-fold-search
+ (eq 'not-yanks search-upper-case))
+ (setq string (downcase string)))
+ (if isearch-regexp (setq string (regexp-quote string)))
+ (setq isearch-yank-flag t)
+ (setq isearch-new-string (concat isearch-string string)
+ isearch-new-message (concat isearch-message
+ (mapconcat
'isearch-text-char-description
+ string ""))))))
+
(defun isearch-yank-pop ()
"Replace just-yanked search string with previously killed string.
Unlike `isearch-yank-pop-only', when this command is called not immediately
@@ -2506,37 +2517,31 @@ minibuffer to read a string from the `kill-ring' as
`yank-pop' does."
(interactive)
(if (not (memq last-command '(isearch-yank-kill
isearch-yank-pop isearch-yank-pop-only)))
- ;; Yank string from kill-ring-browser.
- (with-isearch-suspended
- (let ((string (read-from-kill-ring)))
- (if (and isearch-case-fold-search
- (eq 'not-yanks search-upper-case))
- (setq string (downcase string)))
- (if isearch-regexp (setq string (regexp-quote string)))
- (setq isearch-yank-flag t)
- (setq isearch-new-string (concat isearch-string string)
- isearch-new-message (concat isearch-message
- (mapconcat
'isearch-text-char-description
- string "")))))
+ (isearch-yank-from-kill-ring)
(isearch-pop-state)
(isearch-yank-string (current-kill 1))))
-(defun isearch-yank-pop-only ()
+(defun isearch-yank-pop-only (&optional arg)
"Replace just-yanked search string with previously killed string.
Unlike `isearch-yank-pop', when this command is called not immediately
after a `isearch-yank-kill' or a `isearch-yank-pop-only', it only pops
the last killed string instead of activating the minibuffer to read
-a string from the `kill-ring' as `yank-pop' does."
- (interactive)
- (if (not (memq last-command '(isearch-yank-kill
- isearch-yank-pop isearch-yank-pop-only)))
- ;; Fall back on `isearch-yank-kill' for the benefits of people
- ;; who are used to the old behavior of `M-y' in isearch mode.
- ;; In future, `M-y' could be changed from `isearch-yank-pop-only'
- ;; to `isearch-yank-pop' that uses the kill-ring-browser.
- (isearch-yank-kill)
+a string from the `kill-ring' as `yank-pop' does. The prefix arg C-u
+always reads a string from the `kill-ring' using the minibuffer."
+ (interactive "P")
+ (cond
+ ((equal arg '(4))
+ (isearch-yank-from-kill-ring))
+ ((not (memq last-command '(isearch-yank-kill
+ isearch-yank-pop isearch-yank-pop-only)))
+ ;; Fall back on `isearch-yank-kill' for the benefits of people
+ ;; who are used to the old behavior of `M-y' in isearch mode.
+ ;; In future, `M-y' could be changed from `isearch-yank-pop-only'
+ ;; to `isearch-yank-pop' that uses the kill-ring-browser.
+ (isearch-yank-kill))
+ (t
(isearch-pop-state)
- (isearch-yank-string (current-kill 1))))
+ (isearch-yank-string (current-kill 1)))))
(defun isearch-yank-x-selection ()
"Pull current X selection into search string."
@@ -2997,7 +3002,7 @@ See more for options in `search-exit-option'."
((and (eq (car-safe main-event) 'down-mouse-1)
(window-minibuffer-p (posn-window (event-start main-event))))
;; Swallow the up-event.
- (read-event)
+ (read--potential-mouse-event)
(setq this-command 'isearch-edit-string))
;; Don't terminate the search for motion commands.
((and isearch-yank-on-move
diff --git a/lisp/language/cham.el b/lisp/language/cham.el
index eef6d6f..194574f 100644
--- a/lisp/language/cham.el
+++ b/lisp/language/cham.el
@@ -34,6 +34,11 @@
(set-language-info-alist
"Cham" '((charset unicode)
(coding-system utf-8)
- (coding-priority utf-8)))
+ (coding-priority utf-8)
+ (sample-text . "Cham (ꨌꩌ)\tꨦꨤꩌ ꨦꨰꨁ")
+ (documentation . "\
+The Cham script is a Brahmic script used to write Cham,
+an Austronesian language spoken by some 245,000 Chams
+in Vietnam and Cambodia.")))
(provide 'cham)
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 60b67ed..d29115a 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -51,10 +51,10 @@ Setting this option to nil might speed up the generation of
summaries."
:group 'rmail-summary)
(defvar rmail-summary-font-lock-keywords
- '(("^.....D.*" . font-lock-string-face) ; Deleted.
- ("^.....-.*" . font-lock-type-face) ;
Unread.
+ '(("^ *[0-9]+D.*" . font-lock-string-face) ; Deleted.
+ ("^ *[0-9]+-.*" . font-lock-type-face) ; Unread.
;; Neither of the below will be highlighted if either of the above are:
- ("^.....[^D-] \\(......\\)" 1 font-lock-keyword-face) ; Date.
+ ("^ *[0-9]+[^D-] \\(......\\)" 1 font-lock-keyword-face) ; Date.
("{ \\([^\n}]+\\) }" 1 font-lock-comment-face)) ; Labels.
"Additional expressions to highlight in Rmail Summary mode.")
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index f661260..907ef06 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -225,7 +225,7 @@ To test this function, evaluate:
;; Don't change the mouse pointer shape while we drag.
(setq track-mouse 'dragging)
(while (progn
- (setq event (read-event)
+ (setq event (read--potential-mouse-event)
end (event-end event)
row (cdr (posn-col-row end))
col (car (posn-col-row end)))
@@ -286,7 +286,7 @@ To test this function, evaluate:
window-last-col (- (window-width) 2))
(track-mouse
(while (progn
- (setq event (read-event)
+ (setq event (read--potential-mouse-event)
end (event-end event)
row (cdr (posn-col-row end))
col (car (posn-col-row end)))
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 0da8288..8732fb8 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1792,7 +1792,7 @@ The function returns a non-nil value if it creates a
secondary selection."
(let (event end end-point)
(track-mouse
(while (progn
- (setq event (read-event))
+ (setq event (read--potential-mouse-event))
(or (mouse-movement-p event)
(memq (car-safe event) '(switch-frame select-window))))
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 3f3e713..0ce65a3 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -239,7 +239,7 @@ otherwise."
(mapc
(lambda (info)
(let ((local-ip (nth 1 info))
- (mask (nth 2 info)))
+ (mask (nth 3 info)))
(when
(nsm-network-same-subnet (substring local-ip 0 -1)
(substring mask 0 -1)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c0c215d..2c4ef2a 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -98,6 +98,7 @@ It is used for TCP/IP devices."
`(,tramp-adb-method
(tramp-login-program ,tramp-adb-program)
(tramp-login-args (("shell")))
+ (tramp-direct-async t)
(tramp-tmpdir "/data/local/tmp")
(tramp-default-port 5555)))
@@ -895,8 +896,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; terminated.
(defun tramp-adb-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
-If connection property \"direct-async-process\" is non-nil, an
-alternative implementation will be used."
+If method parameter `tramp-direct-async' and connection property
+\"direct-async-process\" are non-nil, an alternative
+implementation will be used."
(if (tramp-direct-async-process-p args)
(apply #'tramp-handle-make-process args)
(when args
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 7287315..e8ee372 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -168,6 +168,7 @@ The string is used in `tramp-methods'.")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("%h")))
(tramp-async-args (("-q")))
+ (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
@@ -183,6 +184,7 @@ The string is used in `tramp-methods'.")
("-e" "none") ("-t" "-t") ("%h")
("%l")))
(tramp-async-args (("-q")))
+ (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
@@ -197,6 +199,7 @@ The string is used in `tramp-methods'.")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("%h")))
(tramp-async-args (("-q")))
+ (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
@@ -227,6 +230,7 @@ The string is used in `tramp-methods'.")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("%h")))
(tramp-async-args (("-q")))
+ (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
@@ -237,6 +241,7 @@ The string is used in `tramp-methods'.")
("-e" "none") ("-t" "-t") ("%h")
("%l")))
(tramp-async-args (("-q")))
+ (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
@@ -2668,11 +2673,9 @@ The method used must be an out-of-band method."
#'file-name-nondirectory (list localname))))
(tramp-get-remote-null-device v))))
- (let ((beg-marker (point-marker))
- (end-marker (point-marker))
+ (let ((beg-marker (copy-marker (point) nil))
+ (end-marker (copy-marker (point) t))
(emc enable-multibyte-characters))
- (set-marker-insertion-type beg-marker nil)
- (set-marker-insertion-type end-marker t)
;; We cannot use `insert-buffer-substring' because the Tramp
;; buffer changes its contents before insertion due to calling
;; `expand-file-name' and alike.
@@ -2837,9 +2840,9 @@ the result will be a local, non-Tramp, file name."
;; terminated.
(defun tramp-sh-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
-STDERR can also be a file name. If connection property
-\"direct-async-process\" is non-nil, an alternative
-implementation will be used."
+STDERR can also be a file name. If method parameter `tramp-direct-async'
+and connection property \"direct-async-process\" are non-nil, an
+alternative implementation will be used."
(if (tramp-direct-async-process-p args)
(apply #'tramp-handle-make-process args)
(when args
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index cc8dda8..2816c58 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -259,9 +259,9 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
parameters to suppress diagnostic messages, in order not to
tamper the process output.
- * `tramp-direct-async-args'
- An additional argument when a direct asynchronous process is
- started. Used so far only in the \"mock\" method of tramp-tests.el.
+ * `tramp-direct-async'
+ Whether the method supports direct asynchronous processes.
+ Until now, just \"ssh\"-based and \"adb\"-based methods do.
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
@@ -1755,7 +1755,8 @@ The outline level is equal to the verbosity of the Tramp
message."
Message is formatted with FMT-STRING as control string and the remaining
ARGUMENTS to actually emit the message (if applicable)."
(let ((inhibit-message t)
- file-name-handler-alist message-log-max signal-hook-function)
+ create-lockfiles file-name-handler-alist message-log-max
+ signal-hook-function)
(with-current-buffer (tramp-get-debug-buffer vec)
(goto-char (point-max))
(let ((point (point)))
@@ -1982,6 +1983,13 @@ the resulting error message."
(put #'tramp-with-demoted-errors 'tramp-suppress-trace t)
+(defun tramp-test-message (fmt-string &rest arguments)
+ "Emit a Tramp message according `default-directory'."
+ (if (tramp-tramp-file-p default-directory)
+ (apply #'tramp-message
+ (tramp-dissect-file-name default-directory) 0 fmt-string arguments)
+ (apply #'message fmt-string arguments)))
+
;; This function provides traces in case of errors not triggered by
;; Tramp functions.
(defun tramp-signal-hook-function (error-symbol data)
@@ -3741,7 +3749,9 @@ User is always nil."
(let ((v (tramp-dissect-file-name default-directory))
(buffer (plist-get args :buffer))
(stderr (plist-get args :stderr)))
- (and ;; It has been indicated.
+ (and ;; The method supports it.
+ (tramp-get-method-parameter v 'tramp-direct-async)
+ ;; It has been indicated.
(tramp-get-connection-property v "direct-async-process" nil)
;; There's no multi-hop.
(or (not (tramp-multi-hop-p v))
@@ -3821,8 +3831,6 @@ It does not support `:stderr'."
(tramp-get-method-parameter v 'tramp-login-args))
(async-args
(tramp-get-method-parameter v 'tramp-async-args))
- (direct-async-args
- (tramp-get-method-parameter v 'tramp-direct-async-args))
;; We don't create the temporary file. In fact, it
;; is just a prefix for the ControlPath option of
;; ssh; the real temporary file has another name, and
@@ -3850,7 +3858,7 @@ It does not support `:stderr'."
?h (or host "") ?u (or user "") ?p (or port "")
?c options ?l "")
;; Add arguments for asynchronous processes.
- login-args (append async-args direct-async-args login-args)
+ login-args (append async-args login-args)
;; Expand format spec.
login-args
(tramp-compat-flatten-tree
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 714b3f9..ced3e93 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.5.0
+;; Version: 2.5.1-pre
;; Package-Requires: ((emacs "25.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@@ -40,7 +40,7 @@
;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.5.0"
+(defconst tramp-version "2.5.1-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -76,7 +76,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-lessp emacs-version "25.1"))
"ok"
- (format "Tramp 2.5.0 is not fit for %s"
+ (format "Tramp 2.5.1-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index cc0e159..68dc0fb 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -132,8 +132,10 @@ This is an alternative of `scroll-up'. Scope moves
downward."
(pixel-line-height))))
(if (pixel-eob-at-top-p) ; when end-of-the-buffer is close
(scroll-up 1) ; relay on robust method
- (while (pixel-point-at-top-p amt) ; prevent too late (multi tries)
- (vertical-motion 1)) ; move point downward
+ (catch 'no-movement
+ (while (pixel-point-at-top-p amt) ; prevent too late (multi tries)
+ (unless (>= (vertical-motion 1) 1) ; move point downward
+ (throw 'no-movement nil)))) ; exit loop when point did not move
(pixel-scroll-pixel-up amt)))))) ; move scope downward
(defun pixel-scroll-down (&optional arg)
@@ -149,8 +151,10 @@ This is and alternative of `scroll-down'. Scope moves
upward."
pixel-resolution-fine-flag
(frame-char-height))
(pixel-line-height -1))))
- (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries)
- (vertical-motion -1)) ; move point upward
+ (catch 'no-movement
+ (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries)
+ (unless (<= (vertical-motion -1) -1) ; move point upward
+ (throw 'no-movement nil)))) ; exit loop when point did not move
(if (or (pixel-bob-at-top-p amt) ; when beginning-of-the-buffer is seen
(pixel-eob-at-top-p)) ; for file with a long line
(scroll-down 1) ; relay on robust method
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 62c3cf4..06966f3 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -970,20 +970,11 @@ loop using the command \\[fileloop-continue]."
(declare-function compilation-read-command "compile")
;;;###autoload
-(defun project-compile (command &optional comint)
- "Run `compile' in the project root.
-Arguments the same as in `compile'."
- (interactive
- (list
- (let ((command (eval compile-command)))
- (require 'compile)
- (if (or compilation-read-command current-prefix-arg)
- (compilation-read-command command)
- command))
- (consp current-prefix-arg)))
- (let* ((pr (project-current t))
- (default-directory (project-root pr)))
- (compile command comint)))
+(defun project-compile ()
+ "Run `compile' in the project root."
+ (interactive)
+ (let ((default-directory (project-root (project-current t))))
+ (call-interactively #'compile)))
(defun project--read-project-buffer ()
(let* ((pr (project-current t))
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 7cda6c9..1e81904 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -429,7 +429,7 @@ dragging. See also the variable
`ruler-mode-dragged-symbol'."
;; `ding' flushes the next messages about setting goal
;; column. So here I force fetch the event(mouse-2) and
;; throw away.
- (read-event)
+ (read--potential-mouse-event)
;; Ding BEFORE `message' is OK.
(when ruler-mode-set-goal-column-ding-flag
(ding))
@@ -460,7 +460,7 @@ the mouse has been clicked."
(track-mouse
;; Signal the display engine to freeze the mouse pointer shape.
(setq track-mouse 'dragging)
- (while (mouse-movement-p (setq event (read-event)))
+ (while (mouse-movement-p (setq event (read--potential-mouse-event)))
(setq drags (1+ drags))
(when (eq window (posn-window (event-end event)))
(ruler-mode-mouse-drag-any-column event)
diff --git a/lisp/shell.el b/lisp/shell.el
index c179dd2..0f86615 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -603,6 +603,7 @@ buffer."
(or hfile
(cond ((string-equal shell "bash") "~/.bash_history")
((string-equal shell "ksh") "~/.sh_history")
+ ((string-equal shell "zsh") "~/.zsh_history")
(t "~/.history")))))
(if (or (equal comint-input-ring-file-name "")
(equal (file-truename comint-input-ring-file-name)
diff --git a/lisp/simple.el b/lisp/simple.el
index 54c35c0..37c0885 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5606,7 +5606,9 @@ See also `zap-up-to-char'."
;; kill-line and its subroutines.
(defcustom kill-whole-line nil
- "If non-nil, `kill-line' with no arg at start of line kills the whole line."
+ "If non-nil, `kill-line' with no arg at start of line kills the whole line.
+This variable also affects `kill-visual-line' in the same way as
+it does `kill-line'."
:type 'boolean
:group 'killing)
@@ -7319,6 +7321,10 @@ If ARG is negative, kill visual lines backward.
If ARG is zero, kill the text before point on the current visual
line.
+If the variable `kill-whole-line' is non-nil, and this command is
+invoked at start of a line that ends in a newline, kill the newline
+as well.
+
If you want to append the killed line to the last killed text,
use \\[append-next-kill] before \\[kill-line].
@@ -7331,18 +7337,30 @@ even beep.)"
;; Like in `kill-line', it's better to move point to the other end
;; of the kill before killing.
(let ((opoint (point))
- (kill-whole-line (and kill-whole-line (bolp))))
+ (kill-whole-line (and kill-whole-line (bolp)))
+ (orig-y (cdr (nth 2 (posn-at-point))))
+ ;; FIXME: This tolerance should be zero! It isn't due to a
+ ;; bug in posn-at-point, see bug#45837.
+ (tol (/ (line-pixel-height) 2)))
(if arg
(vertical-motion (prefix-numeric-value arg))
(end-of-visual-line 1)
(if (= (point) opoint)
(vertical-motion 1)
- ;; Skip any trailing whitespace at the end of the visual line.
- ;; We used to do this only if `show-trailing-whitespace' is
- ;; nil, but that's wrong; the correct thing would be to check
- ;; whether the trailing whitespace is highlighted. But, it's
- ;; OK to just do this unconditionally.
- (skip-chars-forward " \t")))
+ ;; The first condition below verifies we are still on the same
+ ;; screen line, i.e. that the line isn't continued, and that
+ ;; end-of-visual-line didn't overshoot due to complications
+ ;; like display or overlay strings, intangible text, etc.:
+ ;; otherwise, we don't want to kill a character that's
+ ;; unrelated to the place where the visual line wrapped.
+ (and (< (abs (- (cdr (nth 2 (posn-at-point))) orig-y)) tol)
+ ;; Make sure we delete the character where the line wraps
+ ;; under visual-line-mode, be it whitespace or a
+ ;; character whose category set allows to wrap at it.
+ (or (looking-at-p "[ \t]")
+ (and word-wrap-by-category
+ (aref (char-category-set (following-char)) ?\|)))
+ (forward-char))))
(kill-region opoint (if (and kill-whole-line (= (following-char) ?\n))
(1+ (point))
(point)))))
diff --git a/lisp/startup.el b/lisp/startup.el
index 57fd87f..552802a 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -921,7 +921,8 @@ the name of the init-file to load. If this file cannot be
loaded, and ALTERNATE-FILENAME-FUNCTION is non-nil, then it is
called with no arguments and should return the name of an
alternate init-file to load. If LOAD-DEFAULTS is non-nil, then
-load default.el after the init-file.
+load default.el after the init-file, unless `inhibit-default-init'
+is non-nil.
This function sets `user-init-file' to the name of the loaded
init-file, or to a default value if loading is not possible."
@@ -977,8 +978,8 @@ init-file, or to a default value if loading is not
possible."
(sit-for 1))
(setq user-init-file source))))
- (when load-defaults
-
+ (when (and load-defaults
+ (not inhibit-default-init))
;; Prevent default.el from changing the value of
;; `inhibit-startup-screen'.
(let ((inhibit-startup-screen nil))
@@ -1166,12 +1167,11 @@ please check its value")
;; Re-evaluate predefined variables whose initial value depends on
;; the runtime context.
- (let (current-load-list) ; c-r-s may call defvar, and hence LOADHIST_ATTACH
- (setq custom-delayed-init-variables
- ;; Initialize them in the same order they were loaded, in case there
- ;; are dependencies between them.
- (nreverse custom-delayed-init-variables))
- (mapc 'custom-reevaluate-setting custom-delayed-init-variables))
+ (setq custom-delayed-init-variables
+ ;; Initialize them in the same order they were loaded, in case there
+ ;; are dependencies between them.
+ (nreverse custom-delayed-init-variables))
+ (mapc #'custom-reevaluate-setting custom-delayed-init-variables)
;; Warn for invalid user name.
(when init-file-user
@@ -1288,8 +1288,7 @@ please check its value")
(if (or noninteractive emacs-basic-display)
(setq menu-bar-mode nil
tab-bar-mode nil
- tool-bar-mode nil
- no-blinking-cursor t))
+ tool-bar-mode nil))
(frame-initialize))
(when (fboundp 'x-create-frame)
@@ -1298,15 +1297,6 @@ please check its value")
(unless noninteractive
(tool-bar-setup)))
- ;; Turn off blinking cursor if so specified in X resources. This is here
- ;; only because all other settings of no-blinking-cursor are here.
- (unless (or noninteractive
- emacs-basic-display
- (and (memq window-system '(x w32 ns))
- (not (member (x-get-resource "cursorBlink" "CursorBlink")
- '("no" "off" "false" "0")))))
- (setq no-blinking-cursor t))
-
(unless noninteractive
(startup--setup-quote-display)
(setq internal--text-quoting-flag t))
@@ -1314,9 +1304,8 @@ please check its value")
;; Re-evaluate again the predefined variables whose initial value
;; depends on the runtime context, in case some of them depend on
;; the window-system features. Example: blink-cursor-mode.
- (let (current-load-list) ; c-r-s may call defvar, and hence LOADHIST_ATTACH
- (mapc 'custom-reevaluate-setting custom-delayed-init-variables)
- (setq custom-delayed-init-variables nil))
+ (mapc #'custom-reevaluate-setting custom-delayed-init-variables)
+ (setq custom-delayed-init-variables nil)
(normal-erase-is-backspace-setup-frame)
@@ -1374,7 +1363,7 @@ please check its value")
(expand-file-name
"init.el"
startup-init-directory))
- (not inhibit-default-init))
+ t)
(when (and deactivate-mark transient-mark-mode)
(with-current-buffer (window-buffer)
diff --git a/lisp/strokes.el b/lisp/strokes.el
index b0ab4f9..55f2ae8 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -756,12 +756,12 @@ Optional EVENT is acceptable as the starting event of the
stroke."
(strokes-fill-current-buffer-with-whitespace))
(when prompt
(message "%s" prompt)
- (setq event (read-event))
+ (setq event (read--potential-mouse-event))
(or (strokes-button-press-event-p event)
(error "You must draw with the mouse")))
(unwind-protect
(track-mouse
- (or event (setq event (read-event)
+ (or event (setq event (read--potential-mouse-event)
safe-to-draw-p t))
(while (not (strokes-button-release-event-p event))
(if (strokes-mouse-event-p event)
@@ -776,7 +776,7 @@ Optional EVENT is acceptable as the starting event of the
stroke."
(setq safe-to-draw-p t))
(push (cdr (mouse-pixel-position))
pix-locs)))
- (setq event (read-event)))))
+ (setq event (read--potential-mouse-event)))))
;; protected
;; clean up strokes buffer and then bury it.
(when (equal (buffer-name) strokes-buffer-name)
@@ -787,16 +787,16 @@ Optional EVENT is acceptable as the starting event of the
stroke."
;; Otherwise, don't use strokes buffer and read stroke silently
(when prompt
(message "%s" prompt)
- (setq event (read-event))
+ (setq event (read--potential-mouse-event))
(or (strokes-button-press-event-p event)
(error "You must draw with the mouse")))
(track-mouse
- (or event (setq event (read-event)))
+ (or event (setq event (read--potential-mouse-event)))
(while (not (strokes-button-release-event-p event))
(if (strokes-mouse-event-p event)
(push (cdr (mouse-pixel-position))
pix-locs))
- (setq event (read-event))))
+ (setq event (read--potential-mouse-event))))
(setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs)))
(strokes-fill-stroke
(strokes-eliminate-consecutive-redundancies grid-locs)))))
@@ -817,10 +817,10 @@ Optional EVENT is acceptable as the starting event of the
stroke."
(if prompt
(while (not (strokes-button-press-event-p event))
(message "%s" prompt)
- (setq event (read-event))))
+ (setq event (read--potential-mouse-event))))
(unwind-protect
(track-mouse
- (or event (setq event (read-event)))
+ (or event (setq event (read--potential-mouse-event)))
(while (not (and (strokes-button-press-event-p event)
(eq 'mouse-3
(car (get (car event)
@@ -834,14 +834,15 @@ Optional EVENT is acceptable as the starting event of the
stroke."
?\s strokes-character))
(push (cdr (mouse-pixel-position))
pix-locs)))
- (setq event (read-event)))
+ (setq event (read--potential-mouse-event)))
(push strokes-lift pix-locs)
(while (not (strokes-button-press-event-p event))
- (setq event (read-event))))
+ (setq event (read--potential-mouse-event))))
;; ### KLUDGE! ### sit and wait
;; for some useless event to
;; happen to fix the minibuffer bug.
- (while (not (strokes-button-release-event-p (read-event))))
+ (while (not (strokes-button-release-event-p
+ (read--potential-mouse-event))))
(setq pix-locs (nreverse (cdr pix-locs))
grid-locs (strokes-renormalize-to-grid pix-locs))
(strokes-fill-stroke
diff --git a/lisp/subr.el b/lisp/subr.el
index 6d3ea45..f249ec3 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1178,6 +1178,30 @@ KEY is a string or vector representing a sequence of
keystrokes."
(if (current-local-map)
(local-set-key key nil))
nil)
+
+(defun local-key-binding (keys &optional accept-default)
+ "Return the binding for command KEYS in current local keymap only.
+KEYS is a string or vector, a sequence of keystrokes.
+The binding is probably a symbol with a function definition.
+
+If optional argument ACCEPT-DEFAULT is non-nil, recognize default
+bindings; see the description of `lookup-key' for more details
+about this."
+ (let ((map (current-local-map)))
+ (when map (lookup-key map keys accept-default))))
+
+(defun global-key-binding (keys &optional accept-default)
+ "Return the binding for command KEYS in current global keymap only.
+KEYS is a string or vector, a sequence of keystrokes.
+The binding is probably a symbol with a function definition.
+This function's return values are the same as those of `lookup-key'
+\(which see).
+
+If optional argument ACCEPT-DEFAULT is non-nil, recognize default
+bindings; see the description of `lookup-key' for more details
+about this."
+ (lookup-key (current-global-map) keys accept-default))
+
;;;; substitute-key-definition and its subroutines.
@@ -2545,23 +2569,52 @@ It can be retrieved with `(process-get PROCESS
PROPNAME)'."
;;;; Input and display facilities.
-(defconst read-key-empty-map (make-sparse-keymap))
+;; The following maps are used by `read-key' to remove all key
+;; bindings while calling `read-key-sequence'. This way the keys
+;; returned are independent of the key binding state.
+
+(defconst read-key-empty-map (make-sparse-keymap)
+ "Used internally by `read-key'.")
+
+(defconst read-key-full-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [t] 'dummy)
+
+ ;; ESC needs to be unbound so that escape sequences in
+ ;; `input-decode-map' are still processed by `read-key-sequence'.
+ (define-key map [?\e] nil)
+ map)
+ "Used internally by `read-key'.")
(defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully.
-(defun read-key (&optional prompt)
+(defun read-key (&optional prompt disable-fallbacks)
"Read a key from the keyboard.
Contrary to `read-event' this will not return a raw event but instead will
obey the input decoding and translations usually done by `read-key-sequence'.
So escape sequences and keyboard encoding are taken into account.
When there's an ambiguity because the key looks like the prefix of
-some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
+some sort of escape sequence, the ambiguity is resolved via `read-key-delay'.
+
+If the optional argument PROMPT is non-nil, display that as a
+prompt.
+
+If the optional argument DISABLE-FALLBACKS is non-nil, all
+unbound fallbacks usually done by `read-key-sequence' are
+disabled such as discarding mouse down events. This is generally
+what you want as `read-key' temporarily removes all bindings
+while calling `read-key-sequence'. If nil or unspecified, the
+only unbound fallback disabled is downcasing of the last event."
;; This overriding-terminal-local-map binding also happens to
;; disable quail's input methods, so although read-key-sequence
;; always inherits the input method, in practice read-key does not
;; inherit the input method (at least not if it's based on quail).
(let ((overriding-terminal-local-map nil)
- (overriding-local-map read-key-empty-map)
+ (overriding-local-map
+ ;; FIXME: Audit existing uses of `read-key' to see if they
+ ;; should always specify disable-fallbacks to be more in line
+ ;; with `read-event'.
+ (if disable-fallbacks read-key-full-map read-key-empty-map))
(echo-keystrokes 0)
(old-global-map (current-global-map))
(timer (run-with-idle-timer
@@ -2615,6 +2668,23 @@ some sort of escape sequence, the ambiguity is resolved
via `read-key-delay'."
(message nil)
(use-global-map old-global-map))))
+;; FIXME: Once there's a safe way to transition away from read-event,
+;; callers to this function should be updated to that way and this
+;; function should be deleted.
+(defun read--potential-mouse-event ()
+ "Read an event that might be a mouse event.
+
+This function exists for backward compatibility in code packaged
+with Emacs. Do not call it directly in your own packages."
+ ;; `xterm-mouse-mode' events must go through `read-key' as they
+ ;; are decoded via `input-decode-map'.
+ (if xterm-mouse-mode
+ (read-key nil
+ ;; Normally `read-key' discards all mouse button
+ ;; down events. However, we want them here.
+ t)
+ (read-event)))
+
(defvar read-passwd-map
;; BEWARE: `defconst' would purecopy it, breaking the sharing with
;; minibuffer-local-map along the way!
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index ce62082..50c00c9 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -5004,7 +5004,7 @@ The event, EV, is the mouse event."
(setq timer (run-at-time interval interval draw-fn x1 y1))))
;; Read next event
- (setq ev (read-event))))
+ (setq ev (read--potential-mouse-event))))
;; Cleanup: get rid of any active timer.
(if timer
(cancel-timer timer)))
@@ -5212,7 +5212,7 @@ The event, EV, is the mouse event."
;; Read next event (only if we should not stop)
(if (not done)
- (setq ev (read-event)))))
+ (setq ev (read--potential-mouse-event)))))
;; Reverse point-list (last points are cond'ed first)
(setq point-list (reverse point-list))
@@ -5339,7 +5339,7 @@ The event, EV, is the mouse event."
;; Read next event
- (setq ev (read-event))))
+ (setq ev (read--potential-mouse-event))))
;; If we are not rubber-banding (that is, we were moving around the `2')
;; draw the shape
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index d4c1b87..1b29eaf 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -900,7 +900,7 @@ DOWNCASE t: Downcase words before using them."
,(concat
;; Make sure we search only for optional arguments of
;; environments/macros and don't match any other [. ctable
- ;; provides a macro called \ctable, listings/breqn have
+ ;; provides a macro called \ctable, beamer/breqn/listings have
;; environments. Start with a backslash and a group for names
"\\\\\\(?:"
;; begin, optional spaces and opening brace
@@ -936,8 +936,9 @@ The default value matches usual \\label{...} definitions and
keyval style [..., label = {...}, ...] label definitions. The
regexp for keyval style explicitly looks for environments
provided by the packages \"listings\" (\"lstlisting\"),
-\"breqn\" (\"dmath\", \"dseries\", \"dgroup\", \"darray\") and
-the macro \"\\ctable\" provided by the package of the same name.
+\"beamer\" (\"frame\"), \"breqn\" (\"dmath\", \"dseries\",
+\"dgroup\", \"darray\") and the macro \"\\ctable\" provided by
+the package of the same name.
It is assumed that the regexp group 1 matches the label text, so
you have to define it using \\(?1:...\\) when adding new regexps.
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 72b3458..47ef37a 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -262,11 +262,12 @@ keyboard input to go into icons."
(let (event)
(message
"Select windows by clicking. Please click on Window %d " wind-number)
- (while (not (ediff-mouse-event-p (setq event (read-event))))
+ (while (not (ediff-mouse-event-p (setq event
+ (read--potential-mouse-event))))
(if (sit-for 1) ; if sequence of events, wait till the final word
(beep 1))
(message "Please click on Window %d " wind-number))
- (read-event) ; discard event
+ (read--potential-mouse-event) ; discard event
(posn-window (event-start event))))
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index e3612dd..ed375738 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -939,7 +939,7 @@ arguments after setting up the Ediff buffers."
;; If WIND-A is nil, use selected window.
;; If WIND-B is nil, use window next to WIND-A.
(defun ediff-windows (dumb-mode wind-A wind-B startup-hooks job-name word-mode)
- (if (or dumb-mode (not (ediff-window-display-p)))
+ (if (or dumb-mode (not (display-mouse-p)))
(setq wind-A (ediff-get-next-window wind-A nil)
wind-B (ediff-get-next-window wind-B wind-A))
(setq wind-A (ediff-get-window-by-clicking wind-A nil 1)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 8b10d71..7dda04e 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1104,7 +1104,7 @@ If nothing was called, return non-nil."
(unless (widget-apply button :mouse-down-action event)
(let ((track-mouse t))
(while (not (widget-button-release-event-p event))
- (setq event (read-event))
+ (setq event (read--potential-mouse-event))
(when (and mouse-1 (mouse-movement-p event))
(push event unread-command-events)
(setq event oevent)
@@ -1169,7 +1169,7 @@ If nothing was called, return non-nil."
(when up
;; Don't execute up events twice.
(while (not (widget-button-release-event-p event))
- (setq event (read-event))))
+ (setq event (read--potential-mouse-event))))
(when command
(call-interactively command)))))
(message "You clicked somewhere weird.")))
@@ -3486,14 +3486,16 @@ It reads a directory name from an editable text field."
:help-echo "C-q: insert KEY, EVENT, or CODE; RET: enter value"
:tag "Key sequence")
+;; FIXME: Consider combining this with help--read-key-sequence which
+;; can also read double and triple mouse events.
(defun widget-key-sequence-read-event (ev)
(interactive (list
(let ((inhibit-quit t) quit-flag)
- (read-event "Insert KEY, EVENT, or CODE: "))))
+ (read-key "Insert KEY, EVENT, or CODE: " t))))
(let ((ev2 (and (memq 'down (event-modifiers ev))
- (read-event)))
- (tr (and (keymapp function-key-map)
- (lookup-key function-key-map (vector ev)))))
+ (read-key nil t)))
+ (tr (and (keymapp local-function-key-map)
+ (lookup-key local-function-key-map (vector ev)))))
(when (and (integerp ev)
(or (and (<= ?0 ev) (< ev (+ ?0 (min 10
read-quoted-char-radix))))
(and (<= ?a (downcase ev))
diff --git a/lisp/window.el b/lisp/window.el
index a6cdd4d..0a37d16 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -1736,9 +1736,11 @@ interpret DELTA as pixels."
(setq window (window-normalize-window window))
(cond
((< delta 0)
- (max (- (window-min-size window horizontal ignore pixelwise)
- (window-size window horizontal pixelwise))
- delta))
+ (let ((min-size (window-min-size window horizontal ignore pixelwise))
+ (size (window-size window horizontal pixelwise)))
+ (if (<= size min-size)
+ 0
+ (max (- min-size size) delta))))
((> delta 0)
(if (window-size-fixed-p window horizontal ignore)
0
diff --git a/src/data.c b/src/data.c
index d420bf5..35a6890 100644
--- a/src/data.c
+++ b/src/data.c
@@ -3760,6 +3760,7 @@ syms_of_data (void)
DEFSYM (Qbuffer_read_only, "buffer-read-only");
DEFSYM (Qtext_read_only, "text-read-only");
DEFSYM (Qmark_inactive, "mark-inactive");
+ DEFSYM (Qinhibited_interaction, "inhibited-interaction");
DEFSYM (Qlistp, "listp");
DEFSYM (Qconsp, "consp");
@@ -3844,6 +3845,8 @@ syms_of_data (void)
PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only");
PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail),
"Text is read-only");
+ PUT_ERROR (Qinhibited_interaction, error_tail,
+ "User interaction while inhibited");
DEFSYM (Qrange_error, "range-error");
DEFSYM (Qdomain_error, "domain-error");
diff --git a/src/dispnew.c b/src/dispnew.c
index 36a6dd8..e603c67 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -6049,7 +6049,14 @@ additional wait period, in milliseconds; this is for
backwards compatibility.
READING is true if reading input.
If DISPLAY_OPTION is >0 display process output while waiting.
If DISPLAY_OPTION is >1 perform an initial redisplay before waiting.
-*/
+
+ Returns a boolean Qt if we waited the full time and returns Qnil if the
+ wait was interrupted by incoming process output or keyboard events.
+
+ FIXME: When `wait_reading_process_output` returns early because of
+ process output, instead of returning nil we should loop and wait some
+ more (i.e. until either there's pending input events or the timeout
+ expired). */
Lisp_Object
sit_for (Lisp_Object timeout, bool reading, int display_option)
@@ -6110,8 +6117,9 @@ sit_for (Lisp_Object timeout, bool reading, int
display_option)
gobble_input ();
#endif
- wait_reading_process_output (sec, nsec, reading ? -1 : 1, do_display,
- Qnil, NULL, 0);
+ int nbytes
+ = wait_reading_process_output (sec, nsec, reading ? -1 : 1, do_display,
+ Qnil, NULL, 0);
if (reading && curbuf_eq_winbuf)
/* Timers and process filters/sentinels may have changed the selected
@@ -6120,7 +6128,7 @@ sit_for (Lisp_Object timeout, bool reading, int
display_option)
buffer to start with). */
set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents));
- return detect_input_pending () ? Qnil : Qt;
+ return (nbytes > 0 || detect_input_pending ()) ? Qnil : Qt;
}
diff --git a/src/fns.c b/src/fns.c
index 5fcc54f..7ab2e8f 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5548,6 +5548,90 @@ It should not be used for anything security-related. See
return make_digest_string (digest, SHA1_DIGEST_SIZE);
}
+DEFUN ("buffer-line-statistics", Fbuffer_line_statistics,
+ Sbuffer_line_statistics, 0, 1, 0,
+ doc: /* Return data about lines in BUFFER.
+The data is returned as a list, and the first element is the number of
+lines in the buffer, the second is the length of the longest line, and
+the third is the mean line length. The lengths returned are in bytes, not
+characters. */ )
+ (Lisp_Object buffer_or_name)
+{
+ Lisp_Object buffer;
+ ptrdiff_t lines = 0, longest = 0;
+ double mean = 0;
+ struct buffer *b;
+
+ if (NILP (buffer_or_name))
+ buffer = Fcurrent_buffer ();
+ else
+ buffer = Fget_buffer (buffer_or_name);
+ if (NILP (buffer))
+ nsberror (buffer_or_name);
+
+ b = XBUFFER (buffer);
+
+ unsigned char *start = BUF_BEG_ADDR (b);
+ ptrdiff_t area = BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b), pre_gap = 0;
+
+ /* Process the first part of the buffer. */
+ while (area > 0)
+ {
+ unsigned char *n = memchr (start, '\n', area);
+
+ if (n)
+ {
+ ptrdiff_t this_line = n - start;
+ if (this_line > longest)
+ longest = this_line;
+ lines++;
+ /* Blame Knuth. */
+ mean = mean + (this_line - mean) / lines;
+ area = area - this_line - 1;
+ start += this_line + 1;
+ }
+ else
+ {
+ /* Didn't have a newline here, so save the rest for the
+ post-gap calculation. */
+ pre_gap = area;
+ area = 0;
+ }
+ }
+
+ /* If the gap is before the end of the buffer, process the last half
+ of the buffer. */
+ if (BUF_GPT_BYTE (b) < BUF_Z_BYTE (b))
+ {
+ start = BUF_GAP_END_ADDR (b);
+ area = BUF_Z_ADDR (b) - BUF_GAP_END_ADDR (b);
+
+ while (area > 0)
+ {
+ unsigned char *n = memchr (start, '\n', area);
+ ptrdiff_t this_line = n? n - start + pre_gap: area + pre_gap;
+
+ if (this_line > longest)
+ longest = this_line;
+ lines++;
+ /* Blame Knuth again. */
+ mean = mean + (this_line - mean) / lines;
+ area = area - this_line - 1;
+ start += this_line + 1;
+ pre_gap = 0;
+ }
+ }
+ else if (pre_gap > 0)
+ {
+ if (pre_gap > longest)
+ longest = pre_gap;
+ lines++;
+ mean = mean + (pre_gap - mean) / lines;
+ }
+
+ return list3 (make_int (lines), make_int (longest), make_float (mean));
+}
+
static bool
string_ascii_p (Lisp_Object string)
{
@@ -5871,4 +5955,5 @@ this variable. */);
defsubr (&Ssecure_hash);
defsubr (&Sbuffer_hash);
defsubr (&Slocale_info);
+ defsubr (&Sbuffer_line_statistics);
}
diff --git a/src/frame.c b/src/frame.c
index 45ee96e..599c407 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -2572,23 +2572,30 @@ before calling this function on it, like this.
int yval = check_integer_range (y, INT_MIN, INT_MAX);
/* I think this should be done with a hook. */
-#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (XFRAME (frame)))
- /* Warping the mouse will cause enternotify and focus events. */
- frame_set_mouse_position (XFRAME (frame), xval, yval);
-#elif defined MSDOS
- if (FRAME_MSDOS_P (XFRAME (frame)))
+ {
+#ifdef HAVE_WINDOW_SYSTEM
+ /* Warping the mouse will cause enternotify and focus events. */
+ frame_set_mouse_position (XFRAME (frame), xval, yval);
+#endif /* HAVE_WINDOW_SYSTEM */
+ }
+#ifdef MSDOS
+ else if (FRAME_MSDOS_P (XFRAME (frame)))
{
Fselect_frame (frame, Qnil);
mouse_moveto (xval, yval);
}
-#elif defined HAVE_GPM
- Fselect_frame (frame, Qnil);
- term_mouse_moveto (xval, yval);
+#endif /* MSDOS */
+ else
+ {
+ Fselect_frame (frame, Qnil);
+#ifdef HAVE_GPM
+ term_mouse_moveto (xval, yval);
#else
- (void) xval;
- (void) yval;
-#endif
+ (void) xval;
+ (void) yval;
+#endif /* HAVE_GPM */
+ }
return Qnil;
}
@@ -2610,23 +2617,31 @@ before calling this function on it, like this.
int yval = check_integer_range (y, INT_MIN, INT_MAX);
/* I think this should be done with a hook. */
-#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (XFRAME (frame)))
- /* Warping the mouse will cause enternotify and focus events. */
- frame_set_mouse_pixel_position (XFRAME (frame), xval, yval);
-#elif defined MSDOS
- if (FRAME_MSDOS_P (XFRAME (frame)))
+ {
+ /* Warping the mouse will cause enternotify and focus events. */
+#ifdef HAVE_WINDOW_SYSTEM
+ frame_set_mouse_pixel_position (XFRAME (frame), xval, yval);
+#endif /* HAVE_WINDOW_SYSTEM */
+ }
+#ifdef MSDOS
+ else if (FRAME_MSDOS_P (XFRAME (frame)))
{
Fselect_frame (frame, Qnil);
mouse_moveto (xval, yval);
}
-#elif defined HAVE_GPM
- Fselect_frame (frame, Qnil);
- term_mouse_moveto (xval, yval);
+#endif /* MSDOS */
+ else
+ {
+ Fselect_frame (frame, Qnil);
+#ifdef HAVE_GPM
+ term_mouse_moveto (xval, yval);
#else
- (void) xval;
- (void) yval;
-#endif
+ (void) xval;
+ (void) yval;
+#endif /* HAVE_GPM */
+
+ }
return Qnil;
}
diff --git a/src/keymap.c b/src/keymap.c
index 1197f6f..de9b2b5 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1646,39 +1646,6 @@ specified buffer position instead of point are used.
/* GC is possible in this function if it autoloads a keymap. */
-DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
- doc: /* Return the binding for command KEYS in current local keymap
only.
-KEYS is a string or vector, a sequence of keystrokes.
-The binding is probably a symbol with a function definition.
-
-If optional argument ACCEPT-DEFAULT is non-nil, recognize default
-bindings; see the description of `lookup-key' for more details about this. */)
- (Lisp_Object keys, Lisp_Object accept_default)
-{
- register Lisp_Object map = BVAR (current_buffer, keymap);
- if (NILP (map))
- return Qnil;
- return Flookup_key (map, keys, accept_default);
-}
-
-/* GC is possible in this function if it autoloads a keymap. */
-
-DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
- doc: /* Return the binding for command KEYS in current global keymap
only.
-KEYS is a string or vector, a sequence of keystrokes.
-The binding is probably a symbol with a function definition.
-This function's return values are the same as those of `lookup-key'
-\(which see).
-
-If optional argument ACCEPT-DEFAULT is non-nil, recognize default
-bindings; see the description of `lookup-key' for more details about this. */)
- (Lisp_Object keys, Lisp_Object accept_default)
-{
- return Flookup_key (current_global_map, keys, accept_default);
-}
-
-/* GC is possible in this function if it autoloads a keymap. */
-
DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding,
Sminor_mode_key_binding, 1, 2, 0,
doc: /* Find the visible minor mode bindings of KEY.
Return an alist of pairs (MODENAME . BINDING), where MODENAME is
@@ -3253,8 +3220,6 @@ be preferred. */);
defsubr (&Scopy_keymap);
defsubr (&Scommand_remapping);
defsubr (&Skey_binding);
- defsubr (&Slocal_key_binding);
- defsubr (&Sglobal_key_binding);
defsubr (&Sminor_mode_key_binding);
defsubr (&Sdefine_key);
defsubr (&Slookup_key);
diff --git a/src/lisp.h b/src/lisp.h
index 9d8dbbd..f658868 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4351,6 +4351,7 @@ extern EMACS_INT minibuf_level;
extern Lisp_Object get_minibuffer (EMACS_INT);
extern void init_minibuf_once (void);
extern void syms_of_minibuf (void);
+extern void barf_if_interaction_inhibited (void);
/* Defined in callint.c. */
diff --git a/src/lread.c b/src/lread.c
index 1ff0828..72b68df 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -767,11 +767,16 @@ is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
-floating-point value. */)
+floating-point value.
+
+If `inhibit-interaction' is non-nil, this function will signal an
+`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
Lisp_Object val;
+ barf_if_interaction_inhibited ();
+
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
@@ -782,6 +787,12 @@ floating-point value. */)
DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
doc: /* Read an event object from the input stream.
+
+If you want to read non-character events, consider calling `read-key'
+instead. `read-key' will decode events via `input-decode-map' that
+`read-event' will not. On a terminal this includes function keys such
+as <F7> and <RIGHT>, or mouse events generated by `xterm-mouse-mode'.
+
If the optional argument PROMPT is non-nil, display that as a prompt.
If PROMPT is nil or the string \"\", the key sequence/events that led
to the current command is used as the prompt.
@@ -793,9 +804,14 @@ is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
-floating-point value. */)
+floating-point value.
+
+If `inhibit-interaction' is non-nil, this function will signal an
+`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
+ barf_if_interaction_inhibited ();
+
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
@@ -822,11 +838,16 @@ is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
-floating-point value. */)
- (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
+floating-point value.
+
+If `inhibit-interaction' is non-nil, this function will signal an
+`inhibited-interaction' error. */)
+(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
Lisp_Object val;
+ barf_if_interaction_inhibited ();
+
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
diff --git a/src/minibuf.c b/src/minibuf.c
index 868e481..5df1045 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1075,6 +1075,13 @@ read_minibuf_unwind (void)
}
+void
+barf_if_interaction_inhibited (void)
+{
+ if (inhibit_interaction)
+ xsignal0 (Qinhibited_interaction);
+}
+
DEFUN ("read-from-minibuffer", Fread_from_minibuffer,
Sread_from_minibuffer, 1, 7, 0,
doc: /* Read a string from the minibuffer, prompting with string PROMPT.
@@ -1119,6 +1126,9 @@ If the variable `minibuffer-allow-text-properties' is
non-nil,
then the string which is returned includes whatever text properties
were present in the minibuffer. Otherwise the value has no text properties.
+If `inhibit-interaction' is non-nil, this function will signal an
+ `inhibited-interaction' error.
+
The remainder of this documentation string describes the
INITIAL-CONTENTS argument in more detail. It is only relevant when
studying existing code, or when HIST is a cons. If non-nil,
@@ -1134,6 +1144,8 @@ and some related functions, which use zero-indexing for
POSITION. */)
{
Lisp_Object histvar, histpos, val;
+ barf_if_interaction_inhibited ();
+
CHECK_STRING (prompt);
if (NILP (keymap))
keymap = Vminibuffer_local_map;
@@ -1207,11 +1219,17 @@ point positioned at the end, so that SPACE will accept
the input.
\(Actually, INITIAL can also be a cons of a string and an integer.
Such values are treated as in `read-from-minibuffer', but are normally
not useful in this function.)
+
Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
-the current input method and the setting of`enable-multibyte-characters'. */)
+the current input method and the setting of`enable-multibyte-characters'.
+
+If `inhibit-interaction' is non-nil, this function will signal an
+`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object initial, Lisp_Object inherit_input_method)
{
CHECK_STRING (prompt);
+ barf_if_interaction_inhibited ();
+
return read_minibuf (Vminibuffer_local_ns_map, initial, prompt,
0, Qminibuffer_history, make_fixnum (0), Qnil, 0,
!NILP (inherit_input_method));
@@ -2321,6 +2339,15 @@ This variable also overrides the default character that
`read-passwd'
uses to hide passwords. */);
Vread_hide_char = Qnil;
+ DEFVAR_BOOL ("inhibit-interaction",
+ inhibit_interaction,
+ doc: /* Non-nil means any user interaction will signal an error.
+This variable can be bound when user interaction can't be performed,
+for instance when running a headless Emacs server. Functions like
+`read-from-minibuffer' (and the like) will signal `inhibited-interaction'
+instead. */);
+ inhibit_interaction = 0;
+
defsubr (&Sactive_minibuffer_window);
defsubr (&Sset_minibuffer_window);
defsubr (&Sread_from_minibuffer);
diff --git a/src/process.c b/src/process.c
index dac7d04..aca87f8 100644
--- a/src/process.c
+++ b/src/process.c
@@ -283,6 +283,16 @@ static int max_desc;
the file descriptor of a socket that is already bound. */
static int external_sock_fd;
+/* File descriptor that becomes readable when we receive SIGCHLD. */
+static int child_signal_read_fd = -1;
+/* The write end thereof. The SIGCHLD handler writes to this file
+ descriptor to notify `wait_reading_process_output' of process
+ status changes. */
+static int child_signal_write_fd = -1;
+static void child_signal_init (void);
+static void child_signal_read (int, void *);
+static void child_signal_notify (void);
+
/* Indexed by descriptor, gives the process (if any) for that descriptor. */
static Lisp_Object chan_process[FD_SETSIZE];
static void wait_for_socket_fds (Lisp_Object, char const *);
@@ -2060,6 +2070,10 @@ create_process (Lisp_Object process, char **new_argv,
Lisp_Object current_dir)
Lisp_Object lisp_pty_name = Qnil;
sigset_t oldset;
+ /* Ensure that the SIGCHLD handler can notify
+ `wait_reading_process_output'. */
+ child_signal_init ();
+
inchannel = outchannel = -1;
if (p->pty_flag)
@@ -5395,6 +5409,14 @@ wait_reading_process_output (intmax_t time_limit, int
nsecs, int read_kbd,
check_write = true;
}
+ /* We have to be informed when we receive a SIGCHLD signal for
+ an asynchronous process. Otherwise this might deadlock if we
+ receive a SIGCHLD during `pselect'. */
+ int child_fd = child_signal_read_fd;
+ eassert (child_fd < FD_SETSIZE);
+ if (0 <= child_fd)
+ FD_SET (child_fd, &Available);
+
/* If frame size has changed or the window is newly mapped,
redisplay now, before we start to wait. There is a race
condition here; if a SIGIO arrives between now and the select
@@ -7114,7 +7136,70 @@ process has been transmitted to the serial port. */)
subprocesses which the main thread should not reap. For example,
if the main thread attempted to reap an already-reaped child, it
might inadvertently reap a GTK-created process that happened to
- have the same process ID. */
+ have the same process ID.
+
+ To avoid a deadlock when receiving SIGCHLD while
+ `wait_reading_process_output' is in `pselect', the SIGCHLD handler
+ will notify the `pselect' using a pipe. */
+
+/* Set up `child_signal_read_fd' and `child_signal_write_fd'. */
+
+static void
+child_signal_init (void)
+{
+ /* Either both are initialized, or both are uninitialized. */
+ eassert ((child_signal_read_fd < 0) == (child_signal_write_fd < 0));
+
+ if (0 <= child_signal_read_fd)
+ return; /* already done */
+
+ int fds[2];
+ if (emacs_pipe (fds) < 0)
+ report_file_error ("Creating pipe for child signal", Qnil);
+ if (FD_SETSIZE <= fds[0])
+ {
+ /* Since we need to `pselect' on the read end, it has to fit
+ into an `fd_set'. */
+ emacs_close (fds[0]);
+ emacs_close (fds[1]);
+ report_file_errno ("Creating pipe for child signal", Qnil,
+ EMFILE);
+ }
+
+ /* We leave the file descriptors open until the Emacs process
+ exits. */
+ eassert (0 <= fds[0]);
+ eassert (0 <= fds[1]);
+ add_read_fd (fds[0], child_signal_read, NULL);
+ fd_callback_info[fds[0]].flags &= ~KEYBOARD_FD;
+ child_signal_read_fd = fds[0];
+ child_signal_write_fd = fds[1];
+}
+
+/* Consume a process status change. */
+
+static void
+child_signal_read (int fd, void *data)
+{
+ eassert (0 <= fd);
+ eassert (fd == child_signal_read_fd);
+ char dummy;
+ if (emacs_read (fd, &dummy, 1) < 0)
+ emacs_perror ("reading from child signal FD");
+}
+
+/* Notify `wait_reading_process_output' of a process status
+ change. */
+
+static void
+child_signal_notify (void)
+{
+ int fd = child_signal_write_fd;
+ eassert (0 <= fd);
+ char dummy = 0;
+ if (emacs_write (fd, &dummy, 1) != 1)
+ emacs_perror ("writing to child signal FD");
+}
/* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
its own SIGCHLD handling. On POSIXish systems, glib needs this to
@@ -7152,6 +7237,7 @@ static void
handle_child_signal (int sig)
{
Lisp_Object tail, proc;
+ bool changed = false;
/* Find the process that signaled us, and record its status. */
@@ -7174,6 +7260,7 @@ handle_child_signal (int sig)
eassert (ok);
if (child_status_changed (deleted_pid, 0, 0))
{
+ changed = true;
if (STRINGP (XCDR (head)))
unlink (SSDATA (XCDR (head)));
XSETCAR (tail, Qnil);
@@ -7191,6 +7278,7 @@ handle_child_signal (int sig)
&& child_status_changed (p->pid, &status, WUNTRACED | WCONTINUED))
{
/* Change the status of the process that was found. */
+ changed = true;
p->tick = ++process_tick;
p->raw_status = status;
p->raw_status_new = 1;
@@ -7210,6 +7298,10 @@ handle_child_signal (int sig)
}
}
+ if (changed)
+ /* Wake up `wait_reading_process_output'. */
+ child_signal_notify ();
+
lib_child_handler (sig);
#ifdef NS_IMPL_GNUSTEP
/* NSTask in GNUstep sets its child handler each time it is called.
diff --git a/src/term.c b/src/term.c
index a87f9c7..2e2ab2b 100644
--- a/src/term.c
+++ b/src/term.c
@@ -2382,7 +2382,6 @@ frame's terminal). */)
#ifdef HAVE_GPM
-#ifndef HAVE_WINDOW_SYSTEM
void
term_mouse_moveto (int x, int y)
{
@@ -2396,7 +2395,6 @@ term_mouse_moveto (int x, int y)
last_mouse_x = x;
last_mouse_y = y; */
}
-#endif /* HAVE_WINDOW_SYSTEM */
/* Implementation of draw_row_with_mouse_face for TTY/GPM. */
void
@@ -4246,8 +4244,8 @@ use the Bourne shell command 'TERM=...; export TERM'
(C-shell:\n\
#ifdef HAVE_GPM
terminal->mouse_position_hook = term_mouse_position;
- tty->mouse_highlight.mouse_face_window = Qnil;
#endif
+ tty->mouse_highlight.mouse_face_window = Qnil;
terminal->kboard = allocate_kboard (Qnil);
terminal->kboard->reference_count++;
diff --git a/src/termhooks.h b/src/termhooks.h
index 85a47c0..3800679 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -366,9 +366,7 @@ enum {
#ifdef HAVE_GPM
#include <gpm.h>
extern int handle_one_term_event (struct tty_display_info *, Gpm_Event *);
-#ifndef HAVE_WINDOW_SYSTEM
extern void term_mouse_moveto (int, int);
-#endif
/* The device for which we have enabled gpm support. */
extern struct tty_display_info *gpm_tty;
diff --git a/src/xdisp.c b/src/xdisp.c
index 6a4304d..32e9773 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -9285,8 +9285,8 @@ move_it_in_display_line_to (struct it *it,
if (may_wrap && char_can_wrap_before (it))
{
/* We have reached a glyph that follows one or more
- whitespace characters or a character that allows
- wrapping after it. If this character allows
+ whitespace characters or characters that allow
+ wrapping after them. If this character allows
wrapping before it, save this position as a
wrapping point. */
if (atpos_it.sp >= 0)
@@ -9303,7 +9303,6 @@ move_it_in_display_line_to (struct it *it,
}
/* Otherwise, we can wrap here. */
SAVE_IT (wrap_it, *it, wrap_data);
- next_may_wrap = false;
}
/* Update may_wrap for the next iteration. */
may_wrap = next_may_wrap;
@@ -10650,9 +10649,10 @@ include the height of both, if present, in the return
value. */)
bpos = BEGV_BYTE;
while (bpos < ZV_BYTE)
{
- c = fetch_char_advance (&start, &bpos);
+ c = FETCH_BYTE (bpos);
if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
break;
+ inc_both (&start, &bpos);
}
while (bpos > BEGV_BYTE)
{
@@ -10681,7 +10681,10 @@ include the height of both, if present, in the return
value. */)
dec_both (&end, &bpos);
c = FETCH_BYTE (bpos);
if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
- break;
+ {
+ inc_both (&end, &bpos);
+ break;
+ }
}
while (bpos < ZV_BYTE)
{
@@ -20819,9 +20822,8 @@ try_window_id (struct window *w)
+ window_wants_header_line (w)
+ window_internal_height (w));
-#if defined (HAVE_GPM) || defined (MSDOS)
gui_clear_window_mouse_face (w);
-#endif
+
/* Perform the operation on the screen. */
if (dvpos > 0)
{
diff --git a/test/Makefile.in b/test/Makefile.in
index fc40dad..2d595d9 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -246,6 +246,12 @@ endef
$(foreach test,${TESTS},$(eval $(call test_template,${test})))
+# Get the tests for only a specific directory
+NET_TESTS := $(patsubst %.el,%,$(wildcard lisp/net/*.el))
+LISP_TESTS := $(patsubst %.el,%,$(wildcard lisp/*.el))
+check-net: ${NET_TESTS}
+check-lisp: ${LISP_TESTS}
+
ifeq (@HAVE_MODULES@, yes)
# -fPIC is a no-op on Windows, but causes a compiler warning
ifeq ($(SO),.dll)
diff --git a/test/README b/test/README
index ec566cb..38f4a10 100644
--- a/test/README
+++ b/test/README
@@ -39,6 +39,12 @@ The Makefile in this directory supports the following
targets:
* make check-all
Like "make check", but run all tests.
+* make check-lisp
+ Like "make check", but run only the tests in test/lisp/*.el
+
+* make check-net
+ Like "make check", but run only the tests in test/lisp/net/*.el
+
* make <filename> -or- make <filename>.log
Run all tests declared in <filename>.el. This includes expensive
tests. In the former case the output is shown on the terminal, in
diff --git a/test/file-organization.org b/test/file-organization.org
index 64c0755..efc3545 100644
--- a/test/file-organization.org
+++ b/test/file-organization.org
@@ -57,3 +57,8 @@ directory called ~test/lisp/progmodes/flymake-resources~.
No guidance is given for the organization of resource files inside the
~-resources~ directory; files can be organized at the author's
discretion.
+
+** Testing Infrastructure Files
+
+Files used to support testing infrastructure such as EMBA should be
+placed in ~infra~.
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba
new file mode 100644
index 0000000..421264d
--- /dev/null
+++ b/test/infra/Dockerfile.emba
@@ -0,0 +1,71 @@
+# Copyright (C) 2021 Free Software Foundation, Inc.
+#
+# This file is part of GNU Emacs.
+#
+# GNU Emacs is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# GNU Emacs is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+# GNU Emacs support for the GitLab-specific build of Docker images.
+
+# The presence of this file does not imply any FSF/GNU endorsement of
+# Docker or any other particular tool. Also, it is intended for
+# evaluation purposes, thus possibly temporary.
+
+# Maintainer: Ted Zlatanov <tzz@lifelogs.com>
+# URL: https://emba.gnu.org/emacs/emacs
+
+FROM debian:stretch as emacs-base
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
+ libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev git \
+ && rm -rf /var/lib/apt/lists/*
+
+FROM emacs-base as emacs-inotify
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0
inotify-tools \
+ && rm -rf /var/lib/apt/lists/*
+
+COPY . /checkout
+WORKDIR /checkout
+RUN ./autogen.sh autoconf
+RUN ./configure --without-makeinfo
+RUN make -j4 bootstrap
+RUN make -j4
+
+FROM emacs-base as emacs-filenotify-gio
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0
libglib2.0-dev libglib2.0-bin libglib2.0-0 \
+ && rm -rf /var/lib/apt/lists/*
+
+COPY . /checkout
+WORKDIR /checkout
+RUN ./autogen.sh autoconf
+RUN ./configure --without-makeinfo --with-file-notification=gfile
+RUN make bootstrap
+RUN make -j4
+
+FROM emacs-base as emacs-gnustep
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0
gnustep-devel \
+ && rm -rf /var/lib/apt/lists/*
+
+COPY . /checkout
+WORKDIR /checkout
+RUN ./autogen.sh autoconf
+RUN ./configure --without-makeinfo --with-ns
+RUN make bootstrap
+RUN make -j4
diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml
new file mode 100644
index 0000000..f9c0e0c
--- /dev/null
+++ b/test/infra/gitlab-ci.yml
@@ -0,0 +1,217 @@
+# Copyright (C) 2017-2021 Free Software Foundation, Inc.
+#
+# This file is part of GNU Emacs.
+#
+# GNU Emacs is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# GNU Emacs is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+# GNU Emacs support for the GitLab protocol for CI
+
+# The presence of this file does not imply any FSF/GNU endorsement of
+# any particular service that uses that protocol. Also, it is intended for
+# evaluation purposes, thus possibly temporary.
+
+# Maintainer: Ted Zlatanov <tzz@lifelogs.com>
+# URL: https://emba.gnu.org/emacs/emacs
+
+# Never run merge request pipelines, they usually duplicate push pipelines
+# see
https://docs.gitlab.com/ee/ci/yaml/README.html#common-if-clauses-for-rules
+
+# Rules: always run tags and branches named master*, emacs*, feature*, fix*
+# Test that it triggers by pushing a tag: `git tag mytag; git push origin
mytag`
+# Test that it triggers by pushing to: feature/emba, feature1, master,
master-2, fix/emba, emacs-299, fix-2
+# Test that it doesn't trigger by pushing to: scratch-2, scratch/emba,
oldbranch, dev
+workflow:
+ rules:
+ - if: '$CI_PIPELINE_SOURCE == "merge_request_event"'
+ when: never
+ - if: '$CI_COMMIT_TAG'
+ when: always
+ - if: '$CI_COMMIT_BRANCH !~ /^(master|emacs|feature|fix)/'
+ when: never
+ - when: always
+
+variables:
+ GIT_STRATEGY: fetch
+ EMACS_EMBA_CI: 1
+ # # Use TLS
https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled
+ # DOCKER_HOST: tcp://docker:2376
+ # DOCKER_TLS_CERTDIR: "/certs"
+ # Put the configuration for each run in a separate directory to avoid
conflicts
+ DOCKER_CONFIG: "/.docker-config-${CI_COMMIT_SHA}"
+
+default:
+ image: docker:19.03.12
+ timeout: 3 hours
+ before_script:
+ - docker info
+ - echo "docker registry is ${CI_REGISTRY}"
+ - docker login -u ${CI_REGISTRY_USER} -p ${CI_REGISTRY_PASSWORD}
${CI_REGISTRY}
+
+.job-template:
+ # these will be cached across builds
+ cache:
+ key: ${CI_COMMIT_SHA}
+ paths: []
+ policy: pull-push
+ # these will be saved for followup builds
+ artifacts:
+ expire_in: 24 hrs
+ paths: []
+ # - "test/**/*.log"
+ # - "**/*.log"
+
+.build-template:
+ script:
+ - docker build --pull --target ${target} -t
${CI_REGISTRY_IMAGE}:${target}-${CI_COMMIT_SHA} -f test/infra/Dockerfile.emba .
+ - docker push ${CI_REGISTRY_IMAGE}:${target}-${CI_COMMIT_SHA}
+
+.gnustep-template:
+ rules:
+ - if: '$CI_PIPELINE_SOURCE == "schedule"'
+ changes:
+ - "**/Makefile.in"
+ - .gitlab-ci.yml
+ - configure.ac
+ - src/ns*.{h,m}
+ - src/macfont.{h,m}
+ - lisp/term/ns-win.el
+ - nextstep/**/*
+ - test/infra/*
+
+.filenotify-gio-template:
+ rules:
+ - if: '$CI_PIPELINE_SOURCE == "schedule"'
+ changes:
+ - "**/Makefile.in"
+ - .gitlab-ci.yml
+ - lisp/autorevert.el
+ - lisp/filenotify.el
+ - lisp/net/tramp-sh.el
+ - src/gfilenotify.c
+ - test/infra/*
+ - test/lisp/autorevert-tests.el
+ - test/lisp/filenotify-tests.el
+
+.test-template:
+ rules:
+ - changes:
+ - "**/Makefile.in"
+ - .gitlab-ci.yml
+ - aclocal.m4
+ - autogen.sh
+ - configure.ac
+ - lib/*.{h,c}
+ - lisp/**/*.el
+ - src/*.{h,c}
+ - test/infra/*
+ - test/lisp/**/*.el
+ - test/src/*.el
+ - changes:
+ # gfilemonitor, kqueue
+ - src/gfilenotify.c
+ - src/kqueue.c
+ # MS Windows
+ - "**/w32*"
+ # GNUstep
+ - lisp/term/ns-win.el
+ - src/ns*.{h,m}
+ - src/macfont.{h,m}
+ when: never
+
+ # using the variables for each job
+ script:
+ - docker pull ${CI_REGISTRY_IMAGE}:${target}-${CI_COMMIT_SHA}
+ # TODO: with make -j4 several of the tests were failing, for example
shadowfile-tests, but passed without it
+ - docker run -i --rm -e EMACS_EMBA_CI=${EMACS_EMBA_CI}
${CI_REGISTRY_IMAGE}:${target}-${CI_COMMIT_SHA} make ${make_params}
+
+stages:
+ - prep-images
+ - build-images
+ - fast
+ - normal
+ - platform-images
+ - platforms
+ - slow
+
+prep-image-base:
+ stage: prep-images
+ extends: [.job-template, .build-template]
+ variables:
+ target: emacs-base
+
+build-image-inotify:
+ stage: build-images
+ extends: [.job-template, .build-template]
+ variables:
+ target: emacs-inotify
+
+test-fast-inotify:
+ stage: fast
+ extends: [.job-template, .test-template]
+ variables:
+ target: emacs-inotify
+ make_params: "-C test check"
+
+build-image-filenotify-gio:
+ stage: platform-images
+ extends: [.job-template, .build-template, .filenotify-gio-template]
+ variables:
+ target: emacs-filenotify-gio
+
+build-image-gnustep:
+ stage: platform-images
+ extends: [.job-template, .build-template, .gnustep-template]
+ variables:
+ target: emacs-gnustep
+
+test-lisp-inotify:
+ stage: normal
+ extends: [.job-template, .test-template]
+ variables:
+ target: emacs-inotify
+ make_params: "-C test check-lisp"
+
+test-net-inotify:
+ stage: normal
+ extends: [.job-template, .test-template]
+ variables:
+ target: emacs-inotify
+ make_params: "-C test check-net"
+
+test-filenotify-gio:
+ # This tests file monitor libraries gfilemonitor and gio.
+ stage: platforms
+ extends: [.job-template, .test-template, .filenotify-gio-template]
+ variables:
+ target: emacs-filenotify-gio
+ make_params: "-k -C test autorevert-tests filenotify-tests"
+
+test-gnustep:
+ # This tests the GNUstep build process
+ stage: platforms
+ extends: [.job-template, .test-template, .gnustep-template]
+ variables:
+ target: emacs-gnustep
+ make_params: install
+
+test-all-inotify:
+ # This tests also file monitor libraries inotify and inotifywatch.
+ stage: slow
+ extends: [.job-template, .test-template]
+ rules:
+ # note there's no "changes" section, so this always runs on a schedule
+ - if: '$CI_PIPELINE_SOURCE == "schedule"'
+ variables:
+ target: emacs-inotify
+ make_params: check-expensive
diff --git a/test/lisp/calendar/lunar-tests.el
b/test/lisp/calendar/lunar-tests.el
index 5f1f678..268dcfd 100644
--- a/test/lisp/calendar/lunar-tests.el
+++ b/test/lisp/calendar/lunar-tests.el
@@ -27,39 +27,37 @@
(defmacro with-lunar-test (&rest body)
`(let ((calendar-latitude 40.1)
(calendar-longitude -88.2)
- (calendar-location-name "Urbana, IL")
- (calendar-time-zone -360)
- (calendar-standard-time-zone-name "CST")
- (calendar-time-display-form '(12-hours ":" minutes am-pm)))
+ (calendar-location-name "Paris")
+ (calendar-time-zone 0)
+ (calendar-standard-time-zone-name "UTC")
+ ;; Make sure daylight saving is disabled to avoid interference
+ ;; from the system settings (see bug#45818).
+ (calendar-daylight-savings-starts nil)
+ (calendar-time-display-form '(24-hours ":" minutes)))
,@body))
(ert-deftest lunar-test-phase ()
(with-lunar-test
(should (equal (lunar-phase 1)
- '((1 7 1900) "11:40pm" 1 "")))))
+ '((1 8 1900) "05:40" 1 "")))))
(ert-deftest lunar-test-eclipse-check ()
(with-lunar-test
(should (equal (eclipse-check 1 1) "** Eclipse **"))))
-;; This fails in certain time zones.
-;; Eg TZ=America/Phoenix make lisp/calendar/lunar-tests
-;; Similarly with TZ=UTC.
-;; Daylight saving related?
(ert-deftest lunar-test-phase-list ()
- :tags '(:unstable)
(with-lunar-test
(should (equal (lunar-phase-list 3 1871)
- '(((3 20 1871) "11:03pm" 0 "")
- ((3 29 1871) "1:46am" 1 "** Eclipse **")
- ((4 5 1871) "9:20am" 2 "")
- ((4 12 1871) "12:57am" 3 "** Eclipse possible **")
- ((4 19 1871) "2:06pm" 0 "")
- ((4 27 1871) "6:49pm" 1 "")
- ((5 4 1871) "5:57pm" 2 "")
- ((5 11 1871) "9:29am" 3 "")
- ((5 19 1871) "5:46am" 0 "")
- ((5 27 1871) "8:02am" 1 ""))))))
+ '(((3 21 1871) "04:03" 0 "")
+ ((3 29 1871) "06:46" 1 "** Eclipse **")
+ ((4 5 1871) "14:20" 2 "")
+ ((4 12 1871) "05:57" 3 "** Eclipse possible **")
+ ((4 19 1871) "19:06" 0 "")
+ ((4 27 1871) "23:49" 1 "")
+ ((5 4 1871) "22:57" 2 "")
+ ((5 11 1871) "14:29" 3 "")
+ ((5 19 1871) "10:46" 0 "")
+ ((5 27 1871) "13:02" 1 ""))))))
(ert-deftest lunar-test-new-moon-time ()
(with-lunar-test
diff --git a/test/lisp/calendar/solar-tests.el
b/test/lisp/calendar/solar-tests.el
index 7a37f8d..337deb8 100644
--- a/test/lisp/calendar/solar-tests.el
+++ b/test/lisp/calendar/solar-tests.el
@@ -26,7 +26,9 @@
(calendar-longitude 75.8)
(calendar-time-zone +330)
(calendar-standard-time-zone-name "IST")
- (calendar-daylight-time-zone-name "IST")
+ ;; Make sure our clockwork isn't confused by daylight saving rules
+ ;; in effect for any other time zone (bug#45818).
+ (calendar-daylight-savings-starts nil)
(epsilon (/ 60.0))) ; Minute accuracy is good enough.
(let* ((sunrise-sunset (solar-sunrise-sunset '(12 30 2020)))
(sunrise (car (nth 0 sunrise-sunset)))
diff --git a/test/lisp/cedet/semantic-utest.el
b/test/lisp/cedet/semantic-utest.el
index c009938..67de4a5 100644
--- a/test/lisp/cedet/semantic-utest.el
+++ b/test/lisp/cedet/semantic-utest.el
@@ -577,10 +577,8 @@ INSERTME is the text to be inserted after the deletion."
(ert-deftest semantic-utest-Javascript()
- (if (fboundp 'javascript-mode)
- (semantic-utest-generic (semantic-utest-fname "javascripttest.js")
semantic-utest-Javascript-buffer-contents
semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line")
- (message "Skipping JavaScript test: NO major mode."))
- )
+ (skip-unless (fboundp 'javascript-mode))
+ (semantic-utest-generic (semantic-utest-fname "javascripttest.js")
semantic-utest-Javascript-buffer-contents
semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line"))
(ert-deftest semantic-utest-Java()
;; If JDE is installed, it might mess things up depending on the version
diff --git a/test/lisp/cedet/srecode-utest-getset.el
b/test/lisp/cedet/srecode-utest-getset.el
index 0497dea..1c65780 100644
--- a/test/lisp/cedet/srecode-utest-getset.el
+++ b/test/lisp/cedet/srecode-utest-getset.el
@@ -128,7 +128,6 @@ private:
(srecode-utest-getset-jumptotag "miscFunction"))
(let ((pos (point)))
- (skip-chars-backward " \t\n") ; xemacs forward-comment is different.
(forward-comment -1)
(re-search-forward "miscFunction" pos))
diff --git a/test/lisp/cedet/srecode-utest-template.el
b/test/lisp/cedet/srecode-utest-template.el
index 57d8a64..f97ff18 100644
--- a/test/lisp/cedet/srecode-utest-template.el
+++ b/test/lisp/cedet/srecode-utest-template.el
@@ -307,13 +307,9 @@ INSIDE SECTION: ARG HANDLER ONE")
(should (srecode-table major-mode))
;; Loop over the output testpoints.
-
(dolist (p srecode-utest-output-entries)
- (set-buffer testbuff) ;; XEmacs causes a buffer switch. I don't know
why
- (should-not (srecode-utest-test p))
- )
+ (should-not (srecode-utest-test p)))))
- ))
(when (file-exists-p srecode-utest-testfile)
(delete-file srecode-utest-testfile)))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index a07af18..263736a 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -617,13 +617,13 @@ Subtests signal errors if something goes wrong."
(make-obsolete-variable 'bytecomp--tests-obsolete-var nil "99.99")
(bytecomp--define-warning-file-test "warn-obsolete-hook.el"
- "bytecomp--tests-obs.*obsolete.*99.99")
+ "bytecomp--tests-obs.*obsolete[^z-a]*99.99")
(bytecomp--define-warning-file-test "warn-obsolete-variable-same-file.el"
"foo-obs.*obsolete.*99.99" t)
(bytecomp--define-warning-file-test "warn-obsolete-variable.el"
- "bytecomp--tests-obs.*obsolete.*99.99")
+ "bytecomp--tests-obs.*obsolete[^z-a]*99.99")
(bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el"
"bytecomp--tests-obs.*obsolete.*99.99" t)
diff --git a/test/lisp/emacs-lisp/pcase-tests.el
b/test/lisp/emacs-lisp/pcase-tests.el
index 1b06c6e..e6f4c09 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -32,6 +32,10 @@
(should (equal (pcase '(2 . 3) ;bug#18554
(`(,hd . ,(and (pred atom) tl)) (list hd tl))
((pred consp) nil))
+ '(2 3)))
+ (should (equal (pcase '(2 . 3)
+ (`(,hd . ,(and (pred (not consp)) tl)) (list hd tl))
+ ((pred consp) nil))
'(2 3))))
(pcase-defmacro pcase-tests-plus (pat n)
diff --git a/test/lisp/emacs-lisp/timer-tests.el
b/test/lisp/emacs-lisp/timer-tests.el
index 74da33e..7856c21 100644
--- a/test/lisp/emacs-lisp/timer-tests.el
+++ b/test/lisp/emacs-lisp/timer-tests.el
@@ -36,8 +36,8 @@
(ert-deftest timer-tests-debug-timer-check ()
;; This function exists only if --enable-checking.
- (if (fboundp 'debug-timer-check)
- (should (debug-timer-check)) t))
+ (skip-unless (fboundp 'debug-timer-check))
+ (should (debug-timer-check)))
(ert-deftest timer-test-multiple-of-time ()
(should (time-equal-p
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 835d9fe..8034764 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -95,7 +95,7 @@
key binding
--- -------
-C-g abort-recursive-edit
+C-g abort-minibuffers
TAB minibuffer-complete
C-j minibuffer-complete-and-exit
RET minibuffer-complete-and-exit
@@ -122,7 +122,7 @@ M-s next-matching-history-element
(ert-deftest help-tests-substitute-command-keys/keymap-change ()
(with-substitute-command-keys-test
- (test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-g")
+ (test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-]")
(test "\\<emacs-lisp-mode-map>\\[eval-defun]" "C-M-x")))
(defvar help-tests-remap-map
diff --git a/test/lisp/net/nsm-tests.el b/test/lisp/net/nsm-tests.el
index 88c30c2..ff45331 100644
--- a/test/lisp/net/nsm-tests.el
+++ b/test/lisp/net/nsm-tests.el
@@ -49,15 +49,17 @@
(should (eq nil (nsm-should-check "127.0.0.1")))
(should (eq nil (nsm-should-check "localhost"))))))
-(defun nsm-ipv6-is-available ()
+;; This will need updating when IANA assign more IPv6 global ranges.
+(defun ipv6-is-available ()
(and (featurep 'make-network-process '(:family ipv6))
(cl-rassoc-if
(lambda (elt)
- (eq 9 (length elt)))
+ (and (eq 9 (length elt))
+ (= (logand (aref elt 0) #xe000) #x2000)))
(network-interface-list))))
(ert-deftest nsm-check-local-subnet-ipv6 ()
- (skip-unless (nsm-ipv6-is-available))
+ (skip-unless (ipv6-is-available))
(let ((local-ip '[123 456 789 11 172 26 128 160 0])
(mask '[255 255 255 255 255 255 255 0 0])
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 3995006..ef0968a 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -78,6 +78,8 @@
;; Needed for Emacs 27.
(defvar process-file-return-signal-string)
(defvar shell-command-dont-erase-buffer)
+;; Needed for Emacs 28.
+(defvar dired-copy-dereference)
;; Beautify batch mode.
(when noninteractive
@@ -98,7 +100,6 @@
'("mock"
(tramp-login-program "sh")
(tramp-login-args (("-i")))
- (tramp-direct-async-args (("-c")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
@@ -2438,7 +2439,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
;; We must check the last line. There could be
;; other messages from the progress reporter.
(should
- (string-match
+ (string-match-p
(if (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(format "^Wrote %s\n\\'" (regexp-quote tmp-name))
@@ -2833,6 +2834,7 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ert-deftest tramp-test15-copy-directory ()
"Check `copy-directory'."
(skip-unless (tramp--test-enabled))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
@@ -3612,8 +3614,8 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
`(condition-case err
(progn ,@body)
(file-error
- (unless (string-match "^error with add-name-to-file"
- (error-message-string err))
+ (unless (string-match-p "^error with add-name-to-file"
+ (error-message-string err))
(signal (car err) (cdr err))))))
(ert-deftest tramp-test21-file-links ()
@@ -4388,7 +4390,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; there's an indication for a signal describing string.
(let ((process-file-return-signal-string t))
(should
- (string-match
+ (string-match-p
"Interrupt\\|Signal 2"
(process-file
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
@@ -4456,7 +4458,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4475,7 +4477,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors
@@ -4497,7 +4499,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4539,8 +4541,6 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(cons '(nil "direct-async-process" t)
tramp-connection-properties)))
(skip-unless (tramp-direct-async-process-p))
- ;; For whatever reason, it doesn't cooperate with the "mock" method.
- (skip-unless (not (tramp--test-mock-p)))
;; We do expect an established connection already,
;; `file-truename' does it by side-effect. Suppress
;; `tramp--test-enabled', in order to keep the connection.
@@ -4586,7 +4586,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4607,7 +4607,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors
@@ -4631,9 +4631,9 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
- (while (not (string-match "foo" (buffer-string)))
+ (while (not (string-match-p "foo" (buffer-string)))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4658,7 +4658,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
;; On some MS Windows systems, it returns "unknown signal".
- (should (string-match "unknown signal\\|killed" (buffer-string))))
+ (should (string-match-p "unknown signal\\|killed" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4682,7 +4682,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(delete-process proc)
(with-current-buffer stderr
(should
- (string-match
+ (string-match-p
"cat:.* No such file or directory" (buffer-string)))))
;; Cleanup.
@@ -4709,7 +4709,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(with-temp-buffer
(insert-file-contents tmpfile)
(should
- (string-match
+ (string-match-p
"cat:.* No such file or directory" (buffer-string)))))
;; Cleanup.
@@ -4852,7 +4852,7 @@ INPUT, if non-nil, is a string sent to the process."
(should
(string-equal
;; tramp-adb.el echoes, so we must add the string.
- (if (tramp--test-adb-p)
+ (if (and (tramp--test-adb-p) (not (tramp-direct-async-process-p)))
(format
"%s\n%s\n"
(file-name-nondirectory tmp-name)
@@ -5043,7 +5043,7 @@ INPUT, if non-nil, is a string sent to the process."
(cons (concat envvar "=foo") process-environment)))
;; Default value.
(should
- (string-match
+ (string-match-p
"foo"
(funcall
this-shell-command-to-string
@@ -5054,13 +5054,13 @@ INPUT, if non-nil, is a string sent to the process."
(cons (concat envvar "=") process-environment)))
;; Value is null.
(should
- (string-match
+ (string-match-p
"bla"
(funcall
this-shell-command-to-string (format "echo \"${%s:-bla}\"" envvar))))
;; Variable is set.
(should
- (string-match
+ (string-match-p
(regexp-quote envvar)
(funcall this-shell-command-to-string "set"))))
@@ -5072,7 +5072,7 @@ INPUT, if non-nil, is a string sent to the process."
(cons (concat envvar "=foo") tramp-remote-process-environment)))
;; Set the initial value, we want to unset below.
(should
- (string-match
+ (string-match-p
"foo"
(funcall
this-shell-command-to-string
@@ -5080,14 +5080,14 @@ INPUT, if non-nil, is a string sent to the process."
(let ((process-environment (cons envvar process-environment)))
;; Variable is unset.
(should
- (string-match
+ (string-match-p
"bla"
(funcall
this-shell-command-to-string
(format "echo \"${%s:-bla}\"" envvar))))
;; Variable is unset.
(should-not
- (string-match
+ (string-match-p
(regexp-quote envvar)
;; We must remove PS1, the output is truncated otherwise.
(funcall
@@ -5125,7 +5125,7 @@ Use direct async.")
(format "%s=%d" envvar port)
tramp-remote-process-environment)))
(should
- (string-match
+ (string-match-p
(number-to-string port)
(shell-command-to-string (format "echo $%s" envvar))))))
@@ -5253,7 +5253,7 @@ Use direct async.")
(with-timeout (10)
(while (accept-process-output
(get-buffer-process (current-buffer)) nil nil t)))
- (should (string-match "^foo$" (buffer-string)))))
+ (should (string-match-p "^foo$" (buffer-string)))))
;; Cleanup.
(put 'explicit-shell-file-name 'permanent-local nil)
@@ -5388,25 +5388,27 @@ Use direct async.")
(tramp-remote-process-environment tramp-remote-process-environment)
(inhibit-message t)
(vc-handled-backends
- (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
- (cond
- ((tramp-find-executable
- v vc-git-program (tramp-get-remote-path v))
- '(Git))
- ((tramp-find-executable
- v vc-hg-program (tramp-get-remote-path v))
- '(Hg))
- ((tramp-find-executable
- v vc-bzr-program (tramp-get-remote-path v))
- (setq tramp-remote-process-environment
- (cons (format "BZR_HOME=%s"
- (file-remote-p tmp-name1 'localname))
- tramp-remote-process-environment))
- ;; We must force a reconnect, in order to activate $BZR_HOME.
- (tramp-cleanup-connection
- tramp-test-vec 'keep-debug 'keep-password)
- '(Bzr))
- (t nil))))
+ (cond
+ ((tramp-find-executable
+ tramp-test-vec vc-git-program
+ (tramp-get-remote-path tramp-test-vec))
+ '(Git))
+ ((tramp-find-executable
+ tramp-test-vec vc-hg-program
+ (tramp-get-remote-path tramp-test-vec))
+ '(Hg))
+ ((tramp-find-executable
+ tramp-test-vec vc-bzr-program
+ (tramp-get-remote-path tramp-test-vec))
+ (setq tramp-remote-process-environment
+ (cons (format "BZR_HOME=%s"
+ (file-remote-p tmp-name1 'localname))
+ tramp-remote-process-environment))
+ ;; We must force a reconnect, in order to activate $BZR_HOME.
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ '(Bzr))
+ (t nil)))
;; Suppress nasty messages.
(inhibit-message t))
(skip-unless vc-handled-backends)
@@ -5732,7 +5734,7 @@ This does not support some special file names."
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
;; Globbing characters are ??, ?* and ?\[.
- (string-match
+ (string-match-p
"ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
(defun tramp--test-gvfs-p (&optional method)
@@ -5746,18 +5748,18 @@ If optional METHOD is given, it is checked first."
"Check, whether the remote host runs HP-UX.
Several special characters do not work properly there."
;; We must refill the cache. `file-truename' does it.
- (with-parsed-tramp-file-name
- (file-truename tramp-test-temporary-file-directory) nil
- (string-match "^HP-UX" (tramp-get-connection-property v "uname" ""))))
+ (file-truename tramp-test-temporary-file-directory) nil
+ (string-match-p
+ "^HP-UX" (tramp-get-connection-property tramp-test-vec "uname" "")))
(defun tramp--test-ksh-p ()
"Check, whether the remote shell is ksh.
ksh93 makes some strange conversions of non-latin characters into
a $'' syntax."
;; We must refill the cache. `file-truename' does it.
- (with-parsed-tramp-file-name
- (file-truename tramp-test-temporary-file-directory) nil
- (string-match "ksh$" (tramp-get-connection-property v "remote-shell" ""))))
+ (file-truename tramp-test-temporary-file-directory) nil
+ (string-match-p
+ "ksh$" (tramp-get-connection-property tramp-test-vec "remote-shell" "")))
(defun tramp--test-mock-p ()
"Check, whether the mock method is used.
@@ -5809,7 +5811,7 @@ This does not support special characters."
"Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
This does not support utf8 based file transfer."
(and (eq system-type 'windows-nt)
- (string-match
+ (string-match-p
(regexp-opt '("pscp" "psftp"))
(file-remote-p tramp-test-temporary-file-directory 'method))))
@@ -6072,6 +6074,7 @@ This requires restrictions of file name syntax."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(tramp--test-special-characters))
@@ -6083,6 +6086,8 @@ Use the `stat' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ ;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -6101,6 +6106,8 @@ Use the `perl' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ ;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -6123,6 +6130,7 @@ Use the `ls' command."
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(let ((tramp-connection-properties
(append
@@ -6191,6 +6199,7 @@ Use the `ls' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(tramp--test-utf8))
@@ -6206,6 +6215,8 @@ Use the `stat' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ ;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -6228,6 +6239,8 @@ Use the `perl' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ ;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -6253,6 +6266,7 @@ Use the `ls' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(let ((tramp-connection-properties
(append
@@ -6541,7 +6555,7 @@ process sentinels. They shall not disturb each other."
(message \"Tramp loaded: %%s\" (and (file-remote-p %S) t)))"
tramp-test-temporary-file-directory)))
(should
- (string-match
+ (string-match-p
"Tramp loaded: t[\n\r]+"
(shell-command-to-string
(format
@@ -6572,7 +6586,7 @@ process sentinels. They shall not disturb each other."
;; Tramp doesn't load when `tramp-mode' is nil.
(dolist (tm '(t nil))
(should
- (string-match
+ (string-match-p
(format
"Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded:
%s[\n\r]+"
tm)
@@ -6598,7 +6612,7 @@ process sentinels. They shall not disturb each other."
tramp-test-temporary-file-directory
temporary-file-directory)))
(should-not
- (string-match
+ (string-match-p
"Recursive load"
(shell-command-to-string
(format
@@ -6623,7 +6637,7 @@ process sentinels. They shall not disturb each other."
(load-path (cons \"/foo:bar:\" load-path))) \
(tramp-cleanup-all-connections))"))
(should
- (string-match
+ (string-match-p
(format
"Loading %s"
(regexp-quote
@@ -6670,11 +6684,11 @@ Since it unloads Tramp, it shall be the last test to
run."
(lambda (x)
(and (or (and (boundp x) (null (local-variable-if-set-p x)))
(and (functionp x) (null (autoloadp (symbol-function x)))))
- (string-match "^tramp" (symbol-name x))
+ (string-match-p "^tramp" (symbol-name x))
;; `tramp-completion-mode' is autoloaded in Emacs < 28.1.
(not (eq 'tramp-completion-mode x))
- (not (string-match "^tramp\\(-archive\\)?--?test" (symbol-name x)))
- (not (string-match "unload-hook$" (symbol-name x)))
+ (not (string-match-p "^tramp\\(-archive\\)?--?test" (symbol-name x)))
+ (not (string-match-p "unload-hook$" (symbol-name x)))
(ert-fail (format "`%s' still bound" x)))))
;; The defstruct `tramp-file-name' and all its internal functions
;; shall be purged.
@@ -6682,15 +6696,15 @@ Since it unloads Tramp, it shall be the last test to
run."
(mapatoms
(lambda (x)
(and (functionp x)
- (string-match "tramp-file-name" (symbol-name x))
+ (string-match-p "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.
(mapatoms
(lambda (x)
(and (boundp x)
- (string-match "-\\(hook\\|function\\)s?$" (symbol-name x))
- (not (string-match "unload-hook$" (symbol-name x)))
+ (string-match-p "-\\(hook\\|function\\)s?$" (symbol-name x))
+ (not (string-match-p "unload-hook$" (symbol-name x)))
(consp (symbol-value x))
(ignore-errors (all-completions "tramp" (symbol-value x)))
(ert-fail (format "Hook `%s' still contains Tramp function" x))))))
diff --git a/test/lisp/progmodes/elisp-mode-tests.el
b/test/lisp/progmodes/elisp-mode-tests.el
index a10d5da..fd43707 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -314,7 +314,19 @@
(let* ((xref (pop xrefs))
(expected (pop expected-xrefs))
(expected-xref (or (when (consp expected) (car expected)) expected))
- (expected-source (when (consp expected) (cdr expected))))
+ (expected-source (when (consp expected) (cdr expected)))
+ (xref-file (xref-elisp-location-file (oref xref location)))
+ (expected-file (xref-elisp-location-file
+ (oref expected-xref location))))
+
+ ;; Make sure file names compare as strings.
+ (when (file-name-absolute-p xref-file)
+ (setf (xref-elisp-location-file (oref xref location))
+ (file-truename (xref-elisp-location-file (oref xref location)))))
+ (when (file-name-absolute-p expected-file)
+ (setf (xref-elisp-location-file (oref expected-xref location))
+ (file-truename (xref-elisp-location-file
+ (oref expected-xref location)))))
;; Downcase the filenames for case-insensitive file systems.
(when xref--case-insensitive
diff --git a/test/lisp/progmodes/tcl-tests.el b/test/lisp/progmodes/tcl-tests.el
index 8ff8547..cf1ed28 100644
--- a/test/lisp/progmodes/tcl-tests.el
+++ b/test/lisp/progmodes/tcl-tests.el
@@ -50,14 +50,14 @@
(insert "proc notinthis {} {\n # nothing\n}\n\n")
(should-not (add-log-current-defun))))
-(ert-deftest tcl-mode-function-name ()
+(ert-deftest tcl-mode-function-name-2 ()
(with-temp-buffer
(tcl-mode)
(insert "proc simple {} {\n # nothing\n}")
(backward-char 3)
(should (equal "simple" (add-log-current-defun)))))
-(ert-deftest tcl-mode-function-name ()
+(ert-deftest tcl-mode-function-name-3 ()
(with-temp-buffer
(tcl-mode)
(insert "proc inthis {} {\n # nothing\n")
@@ -72,6 +72,16 @@
(indent-region (point-min) (point-max))
(should (equal (buffer-string) text)))))
+;; From bug#44834
+(ert-deftest tcl-mode-namespace-indent-2 ()
+ :expected-result :failed
+ (with-temp-buffer
+ (tcl-mode)
+ (let ((text "namespace eval Foo {\n proc foo {} {}\n\n proc bar
{}{}}\n"))
+ (insert text)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) text)))))
+
(provide 'tcl-tests)
;;; tcl-tests.el ends here
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index e082620..fc5a1eb 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -87,6 +87,17 @@
;; Returns the symbol.
(should (eq (define-prefix-command 'foo-bar) 'foo-bar)))
+(ert-deftest subr-test-local-key-binding ()
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (should (keymapp (local-key-binding [menu-bar])))
+ (should-not (local-key-binding [f12]))))
+
+(ert-deftest subr-test-global-key-binding ()
+ (should (eq (global-key-binding [f1]) 'help-command))
+ (should (eq (global-key-binding "x") 'self-insert-command))
+ (should-not (global-key-binding [f12])))
+
;;;; Mode hooks.
diff --git a/test/src/decompress-tests.el b/test/src/decompress-tests.el
index 67a7fef..520445c 100644
--- a/test/src/decompress-tests.el
+++ b/test/src/decompress-tests.el
@@ -29,16 +29,16 @@
(ert-deftest zlib--decompress ()
"Test decompressing a gzipped file."
- (when (and (fboundp 'zlib-available-p)
- (zlib-available-p))
- (should (string=
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-file-contents-literally
- (expand-file-name "foo.gz" zlib-tests-data-directory))
- (zlib-decompress-region (point-min) (point-max))
- (buffer-string))
- "foo\n"))))
+ (skip-unless (and (fboundp 'zlib-available-p)
+ (zlib-available-p)))
+ (should (string=
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally
+ (expand-file-name "foo.gz" zlib-tests-data-directory))
+ (zlib-decompress-region (point-min) (point-max))
+ (buffer-string))
+ "foo\n")))
(provide 'decompress-tests)
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index a9daf87..e0aed2a 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -1040,3 +1040,61 @@
(let ((list (list 1)))
(setcdr list list)
(length< list #x1fffe))))
+
+(defun approx-equal (list1 list2)
+ (and (equal (length list1) (length list2))
+ (cl-loop for v1 in list1
+ for v2 in list2
+ when (not (or (= v1 v2)
+ (< (abs (- v1 v2)) 0.1)))
+ return nil
+ finally return t)))
+
+(ert-deftest test-buffer-line-stats-nogap ()
+ (with-temp-buffer
+ (insert "")
+ (should (approx-equal (buffer-line-statistics) '(0 0 0))))
+ (with-temp-buffer
+ (insert "123\n")
+ (should (approx-equal (buffer-line-statistics) '(1 3 3))))
+ (with-temp-buffer
+ (insert "123\n12345\n123\n")
+ (should (approx-equal (buffer-line-statistics) '(3 5 3.66))))
+ (with-temp-buffer
+ (insert "123\n12345\n123")
+ (should (approx-equal (buffer-line-statistics) '(3 5 3.66))))
+ (with-temp-buffer
+ (insert "123\n12345")
+ (should (approx-equal (buffer-line-statistics) '(2 5 4))))
+
+ (with-temp-buffer
+ (insert "123\n12é45\n123\n")
+ (should (approx-equal (buffer-line-statistics) '(3 6 4))))
+
+ (with-temp-buffer
+ (insert "\n\n\n")
+ (should (approx-equal (buffer-line-statistics) '(3 0 0)))))
+
+(ert-deftest test-buffer-line-stats-gap ()
+ (with-temp-buffer
+ (dotimes (_ 1000)
+ (insert "12345678901234567890123456789012345678901234567890\n"))
+ (goto-char (point-min))
+ ;; This should make a gap appear.
+ (insert "123\n")
+ (delete-region (point-min) (point))
+ (should (approx-equal (buffer-line-statistics) '(1000 50 50.0))))
+ (with-temp-buffer
+ (dotimes (_ 1000)
+ (insert "12345678901234567890123456789012345678901234567890\n"))
+ (goto-char (point-min))
+ (insert "123\n")
+ (should (approx-equal (buffer-line-statistics) '(1001 50 49.9))))
+ (with-temp-buffer
+ (dotimes (_ 1000)
+ (insert "12345678901234567890123456789012345678901234567890\n"))
+ (goto-char (point-min))
+ (insert "123\n")
+ (goto-char (point-max))
+ (insert "fóo")
+ (should (approx-equal (buffer-line-statistics) '(1002 50 49.9)))))
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index edf8821..f2a60bc 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -190,4 +190,10 @@ literals (Bug#20852)."
(ert-deftest lread-circular-hash ()
(should-error (read "#s(hash-table data #0=(#0# . #0#))")))
+(ert-deftest test-inhibit-interaction ()
+ (let ((inhibit-interaction t))
+ (should-error (read-char "foo: "))
+ (should-error (read-event "foo: "))
+ (should-error (read-char-exclusive "foo: "))))
+
;;; lread-tests.el ends here
diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el
index b9cd255..28119fc 100644
--- a/test/src/minibuf-tests.el
+++ b/test/src/minibuf-tests.el
@@ -410,5 +410,20 @@
(should (equal (try-completion "baz" '("bAz" "baz"))
(try-completion "baz" '("baz" "bAz"))))))
+(ert-deftest test-inhibit-interaction ()
+ (let ((inhibit-interaction t))
+ (should-error (read-from-minibuffer "foo: "))
+
+ (should-error (y-or-n-p "foo: "))
+ (should-error (yes-or-no-p "foo: "))
+ (should-error (read-blanks-no-input "foo: "))
+
+ ;; See that we get the expected error.
+ (should (eq (condition-case nil
+ (read-from-minibuffer "foo: ")
+ (inhibited-interaction 'inhibit)
+ (error nil))
+ 'inhibit))))
+
;;; minibuf-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 921bcd5..dad3642 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -28,6 +28,7 @@
(require 'puny)
(require 'rx)
(require 'subr-x)
+(require 'dns)
;; Timeout in seconds; the test fails if the timeout is reached.
(defvar process-test-sentinel-wait-timeout 2.0)
@@ -350,14 +351,23 @@ See Bug#30460."
;; All the following tests require working DNS, which appears not to
;; be the case for hydra.nixos.org, so disable them there for now.
+;; This will need updating when IANA assign more IPv6 global ranges.
+(defun ipv6-is-available ()
+ (and (featurep 'make-network-process '(:family ipv6))
+ (cl-rassoc-if
+ (lambda (elt)
+ (and (eq 9 (length elt))
+ (= (logand (aref elt 0) #xe000) #x2000)))
+ (network-interface-list))))
+
(ert-deftest lookup-family-specification ()
"`network-lookup-address-info' should only accept valid family symbols."
(skip-unless (not (getenv "EMACS_HYDRA_CI")))
(with-timeout (60 (ert-fail "Test timed out"))
- (should-error (network-lookup-address-info "google.com" 'both))
- (should (network-lookup-address-info "google.com" 'ipv4))
- (when (featurep 'make-network-process '(:family ipv6))
- (should (network-lookup-address-info "google.com" 'ipv6)))))
+ (should-error (network-lookup-address-info "localhost" 'both))
+ (should (network-lookup-address-info "localhost" 'ipv4))
+ (when (ipv6-is-available)
+ (should (network-lookup-address-info "localhost" 'ipv6)))))
(ert-deftest lookup-unicode-domains ()
"Unicode domains should fail."
@@ -380,7 +390,8 @@ See Bug#30460."
(addresses-v4 (network-lookup-address-info "google.com" 'ipv4)))
(should addresses-both)
(should addresses-v4))
- (when (featurep 'make-network-process '(:family ipv6))
+ (when (and (ipv6-is-available)
+ (dns-query "google.com" 'AAAA))
(should (network-lookup-address-info "google.com" 'ipv6)))))
(ert-deftest non-existent-lookup-failure ()
@@ -565,11 +576,6 @@ FD_SETSIZE file descriptors (Bug#24325)."
(should (memq (process-status process) '(run exit)))
(when (process-live-p process)
(process-send-eof process))
- ;; FIXME: This `sleep-for' shouldn't be needed. It
- ;; indicates a bug in Emacs; perhaps SIGCHLD is
- ;; received in parallel with `accept-process-output',
- ;; causing the latter to hang.
- (sleep-for 0.1)
(while (accept-process-output process))
(should (eq (process-status process) 'exit))
;; If there's an error between fork and exec, Emacs
diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el
index d13ce77..ec96d77 100644
--- a/test/src/xdisp-tests.el
+++ b/test/src/xdisp-tests.el
@@ -72,4 +72,34 @@
(should (equal (nth 0 posns) (nth 1 posns)))
(should (equal (nth 1 posns) (nth 2 posns)))))
+(ert-deftest xdisp-tests--window-text-pixel-size () ;; bug#45748
+ (with-temp-buffer
+ (insert "xxx")
+ (let* ((window
+ (display-buffer (current-buffer) '(display-buffer-in-child-frame .
nil)))
+ (char-width (frame-char-width))
+ (size (window-text-pixel-size nil t t)))
+ (delete-frame (window-frame window))
+ (should (equal (/ (car size) char-width) 3)))))
+
+(ert-deftest xdisp-tests--window-text-pixel-size-leading-space () ;; bug#45748
+ (with-temp-buffer
+ (insert " xx")
+ (let* ((window
+ (display-buffer (current-buffer) '(display-buffer-in-child-frame .
nil)))
+ (char-width (frame-char-width))
+ (size (window-text-pixel-size nil t t)))
+ (delete-frame (window-frame window))
+ (should (equal (/ (car size) char-width) 3)))))
+
+(ert-deftest xdisp-tests--window-text-pixel-size-trailing-space () ;; bug#45748
+ (with-temp-buffer
+ (insert "xx ")
+ (let* ((window
+ (display-buffer (current-buffer) '(display-buffer-in-child-frame .
nil)))
+ (char-width (frame-char-width))
+ (size (window-text-pixel-size nil t t)))
+ (delete-frame (window-frame window))
+ (should (equal (/ (car size) char-width) 3)))))
+
;;; xdisp-tests.el ends here
diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el
index 632cf96..a35b4d2 100644
--- a/test/src/xml-tests.el
+++ b/test/src/xml-tests.el
@@ -44,12 +44,12 @@
(ert-deftest libxml-tests ()
"Test libxml."
- (when (fboundp 'libxml-parse-xml-region)
- (with-temp-buffer
- (dolist (test libxml-tests--data-comments-preserved)
- (erase-buffer)
- (insert (car test))
- (should (equal (cdr test)
- (libxml-parse-xml-region (point-min) (point-max))))))))
+ (skip-unless (fboundp 'libxml-parse-xml-region))
+ (with-temp-buffer
+ (dolist (test libxml-tests--data-comments-preserved)
+ (erase-buffer)
+ (insert (car test))
+ (should (equal (cdr test)
+ (libxml-parse-xml-region (point-min) (point-max)))))))
;;; libxml-tests.el ends here
- scratch/etags-regen updated (153a549 -> f4a1d47), Dmitry Gutov, 2021/02/07
- scratch/etags-regen 8d00e2f 1/8: Merge branch 'master' into scratch/etags-regen,
Dmitry Gutov <=
- scratch/etags-regen 1daad17 2/8: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2021/02/07
- scratch/etags-regen 44f19c7 3/8: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2021/02/07
- scratch/etags-regen 25b2915 7/8: Introduce project-files-filtered and use it, Dmitry Gutov, 2021/02/07
- scratch/etags-regen f4a1d47 8/8: Brute force refresh implementation, Dmitry Gutov, 2021/02/07
- scratch/etags-regen 3098e47 4/8: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2021/02/07
- scratch/etags-regen 4f7b533 6/8: etags-regen--all-files: Extract to a separate function, Dmitry Gutov, 2021/02/07
- scratch/etags-regen f520e5d 5/8: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2021/02/07