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

Merge remote-tracking branch 'savannah/master' into native-comp

Browse source
This commit is contained in:
Andrea Corallo 2021-01-16 13:26:10 +01:00
commit 0a7ac0b550
124 changed files with 2522 additions and 1052 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -299,3 +299,4 @@ nt/emacs.rc
nt/emacsclient.rc
src/gdb.ini
/var/
src/fingerprint.c

196
.gitlab-ci.yml
View file

@ -24,74 +24,114 @@
# Maintainer: Ted Zlatanov <tzz@lifelogs.com>
# URL: https://emba.gnu.org/emacs/emacs
image: debian:stretch
# 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
workflow:
rules:
- if: '$CI_PIPELINE_SOURCE == "merge_request_event"'
when: never
- when: always
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
default:
image: docker:19.03.12
timeout: 3 hours
before_script:
- docker info
.job-template:
# these will be cached across builds
cache:
key: ${CI_COMMIT_REF_SLUG}
paths: []
policy: pull-push
# these will be saved for followup builds
artifacts:
expire_in: 24 hrs
paths: []
# - "test/**/*.log"
# - "**/*.log"
.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 build --target ${target} -t ${target}:${CI_COMMIT_REF_SLUG} -t ${target}:${CI_COMMIT_SHA} -f test/infra/Dockerfile.emba .
# 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} ${target}:${CI_COMMIT_SHA} make ${make_params}
stages:
- test
- fast
- normal
- slow
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-fast:
stage: fast
extends: [.job-template, .test-template]
variables:
target: emacs-inotify
make_params: "-C test check"
test-lisp:
stage: normal
extends: [.job-template, .test-template]
variables:
target: emacs-inotify
make_params: "-C test check-lisp"
test-net:
stage: normal
extends: [.job-template, .test-template]
variables:
target: emacs-inotify
make_params: "-C test check-net"
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
stage: normal
extends: [.job-template, .test-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
variables:
target: emacs-filenotify-gio
make_params: "-k -C test autorevert-tests filenotify-tests"
test-native-bootstrap-speed0:
# Test a full native bootstrap
@ -126,19 +166,31 @@ test-native-bootstrap-speed2:
timeout: 8 hours
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
stage: normal
extends: [.job-template, .test-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/*
variables:
target: emacs-gnustep
make_params: install
test-all:
# 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

32
admin/notes/elpa
View file

@ -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.

38
admin/nt/dist-build/README-scripts
View file

@ -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.

49
admin/nt/dist-build/README-windows-binaries
View file

@ -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

202
admin/nt/dist-build/build-dep-zips.py
View file

@ -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,27 +39,22 @@
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
## 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"]
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!
ARCH_PKGS=[]
SRC_REPO="https://sourceforge.net/projects/msys2/files/REPOS/MINGW/Sources"
def check_output_maybe(*args,**kwargs):
if(DRY_RUN):
@ -68,6 +62,68 @@ def check_output_maybe(*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-glib2"]
MUNGE_SRC_PKGS={"mingw-w64-libwinpthread-git":"mingw-w64-winpthreads-git"}
MUNGE_DEP_PKGS={
"mingw-w64-x86_64-libwinpthread":"mingw-w64-x86_64-libwinpthread-git",
"mingw-w64-x86_64-libtre": "mingw-w64-x86_64-libtre-git",
}
## Currently no packages seem to require this!
ARCH_PKGS=[]
SRC_REPO="https://sourceforge.net/projects/msys2/files/REPOS/MINGW/Sources"
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))
print("Copying {} from local".format(tarball))
shutil.copyfile("../emacs-src-cache/{}".format(tarball),
"{}".format(tarball))
## Fetch all the source code
def gather_source(deps):
if not os.path.exists("emacs-src-cache"):
os.mkdir("emacs-src-cache")
## Source for gcc-libs is part of gcc
## Source for libwinpthread is in libwinpthreads
## mpc, termcap, xpm -- has x86_64, and i686 versions
## 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]
## Switch names if necessary
pkg_name = MUNGE_SRC_PKGS.get(pkg_name,pkg_name)
for d in downloads:
## Switch names if necessary
d = MUNGE_SRC_PKGS.get(d,d)
tarball = "{}-{}.src.tar.gz".format(pkg_name,pkg_version)
tarball = "{}-{}.src.tar.gz".format(d,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 @@ def clean():
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 @@ def clean():
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 @@ def clean():
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 ):

90
admin/nt/dist-build/build-zips.sh
View file

@ -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
build_zip
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
fi
build_installer i686
build_installer
fi

31
admin/nt/dist-build/emacs.nsi
View file

@ -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

21
configure.ac
View file

@ -5769,6 +5769,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}'.
@ -5783,12 +5789,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 NATIVE_COMP 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 NATIVE_COMP 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} ;;
@ -5825,11 +5833,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}

10
doc/emacs/mini.texi
View file

@ -76,9 +76,13 @@ default, the active minibuffer moves to this new frame. If you set
the user option @code{minibuffer-follows-selected-frame} to
@code{nil}, then the minibuffer stays in the frame where you opened
it, and you must switch back to that frame in order to complete (or
abort) the current command. Note that the effect of the command, when
you finally finish using the minibuffer, always takes place in the
frame where you first opened it.
abort) the current command. If you set that option to a value which
is neither @code{nil} nor @code{t}, the minibuffer moves frame only
after a recursive minibuffer has been opened in the current command
(@pxref{Recursive Mini,,, elisp}). This option is mainly to retain
(approximately) the behavior prior to Emacs 28.1. Note that the
effect of the command, when you finally finish using the minibuffer,
always takes place in the frame where you first opened it.
@node Minibuffer File
@section Minibuffers for File Names

7
doc/emacs/trouble.texi
View file

@ -57,6 +57,13 @@ incremental search, @kbd{C-g} behaves specially; it may take two
successive @kbd{C-g} characters to get out of a search.
@xref{Incremental Search}, for details.
If you type @kbd{C-g} in a minibuffer, this quits the command that
opened that minibuffer, closing it. If that minibuffer is not the
most recently opened one (which can happen when
@code{minibuffer-follows-selected-frame} is @code{nil} (@pxref{Basic
Minibuffer})), @kbd{C-g} also closes the more recently opened ones,
quitting their associated commands, after asking you for confirmation.
On MS-DOS, the character @kbd{C-@key{Break}} serves as a quit character
like @kbd{C-g}. The reason is that it is not feasible, on MS-DOS, to
recognize @kbd{C-g} while a command is running, between interactions

14
doc/lispref/commands.texi
View file

@ -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

17
doc/lispref/display.texi
View file

@ -2485,15 +2485,16 @@ avoiding any increase in the character height or width. For simplification
the width could be specified with only a single number @var{n} instead
of a list, such case is equivalent to @code{((abs @var{n}) . @var{n})}.
The value @var{color} specifies the color to draw with. The default is
the foreground color of the face for simple boxes, and the background
color of the face for 3D boxes.
The value @var{style} specifies whether to draw a 3D box. If it is
@code{released-button}, the box looks like a 3D button that is not being
pressed. If it is @code{pressed-button}, the box looks like a 3D button
that is being pressed. If it is @code{nil} or omitted, a plain 2D box
is used.
@code{released-button}, the box looks like a 3D button that is not
being pressed. If it is @code{pressed-button}, the box looks like a
3D button that is being pressed. If it is @code{nil},
@code{flat-button} or omitted, a plain 2D box is used.
The value @var{color} specifies the color to draw with. The default
is the background color of the face for 3D boxes and
@code{flat-button}, and the foreground color of the face for other
boxes.
@end table
@item :inverse-video

1
doc/lispref/elisp.texi
View file

@ -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

5
doc/lispref/errors.texi
View file

@ -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.

57
doc/lispref/minibuf.texi
View file

@ -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
@ -82,10 +83,12 @@ there is an active minibuffer; such a minibuffer is called a
incrementing the number at the end of the name. (The names begin with
a space so that they won't show up in normal buffer lists.) Of
several recursive minibuffers, the innermost (or most recently
entered) is the active minibuffer. We usually call this @emph{the}
minibuffer. You can permit or forbid recursive minibuffers by setting
the variable @code{enable-recursive-minibuffers}, or by putting
properties of that name on command symbols (@xref{Recursive Mini}.)
entered) is the @dfn{active minibuffer}--it is the one you can
terminate by typing @key{RET} (@code{exit-minibuffer}) in. We usually
call this @emph{the} minibuffer. You can permit or forbid recursive
minibuffers by setting the variable
@code{enable-recursive-minibuffers}, or by putting properties of that
name on command symbols (@xref{Recursive Mini}.)
Like other buffers, a minibuffer uses a local keymap
(@pxref{Keymaps}) to specify special key bindings. The function that
@ -2380,7 +2383,8 @@ minibuffer.
@deffn Command exit-minibuffer
This command exits the active minibuffer. It is normally bound to
keys in minibuffer local keymaps.
keys in minibuffer local keymaps. The command throws an error if the
current buffer is not the active minibuffer.
@end deffn
@deffn Command self-insert-and-exit
@ -2594,8 +2598,11 @@ returns zero.
If this variable is non-@code{nil}, you can invoke commands (such as
@code{find-file}) that use minibuffers even while the minibuffer is
active. Such invocation produces a recursive editing level for a new
minibuffer. The outer-level minibuffer is invisible while you are
editing the inner one.
minibuffer. By default, the outer-level minibuffer is invisible while
you are editing the inner one. If you have
@code{minibuffer-follows-selected-frame} set to @code{nil}, you can
have minibuffers visible on several frames at the same time.
@xref{Basic Minibuffer,,, emacs}.
If this variable is @code{nil}, you cannot invoke minibuffer commands
when the minibuffer is active, not even if you switch to another window
@ -2611,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
@ -2623,7 +2662,7 @@ active minibuffer.
@end defun
@defvar minibuffer-setup-hook
This is a normal hook that is run whenever the minibuffer is entered.
This is a normal hook that is run whenever a minibuffer is entered.
@xref{Hooks}.
@end defvar
@ -2641,7 +2680,7 @@ called once, for the outermost use of the minibuffer.
@end defmac
@defvar minibuffer-exit-hook
This is a normal hook that is run whenever the minibuffer is exited.
This is a normal hook that is run whenever a minibuffer is exited.
@xref{Hooks}.
@end defvar

2
doc/lispref/modes.texi
View file

@ -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")

12
doc/misc/auth.texi
View file

@ -107,6 +107,18 @@ The @code{user} is the user name. It's known as @var{:user} in
@code{auth-source-search} queries. You can also use @code{login} and
@code{account}.
Matching entries are usually used in the order they appear, so placing
the most specific entries first in the file is a good idea. For
instance:
@example
machine example.com login foobar password geheimnis port smtp
machine example.com login foobar password hemmelig
@end example
Here we're using one password for the @code{smtp} service, and a
different one for all the other services.
You can also use this file to specify client certificates to use when
setting up TLS connections. The format is:

2
doc/misc/gnus.texi
View file

@ -20195,7 +20195,7 @@ Phu.
For example, to do hierarchical scoring but use a non-server-specific
overall score file, you could use the value
@example
(list (lambda (group) ("all.SCORE"))
(list (lambda (group) (list "all.SCORE"))
'gnus-score-find-hierarchical)
@end example

28
doc/misc/tramp.texi
View file

@ -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.

2
doc/misc/trampver.texi
View file

@ -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

52
etc/NEWS
View file

@ -102,12 +102,13 @@ effect should be negligible in the vast majority of cases anyway.
By default, when you switch to another frame, an active minibuffer now
moves to the newly selected frame. Nevertheless, the effect of what
you type in the minibuffer happens in the frame where the minibuffer
was first activated, even if it moved to another frame. An
alternative behavior is available by customizing
'minibuffer-follows-selected-frame' to nil. Here, the minibuffer
stays in the frame where you first opened it, and you must switch back
to this frame to continue or abort its command. The old, somewhat
unsystematic behavior, which mixed these two is no longer available.
was first activated. An alternative behavior is available by
customizing 'minibuffer-follows-selected-frame' to nil. Here, the
minibuffer stays in the frame where you first opened it, and you must
switch back to this frame to continue or abort its command. The old
behavior, which mixed these two, can be approximated by customizing
'minibuffer-follows-selected-frame' to a value which is neither nil
nor t.
+++
** New system for displaying documentation for groups of functions.
@ -347,6 +348,8 @@ is set to nil, this message is inhibited.
** Python mode
*** 'python-shell-interpreter' now defaults to python3 on systems with python3.
*** 'C-c C-r' can now be used on arbitrary regions.
The command previously extended the start of the region to the start
of the line, but will now actually send the marked region, as
@ -699,6 +702,13 @@ not.
** Message
---
*** Respect 'message-forward-ignored-headers' more.
Previously, this variable would not be consulted if
'message-forward-show-mml' was nil. It's now always used, except if
'message-forward-show-mml' is 'best', and we're forwarding an
encrypted/signed message.
+++
*** Message now supports the OpenPGP header.
To generate these headers, add the new function
@ -1337,6 +1347,11 @@ have been renamed to have "proper" public names and documented
('xref-show-definitions-buffer' and
'xref-show-definitions-buffer-at-bottom').
*** New command 'xref-quit-and-pop-marker-stack' and a binding for it
in Xref buffers ('M-,'). This combination is easy to press
semi-accidentally if the user wants to go back in the middle of
choosing the exact definition to go to, and this should do TRT.
---
*** New value 'project-relative' for 'xref-file-name-display'
If chosen, file names in *xref* buffers will be displayed relative
@ -1360,6 +1375,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".
@ -1517,8 +1541,22 @@ that makes it a valid button.
** Miscellaneous
*** New function 'buffer-line-statistics'.
This function returns some statistics about the line lengths in a buffer.
+++
*** 'add-to-ordered-list' can now take a test predicate.
*** 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.
+++
*** New button face 'flat-button'.
This is a plain 2D button, but uses the background color instead of
the foreground color.
+++
*** New predicate functions 'length<', 'length>' and 'length='.

5
etc/PROBLEMS
View file

@ -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

35
etc/w32-feature.el
View file

@ -25,9 +25,21 @@
;; designed to check whether bundled binary distributions of Emacs on
;; windows are fully functional.
;; By default is checks whether the features that we are expect to be
;; available on Emacs for Windows are reported to be available. It
;; should be possible to run these tests from a distributed version of
;; Emacs.
;; In addition, it provides a single command
;; `w32-feature-load-tests'. If the full source repository of Emacs is
;; available, this will load selected files from the repository which
;; test these features.
;;; Code:
(require 'ert)
(defvar w32-feature-core-tests nil)
(ert-deftest feature-optimization ()
(should
(string-match-p "CFLAGS=-O2" system-configuration-options)))
@ -41,16 +53,24 @@
(ert-deftest feature-gnutls ()
(should (gnutls-available-p)))
(add-to-list 'w32-feature-core-tests "lisp/net/gnutls-tests.el")
(ert-deftest feature-zlib ()
(should (zlib-available-p)))
(add-to-list 'w32-feature-core-tests "src/decompress-tests.el")
(ert-deftest feature-thread ()
(should (fboundp 'make-thread)))
(add-to-list 'w32-feature-core-tests "lisp/thread-tests.el")
(ert-deftest feature-json ()
(should
(fboundp 'json-serialize)))
(add-to-list 'w32-feature-core-tests "src/json-tests.el")
(ert-deftest feature-gmp ()
(should
(string-match-p "GMP" system-configuration-features)))
@ -61,9 +81,13 @@
(ert-deftest feature-libxml ()
(should (libxml-available-p)))
(add-to-list 'w32-feature-core-tests "src/xml-tests.el")
(ert-deftest feature-lcms2 ()
(should (lcms2-available-p)))
(add-to-list 'w32-feature-core-tests "src/lcms-tests.el")
(ert-deftest feature-xpm ()
(should (image-type-available-p 'xpm)))
@ -73,8 +97,7 @@
(ert-deftest feature-png ()
(should (image-type-available-p 'png)))
(ert-deftest feature-xpm ()
(should (image-type-available-p 'xpm)))
(add-to-list 'w32-feature-core-tests "lisp/image-file-tests.el")
(ert-deftest feature-jpeg ()
(should (image-type-available-p 'jpeg)))
@ -84,4 +107,12 @@
(ert-deftest feature-svg ()
(should (image-type-available-p 'svg)))
(defun w32-feature-load-tests (dir)
(interactive "D")
(mapc
(lambda(f)
(load-file (concat dir "test/" f)))
w32-feature-core-tests))
;;; feature.el ends here

10
lisp/calc/calc.el
View file

@ -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"))

24
lisp/cedet/ede/auto.el
View file

@ -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.

26
lisp/comint.el
View file

@ -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)

1
lisp/cus-face.el
View file

@ -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)

6
lisp/cus-start.el
View file

@ -394,7 +394,11 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
;; (directory :format "%v"))))
(load-prefer-newer lisp boolean "24.4")
;; minibuf.c
(minibuffer-follows-selected-frame minibuffer boolean "28.1")
(minibuffer-follows-selected-frame
minibuffer (choice (const :tag "Always" t)
(const :tag "When used" hybrid)
(const :tag "Never" nil))
"28.1")
(enable-recursive-minibuffers minibuffer boolean)
(history-length minibuffer
(choice (const :tag "Infinite" t) integer)

13
lisp/custom.el
View file

@ -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
@ -237,6 +240,8 @@ The following keywords are meaningful:
:type VALUE should be a widget type for editing the symbol's value.
Every `defcustom' should specify a value for this keyword.
See Info node `(elisp) Customization Types' for a list of
base types and useful composite types.
:options VALUE should be a list of valid members of the widget type.
:initialize
VALUE should be a function used to initialize the
@ -778,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".
@ -787,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

2
lisp/dired-x.el
View file

@ -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.

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

@ -304,15 +304,6 @@ the specializer used will be the one returned by BODY."
(lambda ,args ,@body))))
(eval-and-compile ;Needed while compiling the cl-defmethod calls below!
(defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el.
"Check which of the symbols VARS appear in SEXP."
(let ((res '()))
(while (consp sexp)
(dolist (var (cl--generic-fgrep vars (pop sexp)))
(unless (memq var res) (push var res))))
(and (memq sexp vars) (not (memq sexp res)) (push sexp res))
res))
(defun cl--generic-split-args (args)
"Return (SPEC-ARGS . PLAIN-ARGS)."
(let ((plain-args ())
@ -375,11 +366,11 @@ the specializer used will be the one returned by BODY."
;; is used.
;; FIXME: Also, optimize the case where call-next-method is
;; only called with explicit arguments.
(uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
(uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)))
(cons (not (not uses-cnm))
`#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
,@(car parsed-body)
,(if (not (memq nmp uses-cnm))
,(if (not (assq nmp uses-cnm))
nbody
`(let ((,nmp (lambda ()
(cl--generic-isnot-nnm-p ,cnm))))
@ -617,11 +608,11 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
(lambda (,@fixedargs &rest args)
(let ,bindings
(apply (cl--generic-with-memoization
(gethash ,tag-exp method-cache)
(cl--generic-cache-miss
generic ',dispatch-arg dispatches-left methods
,(if (cdr typescodes)
`(append ,@typescodes) (car typescodes))))
(gethash ,tag-exp method-cache)
(cl--generic-cache-miss
generic ',dispatch-arg dispatches-left methods
,(if (cdr typescodes)
`(append ,@typescodes) (car typescodes))))
,@fixedargs args)))))))))
(defun cl--generic-make-function (generic)
@ -1110,7 +1101,8 @@ These match if the argument is a cons cell whose car is `eql' to VAL."
(if (not (eq (car-safe specializer) 'head))
(cl-call-next-method)
(cl--generic-with-memoization
(gethash (cadr specializer) cl--generic-head-used) specializer)
(gethash (cadr specializer) cl--generic-head-used)
specializer)
(list cl--generic-head-generalizer)))
(cl--generic-prefill-dispatchers 0 (head eql))

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

@ -2060,10 +2060,99 @@ Like `cl-flet' but the definitions can refer to previous ones.
((null (cdr bindings)) `(cl-flet ,bindings ,@body))
(t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
(defun cl--self-tco (var fargs body)
;; This tries to "optimize" tail calls for the specific case
;; of recursive self-calls by replacing them with a `while' loop.
;; It is quite far from a general tail-call optimization, since it doesn't
;; even handle mutually recursive functions.
(letrec
((done nil) ;; Non-nil if some TCO happened.
(retvar (make-symbol "retval"))
(ofargs (mapcar (lambda (s) (if (memq s cl--lambda-list-keywords) s
(make-symbol (symbol-name s))))
fargs))
(opt-exps (lambda (exps) ;; `exps' is in tail position!
(append (butlast exps)
(list (funcall opt (car (last exps)))))))
(opt
(lambda (exp) ;; `exp' is in tail position!
(pcase exp
;; FIXME: Optimize `apply'?
(`(funcall ,(pred (eq var)) . ,aargs)
;; This is a self-recursive call in tail position.
(let ((sets nil)
(fargs ofargs))
(while fargs
(pcase (pop fargs)
('&rest
(push (pop fargs) sets)
(push `(list . ,aargs) sets)
;; (cl-assert (null fargs))
)
('&optional nil)
(farg
(push farg sets)
(push (pop aargs) sets))))
(setq done t)
`(progn (setq . ,(nreverse sets))
:recurse)))
(`(progn . ,exps) `(progn . ,(funcall opt-exps exps)))
(`(if ,cond ,then . ,else)
`(if ,cond ,(funcall opt then) . ,(funcall opt-exps else)))
(`(cond . ,conds)
(let ((cs '()))
(while conds
(pcase (pop conds)
(`(,exp)
(push (if conds
;; This returns the value of `exp' but it's
;; only in tail position if it's the
;; last condition.
`((setq ,retvar ,exp) nil)
`(,(funcall opt exp)))
cs))
(exps
(push (funcall opt-exps exps) cs))))
(if (eq t (caar cs))
`(cond . ,(nreverse cs))
`(cond ,@(nreverse cs) (t (setq ,retvar nil))))))
((and `(,(or 'let 'let*) ,bindings . ,exps)
(guard
;; Note: it's OK for this `let' to shadow any
;; of the formal arguments since we will only
;; setq the fresh new `ofargs' vars instead ;-)
(let ((shadowings
(mapcar (lambda (b) (if (consp b) (car b) b)) bindings)))
;; If `var' is shadowed, then it clearly can't be
;; tail-called any more.
(not (memq var shadowings)))))
`(,(car exp) ,bindings . ,(funcall opt-exps exps)))
(_
`(progn (setq ,retvar ,exp) nil))))))
(let ((optimized-body (funcall opt-exps body)))
(if (not done)
(cons fargs body)
;; We use two sets of vars: `ofargs' and `fargs' because we need
;; to be careful that if a closure captures a formal argument
;; in one iteration, it needs to capture a different binding
;; then that of other iterations, e.g.
(cons
ofargs
`((let (,retvar)
(while (let ,(delq nil
(cl-mapcar
(lambda (a oa)
(unless (memq a cl--lambda-list-keywords)
(list a oa)))
fargs ofargs))
. ,optimized-body))
,retvar)))))))
;;;###autoload
(defmacro cl-labels (bindings &rest body)
"Make local (recursive) function definitions.
Each definition can take the form (FUNC ARGLIST BODY...) where
"Make local (recursive) function definitions.
+BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where
FUNC is the function name, ARGLIST its arguments, and BODY the
forms of the function body. FUNC is defined in any BODY, as well
as FORM, so you can write recursive and mutually recursive
@ -2075,17 +2164,33 @@ details.
(let ((binds ()) (newenv macroexpand-all-environment))
(dolist (binding bindings)
(let ((var (make-symbol (format "--cl-%s--" (car binding)))))
(push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
(push (cons var (cdr binding)) binds)
(push (cons (car binding)
(lambda (&rest args)
(if (eq (car args) cl--labels-magic)
(list cl--labels-magic var)
(cl-list* 'funcall var args))))
newenv)))
(macroexpand-all `(letrec ,(nreverse binds) ,@body)
;; Don't override lexical-let's macro-expander.
(if (assq 'function newenv) newenv
(cons (cons 'function #'cl--labels-convert) newenv)))))
;; Don't override lexical-let's macro-expander.
(unless (assq 'function newenv)
(push (cons 'function #'cl--labels-convert) newenv))
;; Perform self-tail call elimination.
(setq binds (mapcar
(lambda (bind)
(pcase-let*
((`(,var ,sargs . ,sbody) bind)
(`(function (lambda ,fargs . ,ebody))
(macroexpand-all `(cl-function (lambda ,sargs . ,sbody))
newenv))
(`(,ofargs . ,obody)
(cl--self-tco var fargs ebody)))
`(,var (function (lambda ,ofargs . ,obody)))))
(nreverse binds)))
`(letrec ,binds
. ,(macroexp-unprogn
(macroexpand-all
(macroexp-progn body)
newenv)))))
;; The following ought to have a better definition for use with newer
;; byte compilers.
@ -3413,8 +3518,8 @@ macro that returns its `&whole' argument."
(put y 'side-effect-free t))
;;; Things that are inline.
(cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany
cl-notevery cl-revappend cl-nreconc gethash))
(cl-proclaim '(inline cl-acons cl-map cl-notany cl-notevery cl-revappend
cl-nreconc gethash))
;;; Things that are side-effect-free.
(mapc (lambda (x) (function-put x 'side-effect-free t))

135
lisp/emacs-lisp/eieio-base.el
View file

@ -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)

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

@ -456,8 +456,7 @@ This will generate compile-time constants from BINDINGS."
("\\(\\\\\\)\\([^\"\\]\\)"
(1 (elisp--font-lock-backslash) prepend))
;; Words inside ‘’ and `' tend to be symbol names.
(,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
lisp-mode-symbol-regexp "\\)['’]")
(,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]")
(1 font-lock-constant-face prepend))
;; Constant values.
(,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
@ -507,8 +506,7 @@ This will generate compile-time constants from BINDINGS."
(,(concat "(" cl-errs-re "\\_>")
(1 font-lock-warning-face))
;; Words inside ‘’ and `' tend to be symbol names.
(,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
lisp-mode-symbol-regexp "\\)['’]")
(,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]")
(1 font-lock-constant-face prepend))
;; Uninterned symbols, e.g., (defpackage #:my-package ...)
;; must come before keywords below to have effect

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

@ -480,6 +480,35 @@ itself or not."
v
(list 'quote v)))
(defun macroexp--fgrep (bindings sexp)
"Return those of the BINDINGS which might be used in SEXP.
It is used as a poor-man's \"free variables\" test. It differs from a true
test of free variables in the following ways:
- It does not distinguish variables from functions, so it can be used
both to detect whether a given variable is used by SEXP and to
detect whether a given function is used by SEXP.
- It does not actually know ELisp syntax, so it only looks for the presence
of symbols in SEXP and can't distinguish if those symbols are truly
references to the given variable (or function). That can make the result
include bindings which actually aren't used.
- For the same reason it may cause the result to fail to include bindings
which will be used if SEXP is not yet fully macro-expanded and the
use of the binding will only be revealed by macro expansion."
(let ((res '()))
(while (and (consp sexp) bindings)
(dolist (binding (macroexp--fgrep bindings (pop sexp)))
(push binding res)
(setq bindings (remove binding bindings))))
(if (or (vectorp sexp) (byte-code-function-p sexp))
;; With backquote, code can appear within vectors as well.
;; This wouldn't be needed if we `macroexpand-all' before
;; calling macroexp--fgrep, OTOH.
(macroexp--fgrep bindings (mapcar #'identity sexp))
(let ((tmp (assq sexp bindings)))
(if tmp
(cons tmp res)
res)))))
;;; Load-time macro-expansion.
;; Because macro-expansion used to be more lazy, eager macro-expansion

27
lisp/emacs-lisp/pcase.el
View file

@ -344,7 +344,7 @@ of the elements of LIST is performed as if by `pcase-let'.
(seen '())
(codegen
(lambda (code vars)
(let ((vars (pcase--fgrep vars code))
(let ((vars (macroexp--fgrep vars code))
(prev (assq code seen)))
(if (not prev)
(let ((res (pcase-codegen code vars)))
@ -401,7 +401,7 @@ of the elements of LIST is performed as if by `pcase-let'.
;; occurrences of this leaf since it's small.
(lambda (code vars)
(pcase-codegen code
(pcase--fgrep vars code)))
(macroexp--fgrep vars code)))
codegen)
(cdr case)
vars))))
@ -668,7 +668,7 @@ MATCH is the pattern that needs to be matched, of the form:
;; run, but we don't have the environment in which `pat' will
;; run, so we can't do a reliable verification. But let's try
;; and catch at least the easy cases such as (bug#14773).
(not (pcase--fgrep (mapcar #'car vars) (cadr upat)))))
(not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
'(:pcase--succeed . :pcase--fail))
((and (eq 'pred (car upat))
(let ((otherpred
@ -692,23 +692,6 @@ MATCH is the pattern that needs to be matched, of the form:
'(nil . :pcase--fail)
'(:pcase--fail . nil))))))
(defun pcase--fgrep (bindings sexp)
"Return those of the BINDINGS which might be used in SEXP."
(let ((res '()))
(while (and (consp sexp) bindings)
(dolist (binding (pcase--fgrep bindings (pop sexp)))
(push binding res)
(setq bindings (remove binding bindings))))
(if (vectorp sexp)
;; With backquote, code can appear within vectors as well.
;; This wouldn't be needed if we `macroexpand-all' before
;; calling pcase--fgrep, OTOH.
(pcase--fgrep bindings (mapcar #'identity sexp))
(let ((tmp (assq sexp bindings)))
(if tmp
(cons tmp res)
res)))))
(defun pcase--self-quoting-p (upat)
(or (keywordp upat) (integerp upat) (stringp upat)))
@ -749,7 +732,7 @@ MATCH is the pattern that needs to be matched, of the form:
`(,fun ,arg)
(let* (;; `env' is an upper bound on the bindings we need.
(env (mapcar (lambda (x) (list (car x) (cdr x)))
(pcase--fgrep vars fun)))
(macroexp--fgrep vars fun)))
(call (progn
(when (assq arg env)
;; `arg' is shadowed by `env'.
@ -770,7 +753,7 @@ MATCH is the pattern that needs to be matched, of the form:
"Build an expression that will evaluate EXP."
(let* ((found (assq exp vars)))
(if found (cdr found)
(let* ((env (pcase--fgrep vars exp)))
(let* ((env (macroexp--fgrep vars exp)))
(if env
(macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
env)

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

@ -1126,12 +1126,21 @@ There can be any number of :example/:result elements."
(insert (propertize "("
'shortdoc-function t))
(if (plist-get data :no-manual)
(insert (symbol-name function))
(insert-text-button
(symbol-name function)
'face 'button
'action (lambda (_)
(describe-function function))
'follow-link t
'help-echo (purecopy "mouse-1, RET: describe function"))
(insert-text-button
(symbol-name function)
'face 'button
'action (lambda (_)
(info-lookup-symbol function 'emacs-lisp-mode))))
(info-lookup-symbol function 'emacs-lisp-mode))
'follow-link t
'help-echo (purecopy "mouse-1, RET: show \
function's documentation in the Info manual")))
(setq arglist-start (point))
(insert ")\n")
;; Doc string.

56
lisp/erc/erc-services.el
View file

@ -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:

2
lisp/foldout.el
View file

@ -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)

8
lisp/frame.el
View file

@ -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

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

@ -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

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

@ -145,7 +145,6 @@ used to display Gnus windows."
(,shell-command-buffer-name 1.0)))
(bug
(vertical 1.0
(if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))
("*Gnus Bug*" 1.0 point)))
(score-trace
(vertical 1.0

12
lisp/gnus/message.el
View file

@ -620,8 +620,8 @@ Done before generating the new subject of a forward."
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
"All headers that match this regexp will be deleted when forwarding a message.
This variable is only consulted when forwarding \"normally\", not
when forwarding as MIME or the like.
This variable is not consulted when forwarding encrypted messages
and `message-forward-show-mml' is `best'.
This may also be a list of regexps."
:version "21.1"
@ -7638,7 +7638,8 @@ Optional DIGEST will use digest to forward."
message-forward-included-headers)
t nil t)))))
(defun message-forward-make-body-mime (forward-buffer &optional beg end)
(defun message-forward-make-body-mime (forward-buffer &optional beg end
remove-headers)
(let ((b (point)))
(insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
(save-restriction
@ -7648,6 +7649,8 @@ Optional DIGEST will use digest to forward."
(goto-char (point-min))
(when (looking-at "From ")
(replace-match "X-From-Line: "))
(when remove-headers
(message-remove-ignored-headers (point-min) (point-max)))
(goto-char (point-max)))
(insert "<#/part>\n")
;; Consider there is no illegible text.
@ -7786,7 +7789,8 @@ is for the internal use."
(message-signed-or-encrypted-p)
(error t))))))
(message-forward-make-body-mml forward-buffer)
(message-forward-make-body-mime forward-buffer))
(message-forward-make-body-mime
forward-buffer nil nil (not (eq message-forward-show-mml 'best))))
(message-forward-make-body-plain forward-buffer)))
(message-position-point))

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

@ -1264,20 +1264,11 @@ in HANDLE."
(when (and (mm-handle-buffer handle)
(buffer-name (mm-handle-buffer handle)))
(with-temp-buffer
(if (and (eq (mm-handle-encoding handle) '8bit)
(with-current-buffer (mm-handle-buffer handle)
enable-multibyte-characters))
;; Due to unfortunate historical reasons, we may have a
;; multibyte buffer here, but if it's using an 8bit
;; Content-Transfer-Encoding, then work around that by
;; just ignoring the situation.
(insert-buffer-substring (mm-handle-buffer handle))
;; Do the decoding.
(mm-disable-multibyte)
(insert-buffer-substring (mm-handle-buffer handle))
(mm-decode-content-transfer-encoding
(mm-handle-encoding handle)
(mm-handle-media-type handle)))
(mm-disable-multibyte)
(insert-buffer-substring (mm-handle-buffer handle))
(mm-decode-content-transfer-encoding
(mm-handle-encoding handle)
(mm-handle-media-type handle))
,@forms))))
(put 'mm-with-part 'lisp-indent-function 1)
(put 'mm-with-part 'edebug-form-spec '(body))

3
lisp/gnus/nnmaildir.el
View file

@ -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)

4
lisp/help-fns.el
View file

@ -713,7 +713,9 @@ FILE is the file where FUNCTION was probably defined."
(insert-text-button
(symbol-name group)
'action (lambda (_)
(shortdoc-display-group group))))
(shortdoc-display-group group))
'follow-link t
'help-echo (purecopy "mouse-1, RET: show documentation group")))
groups)
(insert (if (= (length groups) 1)
" group.\n"

3
lisp/help-mode.el
View file

@ -357,8 +357,7 @@ Commands:
"\\(symbol\\|program\\|property\\)\\|" ; Don't link
"\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
"[ \t\n]+\\)?"
;; Note starting with word-syntax character:
"['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\|`\\)['’]"))
"['`‘]\\(\\(?:\\sw\\|\\s_\\)+\\|`\\)['’]"))
"Regexp matching doc string references to symbols.
The words preceding the quoted symbol can be used in doc strings to

2
lisp/info.el
View file

@ -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)))

61
lisp/isearch.el
View file

@ -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

8
lisp/minibuffer.el
View file

@ -2125,8 +2125,10 @@ variables.")
;; A better solution would be to make deactivate-mark buffer-local
;; (or to turn it into a list of buffers, ...), but in the mean time,
;; this should do the trick in most cases.
(setq deactivate-mark nil)
(throw 'exit nil))
(when (innermost-minibuffer-p)
(setq deactivate-mark nil)
(throw 'exit nil))
(error "%s" "Not in most nested minibuffer"))
(defun self-insert-and-exit ()
"Terminate minibuffer input."
@ -2394,7 +2396,7 @@ The completion method is determined by `completion-at-point-functions'."
;;; Key bindings.
(let ((map minibuffer-local-map))
(define-key map "\C-g" 'abort-recursive-edit)
(define-key map "\C-g" 'abort-minibuffers)
(define-key map "\M-<" 'minibuffer-beginning-of-buffer)
(define-key map "\r" 'exit-minibuffer)

4
lisp/mouse-drag.el
View file

@ -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)))

2
lisp/mouse.el
View file

@ -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))))

2
lisp/net/nsm.el
View file

@ -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)

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

@ -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

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

@ -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"))))
@ -2601,7 +2606,7 @@ The method used must be an out-of-band method."
(t nil)))))))))
(defun tramp-sh-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
(setq filename (expand-file-name filename))
(unless switches (setq switches ""))
@ -2636,66 +2641,63 @@ The method used must be an out-of-band method."
v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
switches filename (if wildcard "yes" "no")
(if full-directory-p "yes" "no"))
;; If `full-directory-p', we just say `ls -l FILENAME'.
;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
;; If `full-directory-p', we just say `ls -l FILENAME'. Else we
;; chdir to the parent directory, then say `ls -ld BASENAME'.
(if full-directory-p
(tramp-send-command
v
(format "%s %s %s 2>%s"
(tramp-get-ls-command v)
switches
(if wildcard
localname
(tramp-shell-quote-argument (concat localname ".")))
(tramp-get-remote-null-device v)))
v (format "%s %s %s 2>%s"
(tramp-get-ls-command v)
switches
(if wildcard
localname
(tramp-shell-quote-argument (concat localname ".")))
(tramp-get-remote-null-device v)))
(tramp-barf-unless-okay
v
(format "cd %s" (tramp-shell-quote-argument
(tramp-run-real-handler
#'file-name-directory (list localname))))
v (format "cd %s" (tramp-shell-quote-argument
(tramp-run-real-handler
#'file-name-directory (list localname))))
"Couldn't `cd %s'"
(tramp-shell-quote-argument
(tramp-run-real-handler #'file-name-directory (list localname))))
(tramp-send-command
v
(format "%s %s %s 2>%s"
(tramp-get-ls-command v)
switches
(if (or wildcard
(zerop (length
(tramp-run-real-handler
#'file-name-nondirectory (list localname)))))
""
(tramp-shell-quote-argument
(tramp-run-real-handler
#'file-name-nondirectory (list localname))))
(tramp-get-remote-null-device v))))
v (format "%s %s %s 2>%s"
(tramp-get-ls-command v)
switches
(if (or wildcard
(zerop (length
(tramp-run-real-handler
#'file-name-nondirectory (list localname)))))
""
(tramp-shell-quote-argument
(tramp-run-real-handler
#'file-name-nondirectory (list localname))))
(tramp-get-remote-null-device v))))
(save-restriction
(let ((beg (point))
(emc enable-multibyte-characters))
(narrow-to-region (point) (point))
;; We cannot use `insert-buffer-substring' because the Tramp
;; buffer changes its contents before insertion due to calling
;; `expand-file-name' and alike.
(insert
(with-current-buffer (tramp-get-buffer v)
(buffer-string)))
(let ((beg-marker (copy-marker (point) nil))
(end-marker (copy-marker (point) t))
(emc enable-multibyte-characters))
;; We cannot use `insert-buffer-substring' because the Tramp
;; buffer changes its contents before insertion due to calling
;; `expand-file-name' and alike.
(insert (with-current-buffer (tramp-get-buffer v) (buffer-string)))
;; Check for "--dired" output. We must enable unibyte
;; strings, because the "--dired" output counts in bytes.
(set-buffer-multibyte nil)
;; We must enable unibyte strings, because the "--dired"
;; output counts in bytes.
(set-buffer-multibyte nil)
(save-restriction
(narrow-to-region beg-marker end-marker)
;; Check for "--dired" output.
(forward-line -2)
(when (looking-at-p "//SUBDIRED//")
(forward-line -1))
(when (looking-at "//DIRED//\\s-+")
(let ((databeg (match-end 0))
(let ((beg (match-end 0))
(end (point-at-eol)))
;; Now read the numeric positions of file names.
(goto-char databeg)
(goto-char beg)
(while (< (point) end)
(let ((start (+ beg (read (current-buffer))))
(end (+ beg (read (current-buffer)))))
(let ((start (+ (point-min) (read (current-buffer))))
(end (+ (point-min) (read (current-buffer)))))
(if (memq (char-after end) '(?\n ?\ ))
;; End is followed by \n or by " -> ".
(put-text-property start end 'dired-filename t))))))
@ -2703,18 +2705,18 @@ The method used must be an out-of-band method."
(goto-char (point-at-bol))
(while (looking-at "//")
(forward-line 1)
(delete-region (match-beginning 0) (point)))
;; Reset multibyte if needed.
(set-buffer-multibyte emc)
(delete-region (match-beginning 0) (point))))
;; Reset multibyte if needed.
(set-buffer-multibyte emc)
(save-restriction
(narrow-to-region beg-marker end-marker)
;; Some busyboxes are reluctant to discard colors.
(unless
(string-match-p "color" (tramp-get-connection-property v "ls" ""))
(save-excursion
(goto-char beg)
(while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match ""))))
(goto-char (point-min))
(while (re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "")))
;; Now decode what read if necessary. Stolen from `insert-directory'.
(let ((coding (or coding-system-for-read
@ -2729,36 +2731,32 @@ The method used must be an out-of-band method."
;; If no coding system is specified or detection is
;; requested, detect the coding.
(if (eq (coding-system-base coding) 'undecided)
(setq coding (detect-coding-region beg (point) t)))
(if (not (eq (coding-system-base coding) 'undecided))
(save-restriction
(setq coding-no-eol
(coding-system-change-eol-conversion coding 'unix))
(narrow-to-region beg (point))
(goto-char (point-min))
(while (not (eobp))
(setq pos (point)
val (get-text-property (point) 'dired-filename))
(goto-char (next-single-property-change
(point) 'dired-filename nil (point-max)))
;; Force no eol conversion on a file name, so
;; that CR is preserved.
(decode-coding-region pos (point)
(if val coding-no-eol coding))
(if val
(put-text-property pos (point)
'dired-filename t)))))))
(setq coding (detect-coding-region (point-min) (point) t)))
(unless (eq (coding-system-base coding) 'undecided)
(setq coding-no-eol
(coding-system-change-eol-conversion coding 'unix))
(goto-char (point-min))
(while (not (eobp))
(setq pos (point)
val (get-text-property (point) 'dired-filename))
(goto-char (next-single-property-change
(point) 'dired-filename nil (point-max)))
;; Force no eol conversion on a file name, so that
;; CR is preserved.
(decode-coding-region
pos (point) (if val coding-no-eol coding))
(if val (put-text-property pos (point) 'dired-filename t))))))
;; The inserted file could be from somewhere else.
(when (and (not wildcard) (not full-directory-p))
(goto-char (point-max))
(when (file-symlink-p filename)
(goto-char (search-backward "->" beg 'noerror)))
(goto-char (search-backward "->" (point-min) 'noerror)))
(search-backward
(if (directory-name-p filename)
"."
(file-name-nondirectory filename))
beg 'noerror)
(point-min) 'noerror)
(replace-match (file-relative-name filename) t))
;; Try to insert the amount of free space.
@ -2769,9 +2767,11 @@ The method used must be an out-of-band method."
;; Replace "total" with "total used", to avoid confusion.
(replace-match "\\1 used in directory")
(end-of-line)
(insert " available " available)))
(insert " available " available))))
(goto-char (point-max)))))))
(prog1 (goto-char end-marker)
(set-marker beg-marker nil)
(set-marker end-marker nil))))))
;; Canonicalization of file names.
@ -2840,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

24
lisp/net/tramp.el
View file

@ -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

6
lisp/net/trampver.el
View file

@ -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)))

12
lisp/pixel-scroll.el
View file

@ -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

7
lisp/progmodes/flymake.el
View file

@ -4,7 +4,7 @@
;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
;; Maintainer: João Távora <joaotavora@gmail.com>
;; Version: 1.1.0
;; Version: 1.1.1
;; Keywords: c languages tools
;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0"))
@ -1283,6 +1283,8 @@ correctly.")
(when (flymake-running-backends) flymake-mode-line-counter-format))
(defun flymake--mode-line-counter (type &optional no-space)
"Compute number of diagnostics in buffer with TYPE's severity.
TYPE is usually keyword `:error', `:warning' or `:note'."
(let ((count 0)
(face (flymake--lookup-type-property type
'mode-line-face
@ -1290,7 +1292,8 @@ correctly.")
(maphash (lambda
(_b state)
(dolist (d (flymake--backend-state-diags state))
(when (eq type (flymake--diag-type d))
(when (= (flymake--severity type)
(flymake--severity (flymake--diag-type d)))
(cl-incf count))))
flymake--backend-state)
(when (or (cl-plusp count)

19
lisp/progmodes/project.el
View file

@ -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))

6
lisp/progmodes/prolog.el
View file

@ -1201,7 +1201,9 @@ Commands:
(define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]"
"Major mode for editing Mercury programs.
Actually this is just customized `prolog-mode'."
(setq-local prolog-system 'mercury))
(setq-local prolog-system 'mercury)
;; Run once more to set up based on `prolog-system'
(prolog-mode-variables))
;;-------------------------------------------------------------------
@ -2082,7 +2084,7 @@ Argument BOUND is a buffer position limiting searching."
(delq
nil
(cond
((eq major-mode 'prolog-mode)
((derived-mode-p 'prolog-mode)
(list
head-predicates
head-predicates-1

6
lisp/progmodes/python.el
View file

@ -2027,8 +2027,12 @@ position, else returns nil."
:group 'python
:safe 'stringp)
(defcustom python-shell-interpreter "python"
(defcustom python-shell-interpreter
(cond ((executable-find "python3") "python3")
((executable-find "python") "python")
(t "python3"))
"Default Python interpreter for shell."
:version "28.1"
:type 'string
:group 'python)

15
lisp/progmodes/xref.el
View file

@ -663,6 +663,12 @@ means to first quit the *xref* buffer."
(interactive)
(xref-goto-xref t))
(defun xref-quit-and-pop-marker-stack ()
"Quit *xref* buffer, then pop the xref marker stack."
(interactive)
(quit-window)
(xref-pop-marker-stack))
(defun xref-query-replace-in-results (from to)
"Perform interactive replacement of FROM with TO in all displayed xrefs.
@ -793,6 +799,7 @@ references displayed in the current *xref* buffer."
(define-key map (kbd ".") #'xref-next-line)
(define-key map (kbd ",") #'xref-prev-line)
(define-key map (kbd "g") #'xref-revert-buffer)
(define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack)
map))
(define-derived-mode xref--xref-buffer-mode special-mode "XREF"
@ -928,8 +935,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
(or
(assoc-default 'fetched-xrefs alist)
(funcall fetcher)))
(xref-alist (xref--analyze xrefs)))
(xref-alist (xref--analyze xrefs))
(dd default-directory))
(with-current-buffer (get-buffer-create xref-buffer-name)
(setq default-directory dd)
(xref--xref-buffer-mode)
(xref--show-common-initialize xref-alist fetcher alist)
(pop-to-buffer (current-buffer))
@ -992,13 +1001,15 @@ When only one definition found, jump to it right away instead."
When there is more than one definition, split the selected window
and show the list in a small window at the bottom. And use a
local keymap that binds `RET' to `xref-quit-and-goto-xref'."
(let ((xrefs (funcall fetcher)))
(let ((xrefs (funcall fetcher))
(dd default-directory))
(cond
((not (cdr xrefs))
(xref-pop-to-location (car xrefs)
(assoc-default 'display-action alist)))
(t
(with-current-buffer (get-buffer-create xref-buffer-name)
(setq default-directory dd)
(xref--transient-buffer-mode)
(xref--show-common-initialize (xref--analyze xrefs) fetcher alist)
(pop-to-buffer (current-buffer)

4
lisp/ruler-mode.el
View file

@ -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)

1
lisp/shell.el
View file

@ -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)

34
lisp/simple.el
View file

@ -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)))))

37
lisp/startup.el
View file

@ -929,7 +929,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."
@ -985,8 +986,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))
@ -1174,12 +1175,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
@ -1296,8 +1296,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)
@ -1306,15 +1305,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))
@ -1322,9 +1312,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)
@ -1382,7 +1371,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)

23
lisp/strokes.el
View file

@ -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

112
lisp/subr.el
View file

@ -1183,6 +1183,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.
@ -1335,7 +1359,9 @@ The normal global definition of the character C-x indirects to this keymap.")
map)
"Default global keymap mapping Emacs keyboard input into commands.
The value is a keymap that is usually (but not necessarily) Emacs's
global map.")
global map.
See also `current-global-map'.")
(use-global-map global-map)
@ -1879,9 +1905,33 @@ all symbols are bound before any of the VALUEFORMs are evalled."
;; As a special-form, we could implement it more efficiently (and cleanly,
;; making the vars actually unbound during evaluation of the binders).
(declare (debug let) (indent 1))
`(let ,(mapcar #'car binders)
,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
,@body))
;; Use plain `let*' for the non-recursive definitions.
;; This only handles the case where the first few definitions are not
;; recursive. Nothing as fancy as an SCC analysis.
(let ((seqbinds nil))
;; Our args haven't yet been macro-expanded, so `macroexp--fgrep'
;; may fail to see references that will be introduced later by
;; macroexpansion. We could call `macroexpand-all' to avoid that,
;; but in order to avoid that, we instead check to see if the binders
;; appear in the macroexp environment, since that's how references can be
;; introduced later on.
(unless (macroexp--fgrep binders macroexpand-all-environment)
(while (and binders
(null (macroexp--fgrep binders (nth 1 (car binders)))))
(push (pop binders) seqbinds)))
(let ((nbody (if (null binders)
(macroexp-progn body)
`(let ,(mapcar #'car binders)
,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
,@body))))
(cond
;; All bindings are recursive.
((null seqbinds) nbody)
;; Special case for trivial uses.
((and (symbolp nbody) (null (cdr seqbinds)) (eq nbody (caar seqbinds)))
(nth 1 (car seqbinds)))
;; General case.
(t `(let* ,(nreverse seqbinds) ,nbody))))))
(defmacro dlet (binders &rest body)
"Like `let*' but using dynamic scoping."
@ -2524,23 +2574,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
@ -2594,6 +2673,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!

6
lisp/textmodes/artist.el
View file

@ -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

11
lisp/textmodes/fill.el
View file

@ -743,9 +743,16 @@ space does not end a sentence, so don't break a line there."
;; This is the actual filling loop.
(goto-char from)
(let (linebeg)
(let ((first t)
linebeg)
(while (< (point) to)
(setq linebeg (point))
;; On the first line, there may be text in the fill prefix
;; zone. In that case, don't consider that area when
;; trying to find a place to put a line break (bug#45720).
(if (not first)
(setq linebeg (point))
(setq first nil
linebeg (+ (point) (length fill-prefix))))
(move-to-column (current-fill-column))
(if (when (< (point) to)
;; Find the position where we'll break the line.

18
lisp/textmodes/reftex-vars.el
View file

@ -900,13 +900,14 @@ 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
"begin[[:space:]]*{"
;; Build a regexp for env names
(regexp-opt '("lstlisting" "dmath" "dseries" "dgroup" "darray"))
(regexp-opt '("lstlisting" "dmath" "dseries" "dgroup"
"darray" "frame"))
;; closing brace, optional spaces
"}[[:space:]]*"
;; Now for macros
@ -919,9 +920,9 @@ DOWNCASE t: Downcase words before using them."
"\\[[^][]*"
;; Allow nested levels of chars enclosed in braces
"\\(?:{[^}{]*"
"\\(?:{[^}{]*"
"\\(?:{[^}{]*}[^}{]*\\)*"
"}[^}{]*\\)*"
"\\(?:{[^}{]*"
"\\(?:{[^}{]*}[^}{]*\\)*"
"}[^}{]*\\)*"
"}[^][]*\\)*"
;; Match the label key
"\\<label[[:space:]]*=[[:space:]]*"
@ -935,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.
@ -944,7 +946,7 @@ you have to define it using \\(?1:...\\) when adding new regexps.
When changed from Lisp, make sure to call
`reftex-compile-variables' afterwards to make the change
effective."
:version "27.1"
:version "28.1"
:set (lambda (symbol value)
(set symbol value)
(when (fboundp 'reftex-compile-variables)

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

@ -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))))

2
lisp/vc/ediff.el
View file

@ -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)

14
lisp/wid-edit.el
View file

@ -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))

13
lisp/window.el
View file

@ -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
@ -4116,7 +4118,10 @@ frame can be safely deleted."
frame))
(throw 'other t))))
(let ((minibuf (active-minibuffer-window)))
(and minibuf (eq frame (window-frame minibuf)))))
(and minibuf (eq frame (window-frame minibuf))
(not (eq (default-toplevel-value
minibuffer-follows-selected-frame)
t)))))
'frame))
((window-minibuffer-p window)
;; If WINDOW is the minibuffer window of a non-minibuffer-only

2
src/buffer.c
View file

@ -4785,7 +4785,7 @@ mmap_init (void)
if (mmap_fd <= 0)
{
/* No anonymous mmap -- we need the file descriptor. */
mmap_fd = emacs_open ("/dev/zero", O_RDONLY, 0);
mmap_fd = emacs_open_noquit ("/dev/zero", O_RDONLY, 0);
if (mmap_fd == -1)
fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
}

33
src/callproc.c
View file

@ -314,6 +314,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
char *tempfile = NULL;
#else
sigset_t oldset;
pid_t pid = -1;
#endif
int child_errno;
@ -601,9 +602,12 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
#ifndef MSDOS
block_input ();
block_child_signal (&oldset);
child_errno
= emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env,
SSDATA (current_dir), NULL);
SSDATA (current_dir), NULL, &oldset);
eassert ((child_errno == 0) == (0 < pid));
if (pid > 0)
@ -624,6 +628,9 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
}
}
unblock_child_signal (&oldset);
unblock_input ();
if (pid < 0)
report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, child_errno);
@ -1227,17 +1234,21 @@ child_setup (int in, int out, int err, char **new_argv, char **env,
process image file ARGV[0]. Use ENVP for the environment block for
the new process. Use CWD as working directory for the new process.
If PTY is not NULL, it must be a pseudoterminal device. If PTY is
NULL, don't perform any terminal setup. */
NULL, don't perform any terminal setup. OLDSET must be a pointer
to a signal set initialized by `block_child_signal'. Before
calling this function, call `block_input' and `block_child_signal';
afterwards, call `unblock_input' and `unblock_child_signal'. Be
sure to call `unblock_child_signal' only after registering NEWPID
in a list where `handle_child_signal' can find it! */
int
emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
char **argv, char **envp, const char *cwd, const char *pty)
char **argv, char **envp, const char *cwd,
const char *pty, const sigset_t *oldset)
{
sigset_t oldset;
int pid;
block_input ();
block_child_signal (&oldset);
eassert (input_blocked_p ());
#ifndef WINDOWSNT
/* vfork, and prevent local vars from being clobbered by the vfork. */
@ -1249,6 +1260,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
int volatile stdout_volatile = std_out;
int volatile stderr_volatile = std_err;
char **volatile envp_volatile = envp;
const sigset_t *volatile oldset_volatile = oldset;
#ifdef DARWIN_OS
/* Darwin doesn't let us run setsid after a vfork, so use fork when
@ -1270,6 +1282,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
std_out = stdout_volatile;
std_err = stderr_volatile;
envp = envp_volatile;
oldset = oldset_volatile;
if (pid == 0)
#endif /* not WINDOWSNT */
@ -1323,7 +1336,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
would work? */
if (std_in >= 0)
emacs_close (std_in);
std_out = std_in = emacs_open (pty, O_RDWR, 0);
std_out = std_in = emacs_open_noquit (pty, O_RDWR, 0);
if (std_in < 0)
{
@ -1364,7 +1377,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
#endif
/* Stop blocking SIGCHLD in the child. */
unblock_child_signal (&oldset);
unblock_child_signal (oldset);
if (pty_flag)
child_setup_tty (std_out);
@ -1382,10 +1395,6 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
int vfork_error = pid < 0 ? errno : 0;
/* Stop blocking in the parent. */
unblock_child_signal (&oldset);
unblock_input ();
if (pid < 0)
{
eassert (0 < vfork_error);

3
src/data.c
View file

@ -3834,6 +3834,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");
@ -3918,6 +3919,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");

16
src/dispnew.c
View file

@ -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;
}

4
src/emacs.c
View file

@ -1300,7 +1300,7 @@ main (int argc, char **argv)
{
emacs_close (STDIN_FILENO);
emacs_close (STDOUT_FILENO);
int result = emacs_open (term, O_RDWR, 0);
int result = emacs_open_noquit (term, O_RDWR, 0);
if (result != STDIN_FILENO
|| (fcntl (STDIN_FILENO, F_DUPFD_CLOEXEC, STDOUT_FILENO)
!= STDOUT_FILENO))
@ -2884,7 +2884,7 @@ from the parent process and its tty file descriptors. */)
int nfd;
/* Get rid of stdin, stdout and stderr. */
nfd = emacs_open ("/dev/null", O_RDWR, 0);
nfd = emacs_open_noquit ("/dev/null", O_RDWR, 0);
err |= nfd < 0;
err |= dup2 (nfd, STDIN_FILENO) < 0;
err |= dup2 (nfd, STDOUT_FILENO) < 0;

26
src/eval.c
View file

@ -1176,9 +1176,18 @@ Lisp_Object
internal_catch (Lisp_Object tag,
Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
{
/* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by
throwing t to tag `exit'.
Value -1 means there is no (throw 'exit t) in progress;
0 means the `throw' wasn't done from an active minibuffer;
N > 0 means the `throw' was done from the minibuffer at level N. */
static EMACS_INT minibuffer_quit_level = -1;
/* This structure is made part of the chain `catchlist'. */
struct handler *c = push_handler (tag, CATCHER);
if (EQ (tag, Qexit))
minibuffer_quit_level = -1;
/* Call FUNC. */
if (! sys_setjmp (c->jmp))
{
@ -1192,6 +1201,23 @@ internal_catch (Lisp_Object tag,
Lisp_Object val = handlerlist->val;
clobbered_eassert (handlerlist == c);
handlerlist = handlerlist->next;
if (EQ (tag, Qexit) && EQ (val, Qt))
/* If we've thrown t to tag `exit' from within a minibuffer, we
exit all minibuffers more deeply nested than the current
one. */
{
EMACS_INT mini_depth = this_minibuffer_depth (Qnil);
if (mini_depth && mini_depth != minibuffer_quit_level)
{
if (minibuffer_quit_level == -1)
minibuffer_quit_level = mini_depth;
if (minibuffer_quit_level
&& (minibuf_level > minibuffer_quit_level))
Fthrow (Qexit, Qt);
}
else
minibuffer_quit_level = -1;
}
return val;
}
}

85
src/fns.c
View file

@ -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);
}

35
src/keymap.c
View file

@ -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);

8
src/lisp.h
View file

@ -4368,9 +4368,12 @@ extern Lisp_Object Vminibuffer_list;
extern Lisp_Object last_minibuf_string;
extern void move_minibuffer_onto_frame (void);
extern bool is_minibuffer (EMACS_INT, Lisp_Object);
extern EMACS_INT this_minibuffer_depth (Lisp_Object);
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. */
@ -4518,8 +4521,8 @@ extern void setup_process_coding_systems (Lisp_Object);
# define CHILD_SETUP_ERROR_DESC "Doing vfork"
#endif
extern int emacs_spawn (pid_t *, int, int, int, char **, char **, const char *,
const char *);
extern int emacs_spawn (pid_t *, int, int, int, char **, char **,
const char *, const char *, const sigset_t *);
extern char **make_environment_block (Lisp_Object);
extern void init_callproc_1 (void);
extern void init_callproc (void);
@ -4598,6 +4601,7 @@ extern AVOID emacs_abort (void) NO_INLINE;
extern int emacs_fstatat (int, char const *, void *, int);
extern int emacs_openat (int, char const *, int, int);
extern int emacs_open (const char *, int, int);
extern int emacs_open_noquit (const char *, int, int);
extern int emacs_pipe (int[2]);
extern int emacs_close (int);
extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);

29
src/lread.c
View file

@ -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);

209
src/minibuf.c
View file

@ -63,9 +63,30 @@ static Lisp_Object minibuf_prompt;
static ptrdiff_t minibuf_prompt_width;
static Lisp_Object nth_minibuffer (EMACS_INT depth);
/* Return TRUE when a frame switch causes a minibuffer on the old
frame to move onto the new one. */
static bool
minibuf_follows_frame (void)
{
return EQ (Fdefault_toplevel_value (Qminibuffer_follows_selected_frame),
Qt);
}
/* Return TRUE when a minibuffer always remains on the frame where it
was first invoked. */
static bool
minibuf_stays_put (void)
{
return NILP (Fdefault_toplevel_value (Qminibuffer_follows_selected_frame));
}
/* Return TRUE when opening a (recursive) minibuffer causes
minibuffers on other frames to move to the selected frame. */
static bool
minibuf_moves_frame_when_opened (void)
{
return !NILP (Fdefault_toplevel_value (Qminibuffer_follows_selected_frame));
}
@ -90,7 +111,7 @@ choose_minibuf_frame (void)
minibuf_window = sf->minibuffer_window;
/* If we've still got another minibuffer open, use its mini-window
instead. */
if (minibuf_level && !minibuf_follows_frame ())
if (minibuf_level > 1 && minibuf_stays_put ())
{
Lisp_Object buffer = get_minibuffer (minibuf_level);
Lisp_Object tail, frame;
@ -105,26 +126,40 @@ choose_minibuf_frame (void)
}
}
if (minibuf_follows_frame ())
if (minibuf_moves_frame_when_opened ()
&& FRAMEP (selected_frame)
&& FRAME_LIVE_P (XFRAME (selected_frame)))
/* Make sure no other frame has a minibuffer as its selected window,
because the text would not be displayed in it, and that would be
confusing. Only allow the selected frame to do this,
and that only if the minibuffer is active. */
{
Lisp_Object tail, frame;
{
Lisp_Object tail, frame;
struct frame *of;
FOR_EACH_FRAME (tail, frame)
if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (XFRAME (frame))))
&& !(EQ (frame, selected_frame)
&& minibuf_level > 0))
Fset_frame_selected_window (frame, Fframe_first_window (frame),
Qnil);
}
FOR_EACH_FRAME (tail, frame)
if (!EQ (frame, selected_frame)
&& minibuf_level > 1
/* The frame's minibuffer can be on a different frame. */
&& ! EQ (XWINDOW ((of = XFRAME (frame))->minibuffer_window)->frame,
selected_frame))
{
if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (of))))
Fset_frame_selected_window (frame, Fframe_first_window (frame),
Qnil);
if (!EQ (XWINDOW (of->minibuffer_window)->contents,
nth_minibuffer (0)))
set_window_buffer (of->minibuffer_window,
nth_minibuffer (0), 0, 0);
}
}
}
/* If `minibuffer_follows_selected_frame' and we have a minibuffer, move it
from its current frame to the selected frame. This function is
intended to be called from `do_switch_frame' in frame.c. */
/* If `minibuffer_follows_selected_frame' is t and we have a
minibuffer, move it from its current frame to the selected frame.
This function is intended to be called from `do_switch_frame' in
frame.c. */
void move_minibuffer_onto_frame (void)
{
if (!minibuf_level)
@ -135,14 +170,18 @@ void move_minibuffer_onto_frame (void)
&& FRAME_LIVE_P (XFRAME (selected_frame))
&& !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window))
{
EMACS_INT i;
struct frame *sf = XFRAME (selected_frame);
Lisp_Object old_frame = XWINDOW (minibuf_window)->frame;
struct frame *of = XFRAME (old_frame);
Lisp_Object buffer = XWINDOW (minibuf_window)->contents;
set_window_buffer (sf->minibuffer_window, buffer, 0, 0);
/* Stack up all the (recursively) open minibuffers on the selected
mini_window. */
for (i = 1; i <= minibuf_level; i++)
set_window_buffer (sf->minibuffer_window, nth_minibuffer (i), 0, 0);
minibuf_window = sf->minibuffer_window;
set_window_buffer (of->minibuffer_window, get_minibuffer (0), 0, 0);
if (of != sf)
set_window_buffer (of->minibuffer_window, get_minibuffer (0), 0, 0);
}
}
@ -336,6 +375,63 @@ return t only if BUFFER is an active minibuffer. */)
? Qt : Qnil;
}
DEFUN ("innermost-minibuffer-p", Finnermost_minibuffer_p,
Sinnermost_minibuffer_p, 0, 1, 0,
doc: /* Return t if BUFFER is the most nested active minibuffer.
No argument or nil as argument means use the current buffer as BUFFER. */)
(Lisp_Object buffer)
{
if (NILP (buffer))
buffer = Fcurrent_buffer ();
return EQ (buffer, (Fcar (Fnthcdr (make_fixnum (minibuf_level),
Vminibuffer_list))))
? Qt
: Qnil;
}
/* Return the nesting depth of the active minibuffer BUFFER, or 0 if
BUFFER isn't such a thing. If BUFFER is nil, this means use the current
buffer. */
EMACS_INT
this_minibuffer_depth (Lisp_Object buffer)
{
EMACS_INT i;
Lisp_Object bufs;
if (NILP (buffer))
buffer = Fcurrent_buffer ();
for (i = 1, bufs = Fcdr (Vminibuffer_list);
i <= minibuf_level;
i++, bufs = Fcdr (bufs))
if (EQ (Fcar (bufs), buffer))
return i;
return 0;
}
DEFUN ("abort-minibuffers", Fabort_minibuffers, Sabort_minibuffers, 0, 0, "",
doc: /* Abort the current minibuffer.
If we are not currently in the innermost minibuffer, prompt the user to
confirm the aborting of the current minibuffer and all contained ones. */)
(void)
{
EMACS_INT minibuf_depth = this_minibuffer_depth (Qnil);
Lisp_Object array[2];
AUTO_STRING (fmt, "Abort %s minibuffer levels? ");
if (!minibuf_depth)
error ("Not in a minibuffer");
if (minibuf_depth < minibuf_level)
{
array[0] = fmt;
array[1] = make_fixnum (minibuf_level - minibuf_depth + 1);
if (!NILP (Fyes_or_no_p (Fformat (2, array))))
Fthrow (Qexit, Qt);
}
else
Fthrow (Qexit, Qt);
return Qnil;
}
DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end,
Sminibuffer_prompt_end, 0, 0, 0,
doc: /* Return the buffer position of the end of the minibuffer prompt.
@ -411,6 +507,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
Lisp_Object val;
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
Lisp_Object calling_frame = selected_frame;
Lisp_Object enable_multibyte;
EMACS_INT pos = 0;
/* String to add to the history. */
@ -648,6 +745,17 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
}
}
if (minibuf_moves_frame_when_opened ())
{
EMACS_INT i;
/* Stack up all the (recursively) open minibuffers on the selected
mini_window. */
for (i = 1; i < minibuf_level; i++)
set_window_buffer (XFRAME (mini_frame)->minibuffer_window,
nth_minibuffer (i), 0, 0);
}
/* Display this minibuffer in the proper window. */
/* Use set_window_buffer instead of Fset_window_buffer (see
discussion of bug#11984, bug#12025, bug#12026). */
@ -729,6 +837,20 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
recursive_edit_1 ();
/* We've exited the recursive edit without an error, so switch the
current window away from the expired minibuffer window. */
{
Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil);
/* PREV can be on a different frame when we have a minibuffer only
frame, the other frame's minibuffer window is MINIBUF_WINDOW,
and its "focus window" is also MINIBUF_WINDOW. */
while (!EQ (prev, minibuf_window)
&& !EQ (selected_frame, WINDOW_FRAME (XWINDOW (prev))))
prev = Fprevious_window (prev, Qnil, Qnil);
if (!EQ (prev, minibuf_window))
Fset_frame_selected_window (selected_frame, prev, Qnil);
}
/* If cursor is on the minibuffer line,
show the user we have exited by putting it in column 0. */
if (XWINDOW (minibuf_window)->cursor.vpos >= 0
@ -767,6 +889,12 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
in set-window-configuration. */
unbind_to (count, Qnil);
/* Switch the frame back to the calling frame. */
if (!EQ (selected_frame, calling_frame)
&& FRAMEP (calling_frame)
&& FRAME_LIVE_P (XFRAME (calling_frame)))
call2 (intern ("select-frame-set-input-focus"), calling_frame, Qnil);
/* Add the value to the appropriate history list, if any. This is
done after the previous buffer has been made current again, in
case the history variable is buffer-local. */
@ -790,6 +918,14 @@ is_minibuffer (EMACS_INT depth, Lisp_Object buf)
&& EQ (Fcar (tail), buf);
}
/* Return the DEPTHth minibuffer, or nil if such does not yet exist. */
static Lisp_Object
nth_minibuffer (EMACS_INT depth)
{
Lisp_Object tail = Fnthcdr (make_fixnum (depth), Vminibuffer_list);
return XCAR (tail);
}
/* Return a buffer to be used as the minibuffer at depth `depth'.
depth = 0 is the lowest allowed argument, and that is the value
used for nonrecursive minibuffer invocations. */
@ -939,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.
@ -983,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,
@ -998,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;
@ -1071,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));
@ -2032,13 +2186,15 @@ For example, `eval-expression' uses this. */);
The function is called with the arguments passed to `read-buffer'. */);
Vread_buffer_function = Qnil;
DEFVAR_BOOL ("minibuffer-follows-selected-frame", minibuffer_follows_selected_frame,
doc: /* Non-nil means the active minibuffer always displays on the selected frame.
DEFVAR_LISP ("minibuffer-follows-selected-frame", minibuffer_follows_selected_frame,
doc: /* t means the active minibuffer always displays on the selected frame.
Nil means that a minibuffer will appear only in the frame which created it.
Any other value means the minibuffer will move onto another frame, but
only when the user starts using a minibuffer there.
Any buffer local or dynamic binding of this variable is ignored. Only the
default top level value is used. */);
minibuffer_follows_selected_frame = 1;
minibuffer_follows_selected_frame = Qt;
DEFVAR_BOOL ("read-buffer-completion-ignore-case",
read_buffer_completion_ignore_case,
@ -2183,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);
@ -2196,6 +2361,8 @@ uses to hide passwords. */);
defsubr (&Sminibuffer_prompt);
defsubr (&Sminibufferp);
defsubr (&Sinnermost_minibuffer_p);
defsubr (&Sabort_minibuffers);
defsubr (&Sminibuffer_prompt_end);
defsubr (&Sminibuffer_contents);
defsubr (&Sminibuffer_contents_no_properties);

2
src/pdumper.c
View file

@ -5460,7 +5460,7 @@ pdumper_load (const char *dump_filename, char *argv0, char const *original_pwd)
eassert (!dump_loaded_p ());
int err;
int dump_fd = emacs_open (dump_filename, O_RDONLY, 0);
int dump_fd = emacs_open_noquit (dump_filename, O_RDONLY, 0);
if (dump_fd < 0)
{
err = (errno == ENOENT || errno == ENOTDIR

13
src/process.c
View file

@ -692,8 +692,7 @@ status_convert (int w)
if (WIFSTOPPED (w))
return Fcons (Qstop, Fcons (make_fixnum (WSTOPSIG (w)), Qnil));
else if (WIFEXITED (w))
return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)),
WCOREDUMP (w) ? Qt : Qnil));
return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)), Qnil));
else if (WIFSIGNALED (w))
return Fcons (Qsignal, Fcons (make_fixnum (WTERMSIG (w)),
WCOREDUMP (w) ? Qt : Qnil));
@ -2059,6 +2058,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
bool pty_flag = 0;
char pty_name[PTY_NAME_SIZE];
Lisp_Object lisp_pty_name = Qnil;
sigset_t oldset;
inchannel = outchannel = -1;
@ -2139,13 +2139,16 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
setup_process_coding_systems (process);
char **env = make_environment_block (current_dir);
block_input ();
block_child_signal (&oldset);
pty_flag = p->pty_flag;
eassert (pty_flag == ! NILP (lisp_pty_name));
vfork_errno
= emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env,
SSDATA (current_dir),
pty_flag ? SSDATA (lisp_pty_name) : NULL);
pty_flag ? SSDATA (lisp_pty_name) : NULL, &oldset);
eassert ((vfork_errno == 0) == (0 < pid));
@ -2153,6 +2156,10 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
if (pid >= 0)
p->alive = 1;
/* Stop blocking in the parent. */
unblock_child_signal (&oldset);
unblock_input ();
/* Environment block no longer needed. */
unbind_to (count, Qnil);

217
src/sysdep.c
View file

@ -53,6 +53,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
# include <sys/sysctl.h>
#endif
#if defined __OpenBSD__
# include <sys/proc.h>
#endif
#ifdef DARWIN_OS
# include <libproc.h>
#endif
@ -2316,6 +2320,28 @@ emacs_open (char const *file, int oflags, int mode)
return emacs_openat (AT_FDCWD, file, oflags, mode);
}
/* Same as above, but doesn't allow the user to quit. */
static int
emacs_openat_noquit (int dirfd, const char *file, int oflags,
int mode)
{
int fd;
if (! (oflags & O_TEXT))
oflags |= O_BINARY;
oflags |= O_CLOEXEC;
do
fd = openat (dirfd, file, oflags, mode);
while (fd < 0 && errno == EINTR);
return fd;
}
int
emacs_open_noquit (char const *file, int oflags, int mode)
{
return emacs_openat_noquit (AT_FDCWD, file, oflags, mode);
}
/* Open FILE as a stream for Emacs use, with mode MODE.
Act like emacs_open with respect to threads, signals, and quits. */
@ -2972,6 +2998,14 @@ make_lisp_timeval (struct timeval t)
return make_lisp_time (timeval_to_timespec (t));
}
#elif defined __OpenBSD__
static Lisp_Object
make_lisp_timeval (long sec, long usec)
{
return make_lisp_time(make_timespec(sec, usec * 1000));
}
#endif
#ifdef GNU_LINUX
@ -3661,6 +3695,189 @@ system_process_attributes (Lisp_Object pid)
return attrs;
}
#elif defined __OpenBSD__
Lisp_Object
system_process_attributes (Lisp_Object pid)
{
int proc_id, nentries, fscale, i;
int pagesize = getpagesize ();
int mib[6];
size_t len;
double pct;
char *ttyname, args[ARG_MAX];
struct kinfo_proc proc;
struct passwd *pw;
struct group *gr;
struct timespec t;
struct uvmexp uvmexp;
Lisp_Object attrs = Qnil;
Lisp_Object decoded_comm;
CHECK_NUMBER (pid);
CONS_TO_INTEGER (pid, int, proc_id);
len = sizeof proc;
mib[0] = CTL_KERN;
mib[1] = KERN_PROC;
mib[2] = KERN_PROC_PID;
mib[3] = proc_id;
mib[4] = len;
mib[5] = 1;
if (sysctl (mib, 6, &proc, &len, NULL, 0) != 0)
return attrs;
attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (proc.p_uid)), attrs);
block_input ();
pw = getpwuid (proc.p_uid);
unblock_input ();
if (pw)
attrs = Fcons (Fcons (Quser, build_string(pw->pw_name)), attrs);
attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER(proc.p_svgid)), attrs);
block_input ();
gr = getgrgid (proc.p_svgid);
unblock_input ();
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
AUTO_STRING (comm, proc.p_comm);
decoded_comm = code_convert_string_norecord (comm, Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
{
char state[2] = {'\0', '\0'};
switch (proc.p_stat) {
case SIDL:
state[0] = 'I';
break;
case SRUN:
state[0] = 'R';
break;
case SSLEEP:
state[0] = 'S';
break;
case SSTOP:
state[0] = 'T';
break;
case SZOMB:
state[0] = 'Z';
break;
case SDEAD:
state[0] = 'D';
break;
}
attrs = Fcons (Fcons (Qstate, build_string (state)), attrs);
}
attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (proc.p_ppid)), attrs);
attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (proc.p_gid)), attrs);
attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (proc.p_sid)), attrs);
block_input ();
ttyname = proc.p_tdev == NODEV ? NULL : devname (proc.p_tdev, S_IFCHR);
unblock_input ();
if (ttyname)
attrs = Fcons (Fcons (Qttname, build_string (ttyname)), attrs);
attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.p_tpgid)), attrs);
attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (proc.p_uru_minflt)),
attrs);
attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (proc.p_uru_majflt)),
attrs);
/* FIXME: missing cminflt, cmajflt. */
attrs = Fcons (Fcons (Qutime, make_lisp_timeval (proc.p_uutime_sec,
proc.p_uutime_usec)),
attrs);
attrs = Fcons (Fcons (Qstime, make_lisp_timeval (proc.p_ustime_sec,
proc.p_ustime_usec)),
attrs);
t = timespec_add (make_timespec (proc.p_uutime_sec,
proc.p_uutime_usec * 1000),
make_timespec (proc.p_ustime_sec,
proc.p_ustime_usec * 1000));
attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs);
attrs = Fcons (Fcons (Qcutime, make_lisp_timeval (proc.p_uctime_sec,
proc.p_uctime_usec)),
attrs);
/* FIXME: missing cstime and thus ctime. */
attrs = Fcons (Fcons (Qpri, make_fixnum (proc.p_priority)), attrs);
attrs = Fcons (Fcons (Qnice, make_fixnum (proc.p_nice)), attrs);
/* FIXME: missing thcount (thread count) */
attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.p_ustart_sec,
proc.p_ustart_usec)),
attrs);
len = (proc.p_vm_tsize + proc.p_vm_dsize + proc.p_vm_ssize) * pagesize >> 10;
attrs = Fcons (Fcons (Qvsize, make_fixnum (len)), attrs);
attrs = Fcons (Fcons (Qrss, make_fixnum (proc.p_vm_rssize * pagesize >> 10)),
attrs);
t = make_timespec (proc.p_ustart_sec,
proc.p_ustart_usec * 1000);
t = timespec_sub (current_timespec (), t);
attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs);
len = sizeof (fscale);
mib[0] = CTL_KERN;
mib[1] = KERN_FSCALE;
if (sysctl (mib, 2, &fscale, &len, NULL, 0) != -1)
{
pct = (double)proc.p_pctcpu / fscale * 100.0;
attrs = Fcons (Fcons (Qpcpu, make_float (pct)), attrs);
}
len = sizeof (uvmexp);
mib[0] = CTL_VM;
mib[1] = VM_UVMEXP;
if (sysctl (mib, 2, &uvmexp, &len, NULL, 0) != -1)
{
pct = (100.0 * (double)proc.p_vm_rssize / uvmexp.npages);
attrs = Fcons (Fcons (Qpmem, make_float (pct)), attrs);
}
len = sizeof args;
mib[0] = CTL_KERN;
mib[1] = KERN_PROC_ARGS;
mib[2] = proc_id;
mib[3] = KERN_PROC_ARGV;
if (sysctl (mib, 4, &args, &len, NULL, 0) == 0 && len != 0)
{
char **argv = (char**)args;
/* concatenate argv reusing the existing storage storage.
sysctl(8) guarantees that "the buffer pointed to by oldp is
filled with an array of char pointers followed by the strings
themselves." */
for (i = 0; argv[i] != NULL; ++i)
{
if (argv[i+1] != NULL)
{
len = strlen (argv[i]);
argv[i][len] = ' ';
}
}
AUTO_STRING (comm, *argv);
decoded_comm = code_convert_string_norecord (comm,
Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
}
return attrs;
}
#elif defined DARWIN_OS
Lisp_Object

3
src/w32term.c
View file

@ -7507,7 +7507,8 @@ w32_initialize (void)
}
#ifdef CYGWIN
if ((w32_message_fd = emacs_open ("/dev/windows", O_RDWR, 0)) == -1)
if ((w32_message_fd = emacs_open_noquit ("/dev/windows", O_RDWR, 0))
== -1)
fatal ("opening /dev/windows: %s", strerror (errno));
#endif /* CYGWIN */

5
src/window.c
View file

@ -2663,12 +2663,15 @@ static void
decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object *all_frames)
{
struct window *w = decode_live_window (*window);
Lisp_Object miniwin = XFRAME (w->frame)->minibuffer_window;
XSETWINDOW (*window, w);
/* MINIBUF nil may or may not include minibuffers. Decide if it
does. */
if (NILP (*minibuf))
*minibuf = minibuf_level ? minibuf_window : Qlambda;
*minibuf = this_minibuffer_depth (XWINDOW (miniwin)->contents)
? miniwin
: Qlambda;
else if (!EQ (*minibuf, Qt))
*minibuf = Qlambda;

4
src/window.h
View file

@ -1124,10 +1124,6 @@ extern Lisp_Object echo_area_window;
extern EMACS_INT command_loop_level;
/* Depth in minibuffer invocations. */
extern EMACS_INT minibuf_level;
/* Non-zero if we should redraw the mode lines on the next redisplay.
Usually set to a unique small integer so we can track the main causes of
full redisplays in `redisplay--mode-lines-cause'. */

13
src/xdisp.c
View file

@ -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)
{

8
src/xfaces.c
View file

@ -3293,7 +3293,8 @@ FRAME 0 means change the face on all frames, and change the default
}
else if (EQ (k, QCstyle))
{
if (!EQ (v, Qpressed_button) && !EQ (v, Qreleased_button))
if (!EQ (v, Qpressed_button) && !EQ (v, Qreleased_button)
&& !EQ(v, Qflat_button))
break;
}
else
@ -6031,6 +6032,10 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]
face->box = FACE_RAISED_BOX;
else if (EQ (value, Qpressed_button))
face->box = FACE_SUNKEN_BOX;
else if (EQ (value, Qflat_button)) {
face->box = FACE_SIMPLE_BOX;
face->box_color = face->background;
}
}
}
}
@ -6919,6 +6924,7 @@ syms_of_xfaces (void)
DEFSYM (Qwave, "wave");
DEFSYM (Qreleased_button, "released-button");
DEFSYM (Qpressed_button, "pressed-button");
DEFSYM (Qflat_button, "flat-button");
DEFSYM (Qnormal, "normal");
DEFSYM (Qextra_light, "extra-light");
DEFSYM (Qlight, "light");

6
test/Makefile.in
View file

@ -253,6 +253,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)

6
test/README
View file

@ -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

5
test/file-organization.org
View file

@ -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~.

71
test/infra/Dockerfile.emba Normal file
View file

@ -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 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

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