[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 0a7ac0b 1/2: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 0a7ac0b 1/2: Merge remote-tracking branch 'savannah/master' into native-comp |
|
Date: |
Sat, 16 Jan 2021 07:40:34 -0500 (EST) |
branch: feature/native-comp
commit 0a7ac0b5504e75275699a3d8d2d5d94bcfda8708
Merge: f1efac1 0732fc3
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into native-comp
---
.gitignore | 1 +
.gitlab-ci.yml | 196 ++++++++++++-------
admin/notes/elpa | 32 ++-
admin/nt/dist-build/README-scripts | 38 ++--
admin/nt/dist-build/README-windows-binaries | 49 ++---
admin/nt/dist-build/build-dep-zips.py | 188 +++++++++---------
admin/nt/dist-build/build-zips.sh | 90 +++------
admin/nt/dist-build/emacs.nsi | 31 +--
configure.ac | 21 +-
doc/emacs/mini.texi | 10 +-
doc/emacs/trouble.texi | 7 +
doc/lispref/commands.texi | 14 +-
doc/lispref/display.texi | 17 +-
doc/lispref/elisp.texi | 1 +
doc/lispref/errors.texi | 5 +
doc/lispref/minibuf.texi | 57 +++++-
doc/lispref/modes.texi | 2 +-
doc/misc/auth.texi | 12 ++
doc/misc/gnus.texi | 2 +-
doc/misc/tramp.texi | 28 ++-
doc/misc/trampver.texi | 2 +-
etc/NEWS | 52 ++++-
etc/PROBLEMS | 5 +
etc/w32-feature.el | 35 +++-
lisp/calc/calc.el | 10 +-
lisp/cedet/ede/auto.el | 24 ++-
lisp/comint.el | 26 +--
lisp/cus-face.el | 1 +
lisp/cus-start.el | 6 +-
lisp/custom.el | 13 +-
lisp/dired-x.el | 2 +-
lisp/emacs-lisp/cl-generic.el | 26 +--
lisp/emacs-lisp/cl-macs.el | 123 +++++++++++-
lisp/emacs-lisp/eieio-base.el | 135 +++++++------
lisp/emacs-lisp/lisp-mode.el | 6 +-
lisp/emacs-lisp/macroexp.el | 29 +++
lisp/emacs-lisp/pcase.el | 27 +--
lisp/emacs-lisp/shortdoc.el | 13 +-
lisp/erc/erc-services.el | 56 ++++--
lisp/foldout.el | 2 +-
lisp/frame.el | 8 +-
lisp/gnus/gnus-search.el | 11 +-
lisp/gnus/gnus-win.el | 1 -
lisp/gnus/message.el | 12 +-
lisp/gnus/mm-decode.el | 19 +-
lisp/gnus/nnmaildir.el | 3 +-
lisp/help-fns.el | 4 +-
lisp/help-mode.el | 3 +-
lisp/info.el | 2 +-
lisp/isearch.el | 61 +++---
lisp/minibuffer.el | 8 +-
lisp/mouse-drag.el | 4 +-
lisp/mouse.el | 2 +-
lisp/net/nsm.el | 2 +-
lisp/net/tramp-adb.el | 6 +-
lisp/net/tramp-sh.el | 162 +++++++--------
lisp/net/tramp.el | 24 ++-
lisp/net/trampver.el | 6 +-
lisp/pixel-scroll.el | 12 +-
lisp/progmodes/flymake.el | 7 +-
lisp/progmodes/project.el | 19 +-
lisp/progmodes/prolog.el | 6 +-
lisp/progmodes/python.el | 6 +-
lisp/progmodes/xref.el | 15 +-
lisp/ruler-mode.el | 4 +-
lisp/shell.el | 1 +
lisp/simple.el | 34 +++-
lisp/startup.el | 37 ++--
lisp/strokes.el | 23 +--
lisp/subr.el | 112 ++++++++++-
lisp/textmodes/artist.el | 6 +-
lisp/textmodes/fill.el | 11 +-
lisp/textmodes/reftex-vars.el | 18 +-
lisp/vc/ediff-wind.el | 5 +-
lisp/vc/ediff.el | 2 +-
lisp/wid-edit.el | 14 +-
lisp/window.el | 13 +-
src/buffer.c | 2 +-
src/callproc.c | 33 ++--
src/data.c | 3 +
src/dispnew.c | 16 +-
src/emacs.c | 4 +-
src/eval.c | 26 +++
src/fns.c | 85 ++++++++
src/keymap.c | 35 ----
src/lisp.h | 8 +-
src/lread.c | 29 ++-
src/minibuf.c | 211 +++++++++++++++++---
src/pdumper.c | 2 +-
src/process.c | 13 +-
src/sysdep.c | 217 +++++++++++++++++++++
src/w32term.c | 3 +-
src/window.c | 5 +-
src/window.h | 4 -
src/xdisp.c | 13 +-
src/xfaces.c | 8 +-
test/Makefile.in | 6 +
test/README | 6 +
test/file-organization.org | 5 +
test/infra/Dockerfile.emba | 71 +++++++
test/lisp/calendar/lunar-tests.el | 38 ++--
test/lisp/calendar/solar-tests.el | 4 +-
test/lisp/cedet/semantic-utest.el | 6 +-
test/lisp/cedet/srecode-utest-getset.el | 1 -
test/lisp/cedet/srecode-utest-template.el | 6 +-
test/lisp/emacs-lisp/cl-macs-tests.el | 23 +++
test/lisp/emacs-lisp/timer-tests.el | 4 +-
.../gnus/mm-decode-resources/win1252-multipart.bin | 44 +++++
test/lisp/gnus/mm-decode-tests.el | 35 ++--
test/lisp/help-mode-tests.el | 21 +-
test/lisp/help-tests.el | 4 +-
test/lisp/net/nsm-tests.el | 8 +-
test/lisp/net/socks-tests.el | 103 ++++++++++
test/lisp/net/tramp-tests.el | 197 ++++++++++++-------
test/lisp/progmodes/tcl-tests.el | 14 +-
test/lisp/subr-tests.el | 20 ++
test/lisp/textmodes/fill-tests.el | 31 +++
test/src/decompress-tests.el | 20 +-
test/src/fns-tests.el | 58 ++++++
test/src/lread-tests.el | 6 +
test/src/minibuf-tests.el | 15 ++
test/src/process-tests.el | 26 ++-
test/src/xdisp-tests.el | 30 +++
test/src/xml-tests.el | 14 +-
124 files changed, 2562 insertions(+), 1048 deletions(-)
diff --git a/.gitignore b/.gitignore
index 4c7c1ad..63fa420 100644
--- a/.gitignore
+++ b/.gitignore
@@ -299,3 +299,4 @@ nt/emacs.rc
nt/emacsclient.rc
src/gdb.ini
/var/
+src/fingerprint.c
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index bd012bf..1be92cf 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -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
-stages:
- - test
+.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-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}
+.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:
- - 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
+ - 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:
+ - fast
+ - normal
+ - slow
+
+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
diff --git a/admin/notes/elpa b/admin/notes/elpa
index ea6c132..1e9e7a9 100644
--- a/admin/notes/elpa
+++ b/admin/notes/elpa
@@ -5,17 +5,31 @@ repository named "elpa", hosted on Savannah. To check it out:
git clone git://git.sv.gnu.org/emacs/elpa
cd elpa
- git remote set-url --push origin git+ssh://git.sv.gnu.org/srv/git/emacs/elpa
- [create task branch for edits, etc.]
+ make setup
-Changes to this branch propagate to elpa.gnu.org via a "deployment" script run
-daily. This script (which is kept in elpa/admin/update-archive.sh) generates
-the content visible at https://elpa.gnu.org/packages.
+That leaves the elpa/packages directory empty; you must check out the
+ones you want.
-A new package is released as soon as the "version number" of that package is
-changed. So you can use 'elpa' to work on a package without fear of releasing
-those changes prematurely. And once the code is ready, just bump the
-version number to make a new release of the package.
+If you wish to check out all the packages into the packages directory,
+you can run the command:
+
+ make worktrees
+
+You can check out a specific package <pkgname> into the packages
+directory with:
+
+ make packages/<pkgname>
+
+
+Changes to this repository propagate to elpa.gnu.org via a
+"deployment" script run daily. This script generates the content
+visible at https://elpa.gnu.org/packages.
+
+A new package is released as soon as the "version number" of that
+package is changed. So you can use 'elpa' to work on a package
+without fear of releasing those changes prematurely. And once the
+code is ready, just bump the version number to make a new release of
+the package.
It is easy to use the elpa branch to deploy a "local" copy of the
package archive. For details, see the README file in the elpa branch.
diff --git a/admin/nt/dist-build/README-scripts
b/admin/nt/dist-build/README-scripts
index 4c3554e..f27bcd3 100644
--- a/admin/nt/dist-build/README-scripts
+++ b/admin/nt/dist-build/README-scripts
@@ -33,26 +33,21 @@ build-zips.sh file will create this for you.
A location for the dependencies. This needs to contain two zip files
with the dependencies. build-dep-zips.py will create these files for you.
-~/emacs-build/deps/libXpm/i686
-~/emacs-build/deps/libXpm/x86_64
+~/emacs-build/deps/libXpm
Contain libXpm-noX4.dll. This file is used to load images for the
splash screen, menu items and so on. Emacs runs without it, but looks
-horrible. The x86_64 comes from msys2, while the i686 comes from
-ezwinports because it itself has no dependencies. These have to be
-placed manually (but probably never need updating).
+horrible. The files came original from msys2, and contains no
+dependencies. It has to be placed manually (but probably never
+need updating).
-
-~/emacs-build/build/$version/i686
-~/emacs-build/build/$version/x86_64
+~/emacs-build/build/$version
We build Emacs out-of-source here. This directory is created by
build-zips.sh. This directory can be freely deleted after zips have
been created
-
-~/emacs-build/install/$version/i686
-~/emacs-build/install/$version/x86_64
+~/emacs-build/install/$version
We install Emacs here. This directory is created by build-zips.sh.
This directory can and *should* be deleted after zips have been
@@ -79,9 +74,9 @@ To do this:
Update msys to the latest version with `pacman -Syu`.
-Then run build-dep-zips.py, in the ~/emacs-build/deps directory. Three
-zips will be created, containing the 64bit and 32bit dependencies, as
-well as the source for these.
+Then run build-dep-zips.py, in the ~/emacs-build/deps directory. Two
+zips will be created, containing the dependencies, as well as the
+source for these.
For emacs release or pre-test version:
@@ -105,12 +100,12 @@ To do this:
Update msys to the latest version with `pacman -Syu`.
-Then run build-dep-zips.py, in ~/emacs-build/deps directory. Three
-zips will be created, containing the 64bit and 32bit dependencies, as
-well as the source for these. These deps files contain the date of
-creation in their name. The deps file can be reused as desired, or a
-new version created. Where multiple deps files exist, the most
-recent will be used.
+Then run build-dep-zips.py, in ~/emacs-build/deps directory. Two zips
+will be created, containing the dependencies, as well as the source
+for these. These deps files contain the date of creation in their
+name. The deps file can be reused as desired, or a new version
+created. Where multiple deps files exist, the most recent will be
+used.
Now, run `build-zips.sh -s` to build a snapshot release.
@@ -134,4 +129,5 @@ For snapshots from another branch
Snapshots can be build from any other branch. There is rarely a need
to do this, except where some significant, wide-ranging feature is
being added on a feature branch. In this case, the branch can be
-given using `build-zips.sh -b pdumper -s` for example.
+given using `build-zips.sh -b pdumper -s` for example. Any "/"
+characters in the branch title are replaced.
diff --git a/admin/nt/dist-build/README-windows-binaries
b/admin/nt/dist-build/README-windows-binaries
index 001bdd7..b6f6e55 100644
--- a/admin/nt/dist-build/README-windows-binaries
+++ b/admin/nt/dist-build/README-windows-binaries
@@ -4,7 +4,7 @@ See the end of the file for license conditions.
Precompiled Distributions of
Emacs for Windows
- Jan 1, 2020
+ Jan 14, 2021
This directory contains precompiled distributions for GNU Emacs on
Windows
@@ -25,51 +25,33 @@ old binaries.
Windows Binaries
================
-Currently, we provide six different binary packages for Emacs, which
+Currently, we provide three different binary packages for Emacs, which
are:
-emacs-$VERSION-x86_64-installer.exe
+emacs-$VERSION-installer.exe
-Contains a 64-bit build of Emacs with dependencies as an installer
+Contains Emacs with dependencies as an installer
package. Mostly, this is the best one to install.
-emacs-$VERSION-x86_64.zip
+emacs-$VERSION.zip
-Contains a 64-bit build of Emacs with dependencies. This contains the
-same files as the installer but as a zip file which some users may
-prefer.
+Contains Emacs with dependencies. This contains the same files as the
+installer but as a zip file which some users may prefer.
-emacs-$VERSION-x86_64-no-deps.zip
+emacs-$VERSION-no-deps.zip
-Contains a 64-bit build of Emacs without any dependencies. This may be
-useful if you wish to install where the dependencies are already
-available, or if you want the small possible Emacs.
-
-emacs-$VERSION-i686-installer.exe
-
-Contains a 32-bit build of Emacs with dependencies as an installer
-package. This is useful for running on a 32-bit machine.
-
-emacs-$VERSION-i686.zip
-
-Contains a 32-bit build of Emacs with dependencies.
-
-emacs-$VERSION-i686-no-deps.zip
-
-Contains a 32-bit build of Emacs without dependencies
+Contains Emacs without any dependencies. This may be useful if you
+wish to install where the dependencies are already available, or if
+you want the small possible Emacs.
In addition, we provide the following files which will not be useful
for most end-users.
-emacs-$VERSION-x86_64-deps.zip
+emacs-$VERSION-deps.zip
The dependencies. Unzipping this file on top of
-emacs-$VERSION-x86_64-no-deps.zip should result in the same install as
-emacs-$VERSION-x86_64.zip.
-
-emacs-$VERSION-i686-deps.zip
-
-The 32-bit version of the dependencies.
+emacs-$VERSION-no-deps.zip should result in the same install as
+emacs-$VERSION.zip.
emacs-$VERSION-deps-mingw-w64-src.zip
@@ -85,7 +67,8 @@ Snapshots
We also distribute "snapshots" of Emacs built at points throughout the
development cycle, for those interested in following this cycle. They
-are not recommended for normal users.
+are not recommended for normal users; however, they are useful for
+people who want to report bugs against the current master.
The files follow the same naming convention, but also include a date
(and sometimes information about their branch). The Emacs source at
diff --git a/admin/nt/dist-build/build-dep-zips.py
b/admin/nt/dist-build/build-dep-zips.py
index 47185db..19168e7 100755
--- a/admin/nt/dist-build/build-dep-zips.py
+++ b/admin/nt/dist-build/build-dep-zips.py
@@ -17,7 +17,6 @@
## You should have received a copy of the GNU General Public License
## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
import argparse
-import multiprocessing as mp
import os
import shutil
import re
@@ -40,21 +39,84 @@ mingw-w64-x86_64-libtiff
mingw-w64-x86_64-libxml2
mingw-w64-x86_64-xpm-nox'''.split()
+DLL_REQ='''libgif
+libgnutls
+libharfbuzz
+libjansson
+liblcms2
+libturbojpeg
+libpng
+librsvg
+libtiff
+libxml
+libXpm'''.split()
+
## Options
DRY_RUN=False
+
+def check_output_maybe(*args,**kwargs):
+ if(DRY_RUN):
+ print("Calling: {}{}".format(args,kwargs))
+ else:
+ return check_output(*args,**kwargs)
+
+## DLL Capture
+def gather_deps():
+
+ os.mkdir("x86_64")
+ os.chdir("x86_64")
+
+ for dep in full_dll_dependency():
+ check_output_maybe(["cp /mingw64/bin/{}*.dll .".format(dep)],
+ shell=True)
+
+ print("Zipping")
+ check_output_maybe("zip -9r ../emacs-{}-{}deps.zip *"
+ .format(EMACS_MAJOR_VERSION, DATE),
+ shell=True)
+ os.chdir("../")
+
+## Return all Emacs dependencies
+def full_dll_dependency():
+ deps = [dll_dependency(dep) for dep in DLL_REQ]
+ return set(sum(deps, []) + DLL_REQ)
+
+## Dependencies for a given DLL
+def dll_dependency(dll):
+ output = check_output(["/mingw64/bin/ntldd", "--recursive",
+ "/mingw64/bin/{}*.dll".format(dll)]).decode("utf-8")
+ ## munge output
+ return ntldd_munge(output)
+
+def ntldd_munge(out):
+ deps = out.splitlines()
+ rtn = []
+ for dep in deps:
+ ## Output looks something like this
+
+ ## KERNEL32.dll => C:\Windows\SYSTEM32\KERNEL32.dll
(0x0000000002a30000)
+ ## libwinpthread-1.dll => C:\msys64\mingw64\bin\libwinpthread-1.dll
(0x0000000000090000)
+
+ ## if it's the former, we want it, if its the later we don't
+ splt = dep.split()
+ if len(splt) > 2 and "msys64" in splt[2]:
+ print("Adding dep", splt[0])
+ rtn.append(splt[0].split(".")[0])
+
+ return rtn
+
+#### Source Capture
+
## Packages to fiddle with
## Source for gcc-libs is part of gcc
SKIP_SRC_PKGS=["mingw-w64-gcc-libs"]
-SKIP_DEP_PKGS=["mingw-w64-x86_64-glib2"]
+SKIP_DEP_PKGS=["mingw-w64-glib2"]
MUNGE_SRC_PKGS={"mingw-w64-libwinpthread-git":"mingw-w64-winpthreads-git"}
MUNGE_DEP_PKGS={
- "mingw-w64-i686-libwinpthread":"mingw-w64-i686-libwinpthread-git",
"mingw-w64-x86_64-libwinpthread":"mingw-w64-x86_64-libwinpthread-git",
-
"mingw-w64-x86_64-libtre": "mingw-w64-x86_64-libtre-git",
- "mingw-w64-i686-libtre": "mingw-w64-i686-libtre-git"
}
## Currently no packages seem to require this!
@@ -62,12 +124,6 @@ ARCH_PKGS=[]
SRC_REPO="https://sourceforge.net/projects/msys2/files/REPOS/MINGW/Sources";
-def check_output_maybe(*args,**kwargs):
- if(DRY_RUN):
- print("Calling: {}{}".format(args,kwargs))
- else:
- return check_output(*args,**kwargs)
-
def immediate_deps(pkg):
package_info = check_output(["pacman", "-Si",
pkg]).decode("utf-8").split("\n")
@@ -87,92 +143,50 @@ def immediate_deps(pkg):
return dependencies
+## Extract all the msys2 packages that are dependencies of our direct
dependencies
def extract_deps():
print( "Extracting deps" )
# Get a list of all dependencies needed for packages mentioned above.
pkgs = PKG_REQ[:]
- print("Initial pkgs", pkgs)
n = 0
while n < len(pkgs):
subdeps = immediate_deps(pkgs[n])
for p in subdeps:
if not (p in pkgs or p in SKIP_DEP_PKGS):
- print("adding", p)
pkgs.append(p)
n = n + 1
return sorted(pkgs)
-def gather_deps(deps, arch, directory):
-
- os.mkdir(arch)
- os.chdir(arch)
-
- ## Replace the architecture with the correct one
- deps = [re.sub(r"x86_64",arch,x) for x in deps]
-
- ## find all files the transitive dependencies
- deps_files = check_output(
- ["pacman", "-Ql"] + deps
- ).decode("utf-8").split("\n")
-
- ## Produces output like
- ## mingw-w64-x86_64-zlib /mingw64/lib/libminizip.a
-
- ## drop the package name
- tmp = deps_files.copy()
- deps_files=[]
- for d in tmp:
- slt = d.split()
- if(not slt==[]):
- deps_files.append(slt[1])
-
- ## sort uniq
- deps_files = sorted(list(set(deps_files)))
- ## copy all files into local
- print("Copying dependencies: {}".format(arch))
- check_output_maybe(["rsync", "-R"] + deps_files + ["."])
-
- ## And package them up
- os.chdir(directory)
- print("Zipping: {}".format(arch))
- check_output_maybe("zip -9r ../../emacs-{}-{}{}-deps.zip *"
- .format(EMACS_MAJOR_VERSION, DATE, arch),
- shell=True)
- os.chdir("../../")
-
def download_source(tarball):
print("Acquiring {}...".format(tarball))
- if os.path.exists("../emacs-src-cache/{}".format(tarball)):
- print("Copying {} from local".format(tarball))
- shutil.copyfile("../emacs-src-cache/{}".format(tarball),
- "{}".format(tarball))
- else:
+ if not os.path.exists("../emacs-src-cache/{}".format(tarball)):
print("Downloading {}...".format(tarball))
check_output_maybe(
- "wget -a ../download.log -O {} {}/{}/download"
+ "wget -a ../download.log -O ../emacs-src-cache/{} {}/{}/download"
.format(tarball, SRC_REPO, tarball),
shell=True
)
print("Downloading {}... done".format(tarball))
-def gather_source(deps):
+ print("Copying {} from local".format(tarball))
+ shutil.copyfile("../emacs-src-cache/{}".format(tarball),
+ "{}".format(tarball))
- ## Source for gcc-libs is part of gcc
- ## Source for libwinpthread is in libwinpthreads
- ## mpc, termcap, xpm -- has x86_64, and i686 versions
+## Fetch all the source code
+def gather_source(deps):
+
+ if not os.path.exists("emacs-src-cache"):
+ os.mkdir("emacs-src-cache")
- ## This needs to have been run first at the same time as the
- ## system was updated.
os.mkdir("emacs-src")
os.chdir("emacs-src")
- to_download = []
for pkg in deps:
pkg_name_and_version= \
check_output(["pacman","-Q", pkg]).decode("utf-8").strip()
@@ -183,31 +197,18 @@ def gather_source(deps):
pkg_name=pkg_name_components[0]
pkg_version=pkg_name_components[1]
- ## make a simple name to make lookup easier
- simple_pkg_name = re.sub(r"x86_64-","",pkg_name)
+ ## source pkgs don't have an architecture in them
+ pkg_name = re.sub(r"x86_64-","",pkg_name)
- if(simple_pkg_name in SKIP_SRC_PKGS):
+ if(pkg_name in SKIP_SRC_PKGS):
continue
- ## Some packages have different source files for different
- ## architectures. For these we need two downloads.
- if(simple_pkg_name in ARCH_PKGS):
- downloads = [pkg_name,
- re.sub(r"x86_64","i686",pkg_name)]
- else:
- downloads = [simple_pkg_name]
-
- for d in downloads:
- ## Switch names if necessary
- d = MUNGE_SRC_PKGS.get(d,d)
+ ## Switch names if necessary
+ pkg_name = MUNGE_SRC_PKGS.get(pkg_name,pkg_name)
- tarball = "{}-{}.src.tar.gz".format(d,pkg_version)
+ tarball = "{}-{}.src.tar.gz".format(pkg_name,pkg_version)
- to_download.append(tarball)
-
- ## Download in parallel or it is just too slow
- p = mp.Pool(16)
- p.map(download_source,to_download)
+ download_source(tarball)
print("Zipping")
check_output_maybe("zip -9 ../emacs-{}-{}deps-mingw-w64-src.zip *"
@@ -220,7 +221,6 @@ def gather_source(deps):
def clean():
print("Cleaning")
os.path.isdir("emacs-src") and shutil.rmtree("emacs-src")
- os.path.isdir("i686") and shutil.rmtree("i686")
os.path.isdir("x86_64") and shutil.rmtree("x86_64")
os.path.isfile("download.log") and os.remove("download.log")
@@ -234,12 +234,6 @@ parser = argparse.ArgumentParser()
parser.add_argument("-s", help="snapshot build",
action="store_true")
-parser.add_argument("-t", help="32 bit deps only",
- action="store_true")
-
-parser.add_argument("-f", help="64 bit deps only",
- action="store_true")
-
parser.add_argument("-r", help="source code only",
action="store_true")
@@ -253,9 +247,9 @@ parser.add_argument("-l", help="list dependencies only",
action="store_true")
args = parser.parse_args()
-do_all=not (args.c or args.r or args.f or args.t)
+do_all=not (args.c or args.r)
+
-deps=extract_deps()
DRY_RUN=args.d
@@ -269,13 +263,11 @@ if args.s:
else:
DATE=""
-if( do_all or args.t ):
- gather_deps(deps,"i686","mingw32")
-
-if( do_all or args.f ):
- gather_deps(deps,"x86_64","mingw64")
+if( do_all):
+ gather_deps()
if( do_all or args.r ):
+ deps=extract_deps()
gather_source(deps)
if( args.c ):
diff --git a/admin/nt/dist-build/build-zips.sh
b/admin/nt/dist-build/build-zips.sh
index 4a9a7b5..7bc6ea6 100755
--- a/admin/nt/dist-build/build-zips.sh
+++ b/admin/nt/dist-build/build-zips.sh
@@ -29,72 +29,62 @@ function git_up {
}
function build_zip {
-
- ARCH=$1
- PKG=$2
- HOST=$3
-
- echo [build] Building Emacs-$VERSION for $ARCH
- if [ $ARCH == "i686" ]
- then
- PATH=/mingw32/bin:$PATH
- MSYSTEM=MINGW32
- fi
+ echo [build] Building Emacs-$VERSION
## Clean the install location because we use it twice
- rm -rf $HOME/emacs-build/install/emacs-$VERSION/$ARCH
- mkdir --parents $HOME/emacs-build/build/emacs-$VERSION/$ARCH
- cd $HOME/emacs-build/build/emacs-$VERSION/$ARCH
+ rm -rf $HOME/emacs-build/install/emacs-$VERSION
+ mkdir --parents $HOME/emacs-build/build/emacs-$VERSION
+ cd $HOME/emacs-build/build/emacs-$VERSION
+
+ ## Do we need this or is it the default?
+ export PKG_CONFIG_PATH=/mingw64/lib/pkgconfig
- export PKG_CONFIG_PATH=$PKG
## Running configure forces a rebuild of the C core which takes
## time that is not always needed, so do not do it unless we have
## to.
if [ ! -f Makefile ] || (($CONFIG))
then
- echo [build] Configuring Emacs $ARCH
+ echo [build] Configuring Emacs
$REPO_DIR/$BRANCH/configure \
--without-dbus \
- --host=$HOST --without-compress-install \
+ --without-compress-install \
$CACHE \
CFLAGS="$CFLAGS"
fi
make -j 4 $INSTALL_TARGET \
- prefix=$HOME/emacs-build/install/emacs-$VERSION/$ARCH
- cd $HOME/emacs-build/install/emacs-$VERSION/$ARCH
- cp $HOME/emacs-build/deps/libXpm/$ARCH/libXpm-noX4.dll bin
- zip -r -9 emacs-$OF_VERSION-$ARCH-no-deps.zip *
- mv emacs-$OF_VERSION-$ARCH-no-deps.zip $HOME/emacs-upload
- rm bin/libXpm-noX4.dll
+ prefix=$HOME/emacs-build/install/emacs-$VERSION
+ cd $HOME/emacs-build/install/emacs-$VERSION
+ zip -r -9 emacs-$OF_VERSION-no-deps.zip *
+ mv emacs-$OF_VERSION-no-deps.zip $HOME/emacs-upload
if [ -z $SNAPSHOT ];
then
- DEPS_FILE=$HOME/emacs-build/deps/emacs-$MAJOR_VERSION-$ARCH-deps.zip
+ DEPS_FILE=$HOME/emacs-build/deps/emacs-$MAJOR_VERSION-deps.zip
else
## Pick the most recent snapshot whatever that is
- DEPS_FILE=`ls
$HOME/emacs-build/deps/emacs-$MAJOR_VERSION-*-$ARCH-deps.zip | tail -n 1`
+ DEPS_FILE=`ls $HOME/emacs-build/deps/emacs-$MAJOR_VERSION-*-deps.zip |
tail -n 1`
fi
echo [build] Using $DEPS_FILE
- unzip $DEPS_FILE
+ unzip -d bin $DEPS_FILE
- zip -r -9 emacs-$OF_VERSION-$ARCH.zip *
- mv emacs-$OF_VERSION-$ARCH.zip ~/emacs-upload
+ zip -r -9 emacs-$OF_VERSION.zip *
+ mv emacs-$OF_VERSION.zip ~/emacs-upload
}
function build_installer {
- ARCH=$1
- cd $HOME/emacs-build/install/emacs-$VERSION
+ cd $HOME/emacs-build/install/
echo [build] Calling makensis in `pwd`
cp $REPO_DIR/$BRANCH/admin/nt/dist-build/emacs.nsi .
makensis -v4 \
- -DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \
+ -DEMACS_VERSION=$ACTUAL_VERSION \
+ -DVERSION_BRANCH=$VERSION \
-DOUT_VERSION=$OF_VERSION emacs.nsi
rm emacs.nsi
- mv emacs-$OF_VERSION-$ARCH-installer.exe ~/emacs-upload
+ mv emacs-$OF_VERSION-installer.exe ~/emacs-upload
}
set -o errexit
@@ -103,7 +93,6 @@ SNAPSHOT=
CACHE=
BUILD=1
-BUILD_32=1
BUILD_64=1
GIT_UP=0
CONFIG=1
@@ -114,19 +103,8 @@ INSTALL_TARGET="install-strip"
REPO_DIR=$HOME/emacs-build/git/
-while getopts "36gb:hnsiV:" opt; do
+while getopts "gb:hnsiV:" opt; do
case $opt in
- 3)
- BUILD_32=1
- BUILD_64=0
- GIT_UP=0
- ;;
- 6)
- BUILD_32=0
- BUILD_64=1
- GIT_UP=0
- ;;
-
g)
BUILD_32=0
BUILD_64=0
@@ -152,10 +130,11 @@ while getopts "36gb:hnsiV:" opt; do
;;
h)
echo "build-zips.sh"
- echo " -3 32 bit build only"
- echo " -6 64 bit build only"
+ echo " -b args -- build args branch"
echo " -g git update and worktree only"
echo " -i build installer only"
+ echo " -n do not configure"
+ echo " -s snaphot build"
exit 0
;;
\?)
@@ -208,7 +187,7 @@ then
else
BRANCH=$REQUIRED_BRANCH
echo [build] Building from Branch $BRANCH
- VERSION=$VERSION-$BRANCH
+ VERSION=$VERSION-${BRANCH/\//_}
OF_VERSION="$VERSION-`date +%Y-%m-%d`"
## Use snapshot dependencies
SNAPSHOT=1
@@ -225,18 +204,7 @@ if (($BUILD_64))
then
if (($BUILD))
then
- build_zip x86_64 /mingw64/lib/pkgconfig x86_64-w64-mingw32
- fi
- build_installer x86_64
-fi
-
-## Do the 64 bit build first, because we reset some environment
-## variables during the 32 bit which will break the build.
-if (($BUILD_32))
-then
- if (($BUILD))
- then
- build_zip i686 /mingw32/lib/pkgconfig i686-w64-mingw32
+ build_zip
fi
- build_installer i686
+ build_installer
fi
diff --git a/admin/nt/dist-build/emacs.nsi b/admin/nt/dist-build/emacs.nsi
index dce8f3d..557bb10 100644
--- a/admin/nt/dist-build/emacs.nsi
+++ b/admin/nt/dist-build/emacs.nsi
@@ -2,7 +2,7 @@
!include LogicLib.nsh
!include x64.nsh
-Outfile "emacs-${OUT_VERSION}-${ARCH}-installer.exe"
+Outfile "emacs-${OUT_VERSION}-installer.exe"
SetCompressor /solid lzma
@@ -14,15 +14,15 @@ Var StartMenuFolder
!define MUI_WELCOMEPAGE_TITLE_3LINES
!define MUI_WELCOMEPAGE_TEXT "Welcome to Emacs -- the editor of a lifetime."
-!define MUI_WELCOMEFINISHPAGE_BITMAP
"${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\splash.bmp"
-!define MUI_ICON
"${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
-!define MUI_UNICON
"${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
+!define MUI_WELCOMEFINISHPAGE_BITMAP
"emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\etc\images\splash.bmp"
+!define MUI_ICON
"emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
+!define MUI_UNICON
"emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
!insertmacro MUI_PAGE_WELCOME
!define MUI_LICENSEPAGE_TEXT_TOP "The GNU General Public License"
-!insertmacro MUI_PAGE_LICENSE
"${ARCH}\share\emacs\${EMACS_VERSION}\lisp\COPYING"
+!insertmacro MUI_PAGE_LICENSE
"emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\lisp\COPYING"
!insertmacro MUI_PAGE_DIRECTORY
!insertmacro MUI_PAGE_INSTFILES
@@ -36,19 +36,7 @@ Var StartMenuFolder
Name Emacs-${EMACS_VERSION}
function .onInit
- ${If} ${RunningX64}
- ${If} ${ARCH} == "x86_64"
- StrCpy $INSTDIR "$PROGRAMFILES64\Emacs"
- ${Else}
- StrCpy $INSTDIR "$PROGRAMFILES32\Emacs"
- ${Endif}
- ${Else}
- ${If} ${ARCH} == "x86_64"
- Quit
- ${Else}
- StrCpy $INSTDIR "$PROGRAMFILES\Emacs"
- ${Endif}
- ${EndIf}
+ StrCpy $INSTDIR "$PROGRAMFILES64\Emacs"
functionend
@@ -56,7 +44,8 @@ Section
SetOutPath $INSTDIR
- File /r ${ARCH}
+ File /r emacs-${VERSION_BRANCH}
+
# define uninstaller name
WriteUninstaller $INSTDIR\Uninstall.exe
@@ -66,7 +55,7 @@ Section
CreateShortcut "$SMPROGRAMS\$StartMenuFolder\Uninstall.lnk"
"$INSTDIR\Uninstall.exe"
!insertmacro MUI_STARTMENU_WRITE_END
- CreateShortCut "$SMPROGRAMS\$StartMenuFolder\Emacs.lnk"
"$INSTDIR\${ARCH}\bin\runemacs.exe"
+ CreateShortCut "$SMPROGRAMS\$StartMenuFolder\Emacs.lnk"
"$INSTDIR\emacs-${VERSION_BRANCH}\bin\runemacs.exe"
SectionEnd
@@ -78,7 +67,7 @@ Section "Uninstall"
Delete "$INSTDIR\Uninstall.exe"
# now delete installed directory
- RMDir /r "$INSTDIR\${ARCH}"
+ RMDir /r "$INSTDIR"
RMDir "$INSTDIR"
!insertmacro MUI_STARTMENU_GETFOLDER Application $StartMenuFolder
diff --git a/configure.ac b/configure.ac
index 2a4a373..1bff666 100644
--- a/configure.ac
+++ b/configure.ac
@@ -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}
diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index c7c8fb3..f81e64b 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -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
diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi
index 4da3d4a..9a63881 100644
--- a/doc/emacs/trouble.texi
+++ b/doc/emacs/trouble.texi
@@ -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
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 6c68f70..3a2c7d0 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -2696,9 +2696,11 @@ from the terminal---not counting those generated by
keyboard macros.
@code{read-event}, @code{read-char}, and @code{read-char-exclusive} do
not perform the translations described in @ref{Translation Keymaps}.
If you wish to read a single key taking these translations into
-account, use the function @code{read-key}:
+account (for example, to read @ref{Function Keys} in a terminal or
+@ref{Mouse Events} from @code{xterm-mouse-mode}), use the function
+@code{read-key}:
-@defun read-key &optional prompt
+@defun read-key &optional prompt disable-fallbacks
This function reads a single key. It is intermediate between
@code{read-key-sequence} and @code{read-event}. Unlike the former, it
reads a single key, not a key sequence. Unlike the latter, it does
@@ -2708,6 +2710,14 @@ and @code{key-translation-map} (@pxref{Translation
Keymaps}).
The argument @var{prompt} is either a string to be displayed in the
echo area as a prompt, or @code{nil}, meaning not to display a prompt.
+
+If argument @var{disable-fallbacks} is non-@code{nil} then the usual
+fallback logic for unbound keys in @code{read-key-sequence} is not
+applied. This means that mouse button-down and multi-click events
+will not be discarded and @code{local-function-key-map} and
+@code{key-translation-map} will not get applied. If @code{nil} or
+unspecified, the only fallback disabled is downcasing of the last
+event.
@end defun
@defun read-char-choice prompt chars &optional inhibit-quit
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index b149a66..93e935c 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -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
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index fa548b5..12255d1 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -739,6 +739,7 @@ Minibuffers
* Minibuffer Windows:: Operating on the special minibuffer windows.
* Minibuffer Contents:: How such commands access the minibuffer text.
* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
+* Inhibiting Interaction:: Running Emacs when no interaction is possible.
* Minibuffer Misc:: Various customization hooks and variables.
Completion
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index 9ec1271..fb393b9 100644
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -230,6 +230,11 @@ The message is @samp{Wrong type argument}. @xref{Type
Predicates}.
@item unknown-image-type
The message is @samp{Cannot determine image type}. @xref{Images}.
+
+@item inhibited-interaction
+The message is @samp{User interaction while inhibited}. This error is
+signalled when @code{inhibit-interaction} is non-@code{nil} and a user
+interaction function (like @code{read-from-minibuffer}) is called.
@end table
@ignore The following seem to be unused now.
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index f0036f0..0ce17ed 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -32,6 +32,7 @@ argument.
* Minibuffer Windows:: Operating on the special minibuffer windows.
* Minibuffer Contents:: How such commands access the minibuffer text.
* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
+* Inhibiting Interaction:: Running Emacs when no interaction is possible.
* Minibuffer Misc:: Various customization hooks and variables.
@end menu
@@ -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
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 9d38fe6..abc1254 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -4241,7 +4241,7 @@ Here is an example of an indentation function:
(`(:elem . basic) sample-indent-basic)
(`(,_ . ",") (smie-rule-separator kind))
(`(:after . ":=") sample-indent-basic)
- (`(:before . ,(or `"begin" `"(" `"@{")))
+ (`(:before . ,(or `"begin" `"(" `"@{"))
(if (smie-rule-hanging-p) (smie-rule-parent)))
(`(:before . "if")
(and (not (smie-rule-bolp)) (smie-rule-prev-p "else")
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index d810f15..034004d 100644
--- a/doc/misc/auth.texi
+++ b/doc/misc/auth.texi
@@ -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:
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 797315d..5a79cbc 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -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
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 358f6fc..2c4b792 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -443,7 +443,7 @@ are optional, in case of a missing part a default value is
assumed.
The default value for an empty local file name part is the remote
user's home directory. The shortest remote file name is
@file{@trampfn{-,,}}, therefore. The @samp{-} notation for the
-default host is used for syntactical reasons, @ref{Default Host}.
+default method is used for syntactical reasons, @ref{Default Method}.
The @code{method} part describes the connection method used to reach
the remote host, see below.
@@ -1622,6 +1622,7 @@ support this command.
@subsection Tunneling with ssh
+@vindex ProxyCommand@r{, ssh option}
With @command{ssh}, you could use the @option{ProxyCommand} entry in
@file{~/.ssh/config}:
@@ -2056,9 +2057,11 @@ default value is @t{"/data/local/tmp"} for the
@option{adb} method,
@item @t{"direct-async-process"}
When this property is non-@code{nil}, an alternative, more performant
-implementation of @code{make-process} and
-@code{start-file-process} is applied. @ref{Improving performance of
-asynchronous remote processes} for a discussion of constraints.
+implementation of @code{make-process} and @code{start-file-process} is
+applied. The connection method must also be marked with a
+non-@code{nil} @code{tramp-direct-async} parameter in
+@code{tramp-methods}. @ref{Improving performance of asynchronous
+remote processes} for a discussion of constraints.
@item @t{"posix"}
@@ -2214,6 +2217,11 @@ overwrite this, you might apply
This uses also the settings in @code{tramp-sh-extra-args}.
+@vindex RemoteCommand@r{, ssh option}
+@strong{Note}: If you use an @option{ssh}-based method for connection,
+do @emph{not} set the @option{RemoteCommand} option in your
+@command{ssh} configuration, for example to @command{screen}.
+
@subsection Other remote shell setup hints
@cindex remote shell setup
@@ -3304,6 +3312,8 @@ whatever reason, then replace @code{(getenv "DISPLAY")}
with a
hard-coded, fixed name. Note that using @code{:0} for X11 display name
here will not work as expected.
+@vindex ForwardX11@r{, ssh option}
+@vindex ForwardX11Trusted@r{, ssh option}
An alternate approach is specify @option{ForwardX11 yes} or
@option{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local
host.
@@ -3566,6 +3576,7 @@ Furthermore, this approach has the following limitations:
It works only for connection methods defined in @file{tramp-sh.el} and
@file{tramp-adb.el}.
+@vindex ControlMaster@r{, ssh option}
@item
It does not support interactive user authentication. With
@option{ssh}-based methods, this can be avoided by using a password
@@ -4269,6 +4280,7 @@ In order to disable those optimizations, set user option
@item
@value{tramp} does not recognize if a @command{ssh} session hangs
+@vindex ServerAliveInterval@r{, ssh option}
@command{ssh} sessions on the local host hang when the network is
down. @value{tramp} cannot safely detect such hangs. The network
configuration for @command{ssh} can be configured to kill such hangs
@@ -4285,6 +4297,8 @@ Host *
@item
@value{tramp} does not use default @command{ssh} @option{ControlPath}
+@vindex ControlPath@r{, ssh option}
+@vindex ControlPersist@r{, ssh option}
@value{tramp} overwrites @option{ControlPath} settings when initiating
@command{ssh} sessions. @value{tramp} does this to fend off a stall
if a master session opened outside the Emacs session is no longer
@@ -4306,8 +4320,8 @@ which allows you to set the @option{ControlPath} provided
the variable
@end group
@end lisp
-Note how "%r", "%h" and "%p" must be encoded as "%%r", "%%h" and
-"%%p".
+Note how @samp{%r}, @samp{%h} and @samp{%p} must be encoded as
+@samp{%%r}, @samp{%%h} and @samp{%%p}.
@vindex tramp-use-ssh-controlmaster-options
If the @file{~/.ssh/config} is configured appropriately for the above
@@ -4318,6 +4332,8 @@ this @code{nil} setting:
(customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
@end lisp
+@vindex ProxyCommand@r{, ssh option}
+@vindex ProxyJump@r{, ssh option}
This shall also be set to @code{nil} if you use the
@option{ProxyCommand} or @option{ProxyJump} options in your
@command{ssh} configuration.
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index 6970c46..827c477 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -8,7 +8,7 @@
@c In the Tramp GIT, the version numbers are auto-frobbed from
@c tramp.el, and the bug report address is auto-frobbed from
@c configure.ac.
-@set trampver 2.5.0
+@set trampver 2.5.1-pre
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 25.1
diff --git a/etc/NEWS b/etc/NEWS
index 6d7aa50..19ad350 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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
@@ -1361,6 +1376,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.
+
++++
+*** 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.
+
+++
-*** 'add-to-ordered-list' can now take a test predicate.
+*** 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='.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 25e129b..15e34ea 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -746,6 +746,11 @@ versions of gnutls-cli, or use Emacs's built-in gnutls
support.
** Characters are displayed as empty boxes or with wrong font under X.
+*** This may be due to your local fontconfig customization.
+Try removing or moving aside "$XDG_CONFIG_HOME/fontconfig/conf.d" and
+"$XDG_CONFIG_HOME/fontconfig/fonts.conf"
+($XDG_CONFIG_HOME is treated as "~/.config" if not set)
+
*** This can occur when two different versions of FontConfig are used.
For example, XFree86 4.3.0 has one version and Gnome usually comes
with a newer version. Emacs compiled with Gtk+ will then use the
diff --git a/etc/w32-feature.el b/etc/w32-feature.el
index c5f2cd5..364e934 100644
--- a/etc/w32-feature.el
+++ b/etc/w32-feature.el
@@ -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
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 68ae468..d684c7b 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1095,15 +1095,7 @@ Used by `calc-user-invocation'.")
(ignore-errors
(define-key calc-digit-map x 'calcDigit-delchar)
(define-key calc-mode-map x 'calc-pop)
- (define-key calc-mode-map
- (if (and (vectorp x) (featurep 'xemacs))
- (if (= (length x) 1)
- (vector (if (consp (aref x 0))
- (cons 'meta (aref x 0))
- (list 'meta (aref x 0))))
- "\e\C-d")
- (vconcat "\e" x))
- 'calc-pop-above)))
+ (define-key calc-mode-map (vconcat "\e" x) 'calc-pop-above)))
(if calc-scan-for-dels
(append (where-is-internal 'delete-forward-char global-map)
'("\C-d"))
diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el
index ee75e29..e1417d7 100644
--- a/lisp/cedet/ede/auto.el
+++ b/lisp/cedet/ede/auto.el
@@ -64,24 +64,22 @@ location is varied dependent on other complex criteria,
this class
can be used to define that match without loading the specific project
into memory.")
+(cl-defmethod ede-calc-fromconfig ((dirmatch ede-project-autoload-dirmatch))
+ "Calculate the value of :fromconfig from DIRMATCH."
+ (let* ((fc (oref dirmatch fromconfig))
+ (found (cond ((stringp fc) fc)
+ ((functionp fc) (funcall fc))
+ (t (error "Unknown dirmatch object match style.")))))
+ (expand-file-name found)
+ ))
+
(cl-defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
"Return non-nil if the tool DIRMATCH might match is installed on the system."
- (let ((fc (oref dirmatch fromconfig)))
-
- (cond
- ;; If the thing to match is stored in a config file.
- ((stringp fc)
- (file-exists-p fc))
-
- ;; Add new types of dirmatches here.
-
- ;; Error for weird stuff
- (t (error "Unknown dirmatch type.")))))
-
+ (file-exists-p (ede-calc-fromconfig dirmatch)))
(cl-defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
"Does DIRMATCH match the filename FILE."
- (let ((fc (oref dirmatch fromconfig)))
+ (let ((fc (ede-calc-fromconfig dirmatch)))
(cond
;; If the thing to match is stored in a config file.
diff --git a/lisp/comint.el b/lisp/comint.el
index 2e683a7..53153af 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -979,6 +979,7 @@ See also `comint-input-ignoredups' and
`comint-write-input-ring'."
(ring (make-ring ring-size))
;; Use possibly buffer-local values of these variables.
(ring-separator comint-input-ring-separator)
+ (ring-file-prefix comint-input-ring-file-prefix)
(history-ignore comint-input-history-ignore)
(ignoredups comint-input-ignoredups))
(with-temp-buffer
@@ -990,24 +991,15 @@ See also `comint-input-ignoredups' and
`comint-write-input-ring'."
(while (and (< count comint-input-ring-size)
(re-search-backward ring-separator nil t)
(setq end (match-beginning 0)))
- (setq start
- (if (re-search-backward ring-separator nil t)
- (progn
- (when (and comint-input-ring-file-prefix
- (looking-at
- comint-input-ring-file-prefix))
- ;; Skip zsh extended_history stamps
- (goto-char (match-end 0)))
- (match-end 0))
- (progn
- (goto-char (point-min))
- (when (and comint-input-ring-file-prefix
- (looking-at
- comint-input-ring-file-prefix))
- (goto-char (match-end 0)))
- (point))))
+ (goto-char (if (re-search-backward ring-separator nil t)
+ (match-end 0)
+ (point-min)))
+ (when (and ring-file-prefix
+ (looking-at ring-file-prefix))
+ ;; Skip zsh extended_history stamps
+ (goto-char (match-end 0)))
+ (setq start (point))
(setq history (buffer-substring start end))
- (goto-char start)
(when (and (not (string-match history-ignore history))
(or (null ignoredups)
(ring-empty-p ring)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 5dcb284..21fe89c 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -175,6 +175,7 @@
(choice :tag "Style"
(const :tag "Raised" released-button)
(const :tag "Sunken" pressed-button)
+ (const :tag "Flat" flat-button)
(const :tag "None" nil))))
;; filter to make value suitable for customize
(lambda (real-value)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 85dd14f..0293d34 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -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)
diff --git a/lisp/custom.el b/lisp/custom.el
index d9d0898..58ecd04 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -136,6 +136,9 @@ to include all of it." ; see eg
vc-sccs-search-project-dir
;; No longer true:
;; "See `send-mail-function' in sendmail.el for an example."
+ ;; Defvar it so as to mark it special, etc (bug#25770).
+ (internal--define-uninitialized-variable symbol)
+
;; Until the var is actually initialized, it is kept unbound.
;; This seemed to be at least as good as setting it to an arbitrary
;; value like nil (evaluating `value' is not an option because it
@@ -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
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 5a52ecc..aebffe3 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -1483,7 +1483,7 @@ a prefix argument, when it offers the filename near point
as a default."
;;; Internal functions.
;; Fixme: This should probably use `thing-at-point'. -- fx
-(define-obsolete-function-alias 'dired-filename-at-point
+(define-obsolete-function-alias 'dired-file-name-at-point
#'dired-x-guess-file-name-at-point "28.1")
(defun dired-x-guess-file-name-at-point ()
"Return the filename closest to point, expanded.
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 19dd54c..8e36dbe 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -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))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index ac7360b..fb43a0b 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -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))
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 4ba72ae..ec1077d 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -162,6 +162,59 @@ only one object ever exists."
old)))
+;;; Named object
+
+(defclass eieio-named ()
+ ((object-name :initarg :object-name :initform nil))
+ "Object with a name."
+ :abstract t)
+
+(cl-defmethod eieio-object-name-string ((obj eieio-named))
+ "Return a string which is OBJ's name."
+ (or (slot-value obj 'object-name)
+ (cl-call-next-method)))
+
+(cl-defgeneric eieio-object-set-name-string (obj name)
+ "Set the string which is OBJ's NAME."
+ (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ
\\='object-name) NAME) instead" "25.1"))
+ (cl-check-type name string)
+ (setf (gethash obj eieio--object-names) name))
+(define-obsolete-function-alias
+ 'object-set-name-string 'eieio-object-set-name-string "24.4")
+
+(with-suppressed-warnings ((obsolete eieio-object-set-name-string))
+ (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
+ "Set the string which is OBJ's NAME."
+ (cl-check-type name string)
+ (eieio-oset obj 'object-name name)))
+
+(cl-defmethod clone ((obj eieio-named) &rest params)
+ "Clone OBJ, initializing `:parent' to OBJ.
+All slots are unbound, except those initialized with PARAMS."
+ (let* ((newname (and (stringp (car params)) (pop params)))
+ (nobj (apply #'cl-call-next-method obj params))
+ (nm (slot-value nobj 'object-name)))
+ (eieio-oset nobj 'object-name
+ (or newname
+ (if (equal nm (slot-value obj 'object-name))
+ (save-match-data
+ (if (and nm (string-match "-\\([0-9]+\\)" nm))
+ (let ((num (1+ (string-to-number
+ (match-string 1 nm)))))
+ (concat (substring nm 0 (match-beginning 0))
+ "-" (int-to-string num)))
+ (concat nm "-1")))
+ nm)))
+ nobj))
+
+(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
+ (if (not (stringp (car args)))
+ (cl-call-next-method)
+ (funcall (if eieio-backward-compatibility #'ignore #'message)
+ "Obsolete: name passed without :object-name to %S constructor"
+ class)
+ (apply #'cl-call-next-method class :object-name args)))
+
;;; eieio-persistent
;;
;; For objects which must save themselves to disk. Provides an
@@ -264,12 +317,17 @@ objects found there."
(:method
((objclass (subclass eieio-default-superclass)) inputlist)
- (let ((slots (if (stringp (car inputlist))
- ;; Earlier versions of `object-write' added a
- ;; string name for the object, now obsolete.
- (cdr inputlist)
- inputlist))
- (createslots nil))
+ (let* ((name nil)
+ (slots (if (stringp (car inputlist))
+ (progn
+ ;; Earlier versions of `object-write' added a
+ ;; string name for the object, now obsolete.
+ ;; Save as 'name' in case this object is subclass
+ ;; of eieio-named with no :object-name slot specified.
+ (setq name (car inputlist))
+ (cdr inputlist))
+ inputlist))
+ (createslots nil))
;; If OBJCLASS is an eieio autoload object, then we need to
;; load it (we don't need the return value).
(eieio--full-class-object objclass)
@@ -286,7 +344,17 @@ objects found there."
(setq slots (cdr (cdr slots))))
- (apply #'make-instance objclass (nreverse createslots)))))
+ (let ((newobj (apply #'make-instance objclass (nreverse createslots))))
+
+ ;; Check for special case of subclass of `eieio-named', and do
+ ;; name assignment.
+ (when (and eieio-backward-compatibility
+ (object-of-class-p newobj 'eieio-named)
+ (not (oref newobj object-name))
+ name)
+ (oset newobj object-name name))
+
+ newobj))))
(defun eieio-persistent-fix-value (proposed-value)
"Fix PROPOSED-VALUE.
@@ -408,59 +476,6 @@ instance."
;; It should also set up some hooks to help it keep itself up to date.
-;;; Named object
-
-(defclass eieio-named ()
- ((object-name :initarg :object-name :initform nil))
- "Object with a name."
- :abstract t)
-
-(cl-defmethod eieio-object-name-string ((obj eieio-named))
- "Return a string which is OBJ's name."
- (or (slot-value obj 'object-name)
- (cl-call-next-method)))
-
-(cl-defgeneric eieio-object-set-name-string (obj name)
- "Set the string which is OBJ's NAME."
- (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ
\\='object-name) NAME) instead" "25.1"))
- (cl-check-type name string)
- (setf (gethash obj eieio--object-names) name))
-(define-obsolete-function-alias
- 'object-set-name-string 'eieio-object-set-name-string "24.4")
-
-(with-suppressed-warnings ((obsolete eieio-object-set-name-string))
- (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
- "Set the string which is OBJ's NAME."
- (cl-check-type name string)
- (eieio-oset obj 'object-name name)))
-
-(cl-defmethod clone ((obj eieio-named) &rest params)
- "Clone OBJ, initializing `:parent' to OBJ.
-All slots are unbound, except those initialized with PARAMS."
- (let* ((newname (and (stringp (car params)) (pop params)))
- (nobj (apply #'cl-call-next-method obj params))
- (nm (slot-value nobj 'object-name)))
- (eieio-oset nobj 'object-name
- (or newname
- (if (equal nm (slot-value obj 'object-name))
- (save-match-data
- (if (and nm (string-match "-\\([0-9]+\\)" nm))
- (let ((num (1+ (string-to-number
- (match-string 1 nm)))))
- (concat (substring nm 0 (match-beginning 0))
- "-" (int-to-string num)))
- (concat nm "-1")))
- nm)))
- nobj))
-
-(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
- (if (not (stringp (car args)))
- (cl-call-next-method)
- (funcall (if eieio-backward-compatibility #'ignore #'message)
- "Obsolete: name passed without :object-name to %S constructor"
- class)
- (apply #'cl-call-next-method class :object-name args)))
-
(provide 'eieio-base)
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 1ae216c..8780c5d 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -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
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 82a8cd2..3784497 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -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
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 8fb79d2..72ea1ba 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -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)
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 698467e..39e69f5 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -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.
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 4f9b0b1..9ef8b7f 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -168,8 +168,19 @@ You can also use \\[erc-nickserv-identify-mode] to change
modes."
:group 'erc-services
:type 'boolean)
+(defcustom erc-use-auth-source-for-nickserv-password nil
+ "Query auth-source for a password when identifiying to NickServ.
+This option has an no effect if `erc-prompt-for-nickserv-password'
+is non-nil, and passwords from `erc-nickserv-passwords' take
+precedence."
+ :version "28.1"
+ :group 'erc-services
+ :type 'boolean)
+
(defcustom erc-nickserv-passwords nil
"Passwords used when identifying to NickServ automatically.
+`erc-prompt-for-nickserv-password' must be nil for these
+passwords to be used.
Example of use:
(setq erc-nickserv-passwords
@@ -375,7 +386,8 @@ Make sure it is the real NickServ for this network.
If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the
password for this nickname, otherwise try to send it automatically."
(unless (and (null erc-nickserv-passwords)
- (null erc-prompt-for-nickserv-password))
+ (null erc-prompt-for-nickserv-password)
+ (null erc-use-auth-source-for-nickserv-password))
(let* ((network (erc-network))
(sender (erc-nickserv-alist-sender network))
(identify-regex (erc-nickserv-alist-regexp network))
@@ -394,30 +406,49 @@ password for this nickname, otherwise try to send it
automatically."
(defun erc-nickserv-identify-on-connect (_server nick)
"Identify to Nickserv after the connection to the server is established."
(unless (or (and (null erc-nickserv-passwords)
- (null erc-prompt-for-nickserv-password))
- (and (eq erc-nickserv-identify-mode 'both)
- (erc-nickserv-alist-regexp (erc-network))))
+ (null erc-prompt-for-nickserv-password)
+ (null erc-use-auth-source-for-nickserv-password))
+ (and (eq erc-nickserv-identify-mode 'both)
+ (erc-nickserv-alist-regexp (erc-network))))
(erc-nickserv-call-identify-function nick)))
(defun erc-nickserv-identify-on-nick-change (nick _old-nick)
"Identify to Nickserv whenever your nick changes."
(unless (or (and (null erc-nickserv-passwords)
- (null erc-prompt-for-nickserv-password))
- (and (eq erc-nickserv-identify-mode 'both)
- (erc-nickserv-alist-regexp (erc-network))))
+ (null erc-prompt-for-nickserv-password)
+ (null erc-use-auth-source-for-nickserv-password))
+ (and (eq erc-nickserv-identify-mode 'both)
+ (erc-nickserv-alist-regexp (erc-network))))
(erc-nickserv-call-identify-function nick)))
+(defun erc-nickserv-get-password (nickname)
+ "Return the password for NICKNAME from configured sources.
+
+It uses `erc-nickserv-passwords' and additionally auth-source
+when `erc-use-auth-source-for-nickserv-password' is not nil."
+ (or
+ (when erc-nickserv-passwords
+ (cdr (assoc nickname
+ (nth 1 (assoc (erc-network)
+ erc-nickserv-passwords)))))
+ (when erc-use-auth-source-for-nickserv-password
+ (let* ((secret (nth 0 (auth-source-search
+ :max 1 :require '(:secret)
+ :host (erc-with-server-buffer erc-session-server)
+ :port (format ; ensure we have a string
+ "%s" (erc-with-server-buffer
erc-session-port))
+ :user nickname))))
+ (when secret
+ (let ((passwd (plist-get secret :secret)))
+ (if (functionp passwd) (funcall passwd) passwd)))))))
+
(defun erc-nickserv-call-identify-function (nickname)
"Call `erc-nickserv-identify'.
Either call it interactively or run it with NICKNAME's password,
depending on the value of `erc-prompt-for-nickserv-password'."
(if erc-prompt-for-nickserv-password
(call-interactively 'erc-nickserv-identify)
- (when erc-nickserv-passwords
- (erc-nickserv-identify
- (cdr (assoc nickname
- (nth 1 (assoc (erc-network)
- erc-nickserv-passwords))))))))
+ (erc-nickserv-identify (erc-nickserv-get-password nickname))))
(defvar erc-auto-discard-away)
@@ -451,6 +482,7 @@ When called interactively, read the password using
`read-passwd'."
(provide 'erc-services)
+
;;; erc-services.el ends here
;;
;; Local Variables:
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 771b81e..4c479d6 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -487,7 +487,7 @@ What happens depends on the number of mouse clicks:-
Signal an error if the final event isn't the same type as the first one."
(let ((initial-event-type (event-basic-type event)))
(while (null (sit-for (/ double-click-time 1000.0) 'nodisplay))
- (setq event (read-event)))
+ (setq event (read--potential-mouse-event)))
(or (eq initial-event-type (event-basic-type event))
(error "")))
event)
diff --git a/lisp/frame.el b/lisp/frame.el
index c712762..e2d7f21 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -2557,7 +2557,7 @@ command starts, by installing a pre-command hook."
;; blink-cursor-end is not added to pre-command-hook.
(setq blink-cursor-blinks-done 1)
(blink-cursor--start-timer)
- (add-hook 'pre-command-hook 'blink-cursor-end)
+ (add-hook 'pre-command-hook #'blink-cursor-end)
(internal-show-cursor nil nil)))
(defun blink-cursor-timer-function ()
@@ -2572,14 +2572,14 @@ command starts, by installing a pre-command hook."
(when (and (> blink-cursor-blinks 0)
(<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
(blink-cursor-suspend)
- (add-hook 'post-command-hook 'blink-cursor-check)))
+ (add-hook 'post-command-hook #'blink-cursor-check)))
(defun blink-cursor-end ()
"Stop cursor blinking.
This is installed as a pre-command hook by `blink-cursor-start'.
When run, it cancels the timer `blink-cursor-timer' and removes
itself as a pre-command hook."
- (remove-hook 'pre-command-hook 'blink-cursor-end)
+ (remove-hook 'pre-command-hook #'blink-cursor-end)
(internal-show-cursor nil t)
(when blink-cursor-timer
(cancel-timer blink-cursor-timer)
@@ -2648,7 +2648,7 @@ terminals, cursor blinking is controlled by the terminal."
(when blink-cursor-mode
(add-function :after after-focus-change-function
#'blink-cursor--rescan-frames)
(add-hook 'after-delete-frame-functions #'blink-cursor--rescan-frames)
- (blink-cursor--start-idle-timer)))
+ (blink-cursor-check)))
;; Frame maximization/fullscreen
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 44f43b0..5c6a5b9 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -1036,7 +1036,7 @@ Responsible for handling and, or, and parenthetical
expressions.")
'(body cc bcc from header keyword larger smaller subject text to uid x-gm-raw
answered before deleted draft flagged on since recent seen sentbefore
senton sentsince unanswered undeleted undraft unflagged unkeyword
- unseen all)
+ unseen all old new or not)
"Known IMAP search keys.")
;; imap interface
@@ -1072,10 +1072,11 @@ Responsible for handling and, or, and parenthetical
expressions.")
;; A bit of backward-compatibility slash convenience: if the
;; query string doesn't start with any known IMAP search
;; keyword, assume it is a "TEXT" search.
- (unless (and (string-match "\\`[^[:blank:]]+" q-string)
- (memql (intern-soft (downcase
- (match-string 0 q-string)))
- gnus-search-imap-search-keys))
+ (unless (or (looking-at "(")
+ (and (string-match "\\`[^[:blank:]]+" q-string)
+ (memql (intern-soft (downcase
+ (match-string 0 q-string)))
+ gnus-search-imap-search-keys)))
(setq q-string (concat "TEXT " q-string)))
;; If it's a thread query, make sure that all message-id
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 18924a3..3fb8e46 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -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
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 3ff3d29..50e0218 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -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))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 2b0b61b..61946aa 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -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))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index e4fd976..2a4c74d 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1351,7 +1351,8 @@ This variable is set by `nnmaildir-request-article'.")
(throw 'return nil))
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
- (nnheader-insert-file-contents nnmaildir-article-file-name))
+ (let ((coding-system-for-read mm-text-coding-system))
+ (mm-insert-file-contents nnmaildir-article-file-name)))
(cons gname num-msgid))))
(defun nnmaildir-request-post (&optional _server)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index b6feeeb..8ce936a 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -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"
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index cd08b2b..7043f12 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -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
diff --git a/lisp/info.el b/lisp/info.el
index 62d7b58..dec9392 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1973,7 +1973,6 @@ If DIRECTION is `backward', search in the reverse
direction."
"Regexp search%s" (car Info-search-history)
(if case-fold-search "" " case-sensitively"))
nil 'Info-search-history)))
- (deactivate-mark)
(when (equal regexp "")
(setq regexp (car Info-search-history)))
(when regexp
@@ -2066,6 +2065,7 @@ If DIRECTION is `backward', search in the reverse
direction."
(< found opoint-max))
;; Search landed in the same node
(goto-char found)
+ (deactivate-mark)
(widen)
(goto-char found)
(save-match-data (Info-select-node)))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 67cc7be..c6f7fe7 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -838,10 +838,6 @@ This is like `describe-bindings', but displays only
Isearch keys."
:image '(isearch-tool-bar-image "left-arrow")))
map))
-;; Note: Before adding more key bindings to this map, please keep in
-;; mind that any unbound key exits Isearch and runs the command bound
-;; to it in the local or global map. So in effect every key unbound
-;; in this map is implicitly bound.
(defvar minibuffer-local-isearch-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
@@ -2498,6 +2494,21 @@ If search string is empty, just beep."
(unless isearch-mode (isearch-mode t))
(isearch-yank-string (current-kill 0)))
+(defun isearch-yank-from-kill-ring ()
+ "Read a string from the `kill-ring' and append it to the search string."
+ (interactive)
+ (with-isearch-suspended
+ (let ((string (read-from-kill-ring)))
+ (if (and isearch-case-fold-search
+ (eq 'not-yanks search-upper-case))
+ (setq string (downcase string)))
+ (if isearch-regexp (setq string (regexp-quote string)))
+ (setq isearch-yank-flag t)
+ (setq isearch-new-string (concat isearch-string string)
+ isearch-new-message (concat isearch-message
+ (mapconcat
'isearch-text-char-description
+ string ""))))))
+
(defun isearch-yank-pop ()
"Replace just-yanked search string with previously killed string.
Unlike `isearch-yank-pop-only', when this command is called not immediately
@@ -2506,37 +2517,31 @@ minibuffer to read a string from the `kill-ring' as
`yank-pop' does."
(interactive)
(if (not (memq last-command '(isearch-yank-kill
isearch-yank-pop isearch-yank-pop-only)))
- ;; Yank string from kill-ring-browser.
- (with-isearch-suspended
- (let ((string (read-from-kill-ring)))
- (if (and isearch-case-fold-search
- (eq 'not-yanks search-upper-case))
- (setq string (downcase string)))
- (if isearch-regexp (setq string (regexp-quote string)))
- (setq isearch-yank-flag t)
- (setq isearch-new-string (concat isearch-string string)
- isearch-new-message (concat isearch-message
- (mapconcat
'isearch-text-char-description
- string "")))))
+ (isearch-yank-from-kill-ring)
(isearch-pop-state)
(isearch-yank-string (current-kill 1))))
-(defun isearch-yank-pop-only ()
+(defun isearch-yank-pop-only (&optional arg)
"Replace just-yanked search string with previously killed string.
Unlike `isearch-yank-pop', when this command is called not immediately
after a `isearch-yank-kill' or a `isearch-yank-pop-only', it only pops
the last killed string instead of activating the minibuffer to read
-a string from the `kill-ring' as `yank-pop' does."
- (interactive)
- (if (not (memq last-command '(isearch-yank-kill
- isearch-yank-pop isearch-yank-pop-only)))
- ;; Fall back on `isearch-yank-kill' for the benefits of people
- ;; who are used to the old behavior of `M-y' in isearch mode.
- ;; In future, `M-y' could be changed from `isearch-yank-pop-only'
- ;; to `isearch-yank-pop' that uses the kill-ring-browser.
- (isearch-yank-kill)
+a string from the `kill-ring' as `yank-pop' does. The prefix arg C-u
+always reads a string from the `kill-ring' using the minibuffer."
+ (interactive "P")
+ (cond
+ ((equal arg '(4))
+ (isearch-yank-from-kill-ring))
+ ((not (memq last-command '(isearch-yank-kill
+ isearch-yank-pop isearch-yank-pop-only)))
+ ;; Fall back on `isearch-yank-kill' for the benefits of people
+ ;; who are used to the old behavior of `M-y' in isearch mode.
+ ;; In future, `M-y' could be changed from `isearch-yank-pop-only'
+ ;; to `isearch-yank-pop' that uses the kill-ring-browser.
+ (isearch-yank-kill))
+ (t
(isearch-pop-state)
- (isearch-yank-string (current-kill 1))))
+ (isearch-yank-string (current-kill 1)))))
(defun isearch-yank-x-selection ()
"Pull current X selection into search string."
@@ -2997,7 +3002,7 @@ See more for options in `search-exit-option'."
((and (eq (car-safe main-event) 'down-mouse-1)
(window-minibuffer-p (posn-window (event-start main-event))))
;; Swallow the up-event.
- (read-event)
+ (read--potential-mouse-event)
(setq this-command 'isearch-edit-string))
;; Don't terminate the search for motion commands.
((and isearch-yank-on-move
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 556f5d3..315f2d3 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -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)
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index f661260..907ef06 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -225,7 +225,7 @@ To test this function, evaluate:
;; Don't change the mouse pointer shape while we drag.
(setq track-mouse 'dragging)
(while (progn
- (setq event (read-event)
+ (setq event (read--potential-mouse-event)
end (event-end event)
row (cdr (posn-col-row end))
col (car (posn-col-row end)))
@@ -286,7 +286,7 @@ To test this function, evaluate:
window-last-col (- (window-width) 2))
(track-mouse
(while (progn
- (setq event (read-event)
+ (setq event (read--potential-mouse-event)
end (event-end event)
row (cdr (posn-col-row end))
col (car (posn-col-row end)))
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 0da8288..8732fb8 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1792,7 +1792,7 @@ The function returns a non-nil value if it creates a
secondary selection."
(let (event end end-point)
(track-mouse
(while (progn
- (setq event (read-event))
+ (setq event (read--potential-mouse-event))
(or (mouse-movement-p event)
(memq (car-safe event) '(switch-frame select-window))))
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 3f3e713..0ce65a3 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -239,7 +239,7 @@ otherwise."
(mapc
(lambda (info)
(let ((local-ip (nth 1 info))
- (mask (nth 2 info)))
+ (mask (nth 3 info)))
(when
(nsm-network-same-subnet (substring local-ip 0 -1)
(substring mask 0 -1)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c0c215d..2c4ef2a 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -98,6 +98,7 @@ It is used for TCP/IP devices."
`(,tramp-adb-method
(tramp-login-program ,tramp-adb-program)
(tramp-login-args (("shell")))
+ (tramp-direct-async t)
(tramp-tmpdir "/data/local/tmp")
(tramp-default-port 5555)))
@@ -895,8 +896,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; terminated.
(defun tramp-adb-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
-If connection property \"direct-async-process\" is non-nil, an
-alternative implementation will be used."
+If method parameter `tramp-direct-async' and connection property
+\"direct-async-process\" are non-nil, an alternative
+implementation will be used."
(if (tramp-direct-async-process-p args)
(apply #'tramp-handle-make-process args)
(when args
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index b43b448..e8ee372 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -168,6 +168,7 @@ The string is used in `tramp-methods'.")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("%h")))
(tramp-async-args (("-q")))
+ (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
@@ -183,6 +184,7 @@ The string is used in `tramp-methods'.")
("-e" "none") ("-t" "-t") ("%h")
("%l")))
(tramp-async-args (("-q")))
+ (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
@@ -197,6 +199,7 @@ The string is used in `tramp-methods'.")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("%h")))
(tramp-async-args (("-q")))
+ (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
@@ -227,6 +230,7 @@ The string is used in `tramp-methods'.")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("%h")))
(tramp-async-args (("-q")))
+ (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
@@ -237,6 +241,7 @@ The string is used in `tramp-methods'.")
("-e" "none") ("-t" "-t") ("%h")
("%l")))
(tramp-async-args (("-q")))
+ (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
@@ -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))))
-
- (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)))
-
- ;; Check for "--dired" output. We must enable unibyte
- ;; strings, because the "--dired" output counts in bytes.
- (set-buffer-multibyte nil)
+ 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))))
+
+ (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)))
+
+ ;; 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
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index cc8dda8..2816c58 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -259,9 +259,9 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
parameters to suppress diagnostic messages, in order not to
tamper the process output.
- * `tramp-direct-async-args'
- An additional argument when a direct asynchronous process is
- started. Used so far only in the \"mock\" method of tramp-tests.el.
+ * `tramp-direct-async'
+ Whether the method supports direct asynchronous processes.
+ Until now, just \"ssh\"-based and \"adb\"-based methods do.
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
@@ -1755,7 +1755,8 @@ The outline level is equal to the verbosity of the Tramp
message."
Message is formatted with FMT-STRING as control string and the remaining
ARGUMENTS to actually emit the message (if applicable)."
(let ((inhibit-message t)
- file-name-handler-alist message-log-max signal-hook-function)
+ create-lockfiles file-name-handler-alist message-log-max
+ signal-hook-function)
(with-current-buffer (tramp-get-debug-buffer vec)
(goto-char (point-max))
(let ((point (point)))
@@ -1982,6 +1983,13 @@ the resulting error message."
(put #'tramp-with-demoted-errors 'tramp-suppress-trace t)
+(defun tramp-test-message (fmt-string &rest arguments)
+ "Emit a Tramp message according `default-directory'."
+ (if (tramp-tramp-file-p default-directory)
+ (apply #'tramp-message
+ (tramp-dissect-file-name default-directory) 0 fmt-string arguments)
+ (apply #'message fmt-string arguments)))
+
;; This function provides traces in case of errors not triggered by
;; Tramp functions.
(defun tramp-signal-hook-function (error-symbol data)
@@ -3741,7 +3749,9 @@ User is always nil."
(let ((v (tramp-dissect-file-name default-directory))
(buffer (plist-get args :buffer))
(stderr (plist-get args :stderr)))
- (and ;; It has been indicated.
+ (and ;; The method supports it.
+ (tramp-get-method-parameter v 'tramp-direct-async)
+ ;; It has been indicated.
(tramp-get-connection-property v "direct-async-process" nil)
;; There's no multi-hop.
(or (not (tramp-multi-hop-p v))
@@ -3821,8 +3831,6 @@ It does not support `:stderr'."
(tramp-get-method-parameter v 'tramp-login-args))
(async-args
(tramp-get-method-parameter v 'tramp-async-args))
- (direct-async-args
- (tramp-get-method-parameter v 'tramp-direct-async-args))
;; We don't create the temporary file. In fact, it
;; is just a prefix for the ControlPath option of
;; ssh; the real temporary file has another name, and
@@ -3850,7 +3858,7 @@ It does not support `:stderr'."
?h (or host "") ?u (or user "") ?p (or port "")
?c options ?l "")
;; Add arguments for asynchronous processes.
- login-args (append async-args direct-async-args login-args)
+ login-args (append async-args login-args)
;; Expand format spec.
login-args
(tramp-compat-flatten-tree
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 714b3f9..ced3e93 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.5.0
+;; Version: 2.5.1-pre
;; Package-Requires: ((emacs "25.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@@ -40,7 +40,7 @@
;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.5.0"
+(defconst tramp-version "2.5.1-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -76,7 +76,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-lessp emacs-version "25.1"))
"ok"
- (format "Tramp 2.5.0 is not fit for %s"
+ (format "Tramp 2.5.1-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index cc0e159..68dc0fb 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -132,8 +132,10 @@ This is an alternative of `scroll-up'. Scope moves
downward."
(pixel-line-height))))
(if (pixel-eob-at-top-p) ; when end-of-the-buffer is close
(scroll-up 1) ; relay on robust method
- (while (pixel-point-at-top-p amt) ; prevent too late (multi tries)
- (vertical-motion 1)) ; move point downward
+ (catch 'no-movement
+ (while (pixel-point-at-top-p amt) ; prevent too late (multi tries)
+ (unless (>= (vertical-motion 1) 1) ; move point downward
+ (throw 'no-movement nil)))) ; exit loop when point did not move
(pixel-scroll-pixel-up amt)))))) ; move scope downward
(defun pixel-scroll-down (&optional arg)
@@ -149,8 +151,10 @@ This is and alternative of `scroll-down'. Scope moves
upward."
pixel-resolution-fine-flag
(frame-char-height))
(pixel-line-height -1))))
- (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries)
- (vertical-motion -1)) ; move point upward
+ (catch 'no-movement
+ (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries)
+ (unless (<= (vertical-motion -1) -1) ; move point upward
+ (throw 'no-movement nil)))) ; exit loop when point did not move
(if (or (pixel-bob-at-top-p amt) ; when beginning-of-the-buffer is seen
(pixel-eob-at-top-p)) ; for file with a long line
(scroll-down 1) ; relay on robust method
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index fddc13f..460af71 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -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)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 62c3cf4..06966f3 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -970,20 +970,11 @@ loop using the command \\[fileloop-continue]."
(declare-function compilation-read-command "compile")
;;;###autoload
-(defun project-compile (command &optional comint)
- "Run `compile' in the project root.
-Arguments the same as in `compile'."
- (interactive
- (list
- (let ((command (eval compile-command)))
- (require 'compile)
- (if (or compilation-read-command current-prefix-arg)
- (compilation-read-command command)
- command))
- (consp current-prefix-arg)))
- (let* ((pr (project-current t))
- (default-directory (project-root pr)))
- (compile command comint)))
+(defun project-compile ()
+ "Run `compile' in the project root."
+ (interactive)
+ (let ((default-directory (project-root (project-current t))))
+ (call-interactively #'compile)))
(defun project--read-project-buffer ()
(let* ((pr (project-current t))
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index c8f6c12..9f5f9ed 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -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
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 0965fec..d6c0a4d 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -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)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index b393b8d..b6778de 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -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)
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 7cda6c9..1e81904 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -429,7 +429,7 @@ dragging. See also the variable
`ruler-mode-dragged-symbol'."
;; `ding' flushes the next messages about setting goal
;; column. So here I force fetch the event(mouse-2) and
;; throw away.
- (read-event)
+ (read--potential-mouse-event)
;; Ding BEFORE `message' is OK.
(when ruler-mode-set-goal-column-ding-flag
(ding))
@@ -460,7 +460,7 @@ the mouse has been clicked."
(track-mouse
;; Signal the display engine to freeze the mouse pointer shape.
(setq track-mouse 'dragging)
- (while (mouse-movement-p (setq event (read-event)))
+ (while (mouse-movement-p (setq event (read--potential-mouse-event)))
(setq drags (1+ drags))
(when (eq window (posn-window (event-end event)))
(ruler-mode-mouse-drag-any-column event)
diff --git a/lisp/shell.el b/lisp/shell.el
index c179dd2..0f86615 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -603,6 +603,7 @@ buffer."
(or hfile
(cond ((string-equal shell "bash") "~/.bash_history")
((string-equal shell "ksh") "~/.sh_history")
+ ((string-equal shell "zsh") "~/.zsh_history")
(t "~/.history")))))
(if (or (equal comint-input-ring-file-name "")
(equal (file-truename comint-input-ring-file-name)
diff --git a/lisp/simple.el b/lisp/simple.el
index 54c35c0..37c0885 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5606,7 +5606,9 @@ See also `zap-up-to-char'."
;; kill-line and its subroutines.
(defcustom kill-whole-line nil
- "If non-nil, `kill-line' with no arg at start of line kills the whole line."
+ "If non-nil, `kill-line' with no arg at start of line kills the whole line.
+This variable also affects `kill-visual-line' in the same way as
+it does `kill-line'."
:type 'boolean
:group 'killing)
@@ -7319,6 +7321,10 @@ If ARG is negative, kill visual lines backward.
If ARG is zero, kill the text before point on the current visual
line.
+If the variable `kill-whole-line' is non-nil, and this command is
+invoked at start of a line that ends in a newline, kill the newline
+as well.
+
If you want to append the killed line to the last killed text,
use \\[append-next-kill] before \\[kill-line].
@@ -7331,18 +7337,30 @@ even beep.)"
;; Like in `kill-line', it's better to move point to the other end
;; of the kill before killing.
(let ((opoint (point))
- (kill-whole-line (and kill-whole-line (bolp))))
+ (kill-whole-line (and kill-whole-line (bolp)))
+ (orig-y (cdr (nth 2 (posn-at-point))))
+ ;; FIXME: This tolerance should be zero! It isn't due to a
+ ;; bug in posn-at-point, see bug#45837.
+ (tol (/ (line-pixel-height) 2)))
(if arg
(vertical-motion (prefix-numeric-value arg))
(end-of-visual-line 1)
(if (= (point) opoint)
(vertical-motion 1)
- ;; Skip any trailing whitespace at the end of the visual line.
- ;; We used to do this only if `show-trailing-whitespace' is
- ;; nil, but that's wrong; the correct thing would be to check
- ;; whether the trailing whitespace is highlighted. But, it's
- ;; OK to just do this unconditionally.
- (skip-chars-forward " \t")))
+ ;; The first condition below verifies we are still on the same
+ ;; screen line, i.e. that the line isn't continued, and that
+ ;; end-of-visual-line didn't overshoot due to complications
+ ;; like display or overlay strings, intangible text, etc.:
+ ;; otherwise, we don't want to kill a character that's
+ ;; unrelated to the place where the visual line wrapped.
+ (and (< (abs (- (cdr (nth 2 (posn-at-point))) orig-y)) tol)
+ ;; Make sure we delete the character where the line wraps
+ ;; under visual-line-mode, be it whitespace or a
+ ;; character whose category set allows to wrap at it.
+ (or (looking-at-p "[ \t]")
+ (and word-wrap-by-category
+ (aref (char-category-set (following-char)) ?\|)))
+ (forward-char))))
(kill-region opoint (if (and kill-whole-line (= (following-char) ?\n))
(1+ (point))
(point)))))
diff --git a/lisp/startup.el b/lisp/startup.el
index 8a8e835..9325ab5 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -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)
diff --git a/lisp/strokes.el b/lisp/strokes.el
index b0ab4f9..55f2ae8 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -756,12 +756,12 @@ Optional EVENT is acceptable as the starting event of the
stroke."
(strokes-fill-current-buffer-with-whitespace))
(when prompt
(message "%s" prompt)
- (setq event (read-event))
+ (setq event (read--potential-mouse-event))
(or (strokes-button-press-event-p event)
(error "You must draw with the mouse")))
(unwind-protect
(track-mouse
- (or event (setq event (read-event)
+ (or event (setq event (read--potential-mouse-event)
safe-to-draw-p t))
(while (not (strokes-button-release-event-p event))
(if (strokes-mouse-event-p event)
@@ -776,7 +776,7 @@ Optional EVENT is acceptable as the starting event of the
stroke."
(setq safe-to-draw-p t))
(push (cdr (mouse-pixel-position))
pix-locs)))
- (setq event (read-event)))))
+ (setq event (read--potential-mouse-event)))))
;; protected
;; clean up strokes buffer and then bury it.
(when (equal (buffer-name) strokes-buffer-name)
@@ -787,16 +787,16 @@ Optional EVENT is acceptable as the starting event of the
stroke."
;; Otherwise, don't use strokes buffer and read stroke silently
(when prompt
(message "%s" prompt)
- (setq event (read-event))
+ (setq event (read--potential-mouse-event))
(or (strokes-button-press-event-p event)
(error "You must draw with the mouse")))
(track-mouse
- (or event (setq event (read-event)))
+ (or event (setq event (read--potential-mouse-event)))
(while (not (strokes-button-release-event-p event))
(if (strokes-mouse-event-p event)
(push (cdr (mouse-pixel-position))
pix-locs))
- (setq event (read-event))))
+ (setq event (read--potential-mouse-event))))
(setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs)))
(strokes-fill-stroke
(strokes-eliminate-consecutive-redundancies grid-locs)))))
@@ -817,10 +817,10 @@ Optional EVENT is acceptable as the starting event of the
stroke."
(if prompt
(while (not (strokes-button-press-event-p event))
(message "%s" prompt)
- (setq event (read-event))))
+ (setq event (read--potential-mouse-event))))
(unwind-protect
(track-mouse
- (or event (setq event (read-event)))
+ (or event (setq event (read--potential-mouse-event)))
(while (not (and (strokes-button-press-event-p event)
(eq 'mouse-3
(car (get (car event)
@@ -834,14 +834,15 @@ Optional EVENT is acceptable as the starting event of the
stroke."
?\s strokes-character))
(push (cdr (mouse-pixel-position))
pix-locs)))
- (setq event (read-event)))
+ (setq event (read--potential-mouse-event)))
(push strokes-lift pix-locs)
(while (not (strokes-button-press-event-p event))
- (setq event (read-event))))
+ (setq event (read--potential-mouse-event))))
;; ### KLUDGE! ### sit and wait
;; for some useless event to
;; happen to fix the minibuffer bug.
- (while (not (strokes-button-release-event-p (read-event))))
+ (while (not (strokes-button-release-event-p
+ (read--potential-mouse-event))))
(setq pix-locs (nreverse (cdr pix-locs))
grid-locs (strokes-renormalize-to-grid pix-locs))
(strokes-fill-stroke
diff --git a/lisp/subr.el b/lisp/subr.el
index 6513950..b1295a0 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -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!
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index ce62082..50c00c9 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -5004,7 +5004,7 @@ The event, EV, is the mouse event."
(setq timer (run-at-time interval interval draw-fn x1 y1))))
;; Read next event
- (setq ev (read-event))))
+ (setq ev (read--potential-mouse-event))))
;; Cleanup: get rid of any active timer.
(if timer
(cancel-timer timer)))
@@ -5212,7 +5212,7 @@ The event, EV, is the mouse event."
;; Read next event (only if we should not stop)
(if (not done)
- (setq ev (read-event)))))
+ (setq ev (read--potential-mouse-event)))))
;; Reverse point-list (last points are cond'ed first)
(setq point-list (reverse point-list))
@@ -5339,7 +5339,7 @@ The event, EV, is the mouse event."
;; Read next event
- (setq ev (read-event))))
+ (setq ev (read--potential-mouse-event))))
;; If we are not rubber-banding (that is, we were moving around the `2')
;; draw the shape
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 3346c55..6681b03 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -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.
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 073059d..1b29eaf 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -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)
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 72b3458..47ef37a 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -262,11 +262,12 @@ keyboard input to go into icons."
(let (event)
(message
"Select windows by clicking. Please click on Window %d " wind-number)
- (while (not (ediff-mouse-event-p (setq event (read-event))))
+ (while (not (ediff-mouse-event-p (setq event
+ (read--potential-mouse-event))))
(if (sit-for 1) ; if sequence of events, wait till the final word
(beep 1))
(message "Please click on Window %d " wind-number))
- (read-event) ; discard event
+ (read--potential-mouse-event) ; discard event
(posn-window (event-start event))))
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index e3612dd..ed375738 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -939,7 +939,7 @@ arguments after setting up the Ediff buffers."
;; If WIND-A is nil, use selected window.
;; If WIND-B is nil, use window next to WIND-A.
(defun ediff-windows (dumb-mode wind-A wind-B startup-hooks job-name word-mode)
- (if (or dumb-mode (not (ediff-window-display-p)))
+ (if (or dumb-mode (not (display-mouse-p)))
(setq wind-A (ediff-get-next-window wind-A nil)
wind-B (ediff-get-next-window wind-B wind-A))
(setq wind-A (ediff-get-window-by-clicking wind-A nil 1)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 8b10d71..7dda04e 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1104,7 +1104,7 @@ If nothing was called, return non-nil."
(unless (widget-apply button :mouse-down-action event)
(let ((track-mouse t))
(while (not (widget-button-release-event-p event))
- (setq event (read-event))
+ (setq event (read--potential-mouse-event))
(when (and mouse-1 (mouse-movement-p event))
(push event unread-command-events)
(setq event oevent)
@@ -1169,7 +1169,7 @@ If nothing was called, return non-nil."
(when up
;; Don't execute up events twice.
(while (not (widget-button-release-event-p event))
- (setq event (read-event))))
+ (setq event (read--potential-mouse-event))))
(when command
(call-interactively command)))))
(message "You clicked somewhere weird.")))
@@ -3486,14 +3486,16 @@ It reads a directory name from an editable text field."
:help-echo "C-q: insert KEY, EVENT, or CODE; RET: enter value"
:tag "Key sequence")
+;; FIXME: Consider combining this with help--read-key-sequence which
+;; can also read double and triple mouse events.
(defun widget-key-sequence-read-event (ev)
(interactive (list
(let ((inhibit-quit t) quit-flag)
- (read-event "Insert KEY, EVENT, or CODE: "))))
+ (read-key "Insert KEY, EVENT, or CODE: " t))))
(let ((ev2 (and (memq 'down (event-modifiers ev))
- (read-event)))
- (tr (and (keymapp function-key-map)
- (lookup-key function-key-map (vector ev)))))
+ (read-key nil t)))
+ (tr (and (keymapp local-function-key-map)
+ (lookup-key local-function-key-map (vector ev)))))
(when (and (integerp ev)
(or (and (<= ?0 ev) (< ev (+ ?0 (min 10
read-quoted-char-radix))))
(and (<= ?a (downcase ev))
diff --git a/lisp/window.el b/lisp/window.el
index 38be778..0a37d16 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -1736,9 +1736,11 @@ interpret DELTA as pixels."
(setq window (window-normalize-window window))
(cond
((< delta 0)
- (max (- (window-min-size window horizontal ignore pixelwise)
- (window-size window horizontal pixelwise))
- delta))
+ (let ((min-size (window-min-size window horizontal ignore pixelwise))
+ (size (window-size window horizontal pixelwise)))
+ (if (<= size min-size)
+ 0
+ (max (- min-size size) delta))))
((> delta 0)
(if (window-size-fixed-p window horizontal ignore)
0
@@ -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
diff --git a/src/buffer.c b/src/buffer.c
index 71ad5ed..80c799e 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -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));
}
diff --git a/src/callproc.c b/src/callproc.c
index 8d2a561..cb72b07 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -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);
diff --git a/src/data.c b/src/data.c
index 3cf5bbb..0dc21c8 100644
--- a/src/data.c
+++ b/src/data.c
@@ -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");
diff --git a/src/dispnew.c b/src/dispnew.c
index 36a6dd8..e603c67 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -6049,7 +6049,14 @@ additional wait period, in milliseconds; this is for
backwards compatibility.
READING is true if reading input.
If DISPLAY_OPTION is >0 display process output while waiting.
If DISPLAY_OPTION is >1 perform an initial redisplay before waiting.
-*/
+
+ Returns a boolean Qt if we waited the full time and returns Qnil if the
+ wait was interrupted by incoming process output or keyboard events.
+
+ FIXME: When `wait_reading_process_output` returns early because of
+ process output, instead of returning nil we should loop and wait some
+ more (i.e. until either there's pending input events or the timeout
+ expired). */
Lisp_Object
sit_for (Lisp_Object timeout, bool reading, int display_option)
@@ -6110,8 +6117,9 @@ sit_for (Lisp_Object timeout, bool reading, int
display_option)
gobble_input ();
#endif
- wait_reading_process_output (sec, nsec, reading ? -1 : 1, do_display,
- Qnil, NULL, 0);
+ int nbytes
+ = wait_reading_process_output (sec, nsec, reading ? -1 : 1, do_display,
+ Qnil, NULL, 0);
if (reading && curbuf_eq_winbuf)
/* Timers and process filters/sentinels may have changed the selected
@@ -6120,7 +6128,7 @@ sit_for (Lisp_Object timeout, bool reading, int
display_option)
buffer to start with). */
set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents));
- return detect_input_pending () ? Qnil : Qt;
+ return (nbytes > 0 || detect_input_pending ()) ? Qnil : Qt;
}
diff --git a/src/emacs.c b/src/emacs.c
index 738ef12..c6581bb 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -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;
diff --git a/src/eval.c b/src/eval.c
index f77f07e..cef9407 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -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;
}
}
diff --git a/src/fns.c b/src/fns.c
index 5fcc54f..7ab2e8f 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5548,6 +5548,90 @@ It should not be used for anything security-related. See
return make_digest_string (digest, SHA1_DIGEST_SIZE);
}
+DEFUN ("buffer-line-statistics", Fbuffer_line_statistics,
+ Sbuffer_line_statistics, 0, 1, 0,
+ doc: /* Return data about lines in BUFFER.
+The data is returned as a list, and the first element is the number of
+lines in the buffer, the second is the length of the longest line, and
+the third is the mean line length. The lengths returned are in bytes, not
+characters. */ )
+ (Lisp_Object buffer_or_name)
+{
+ Lisp_Object buffer;
+ ptrdiff_t lines = 0, longest = 0;
+ double mean = 0;
+ struct buffer *b;
+
+ if (NILP (buffer_or_name))
+ buffer = Fcurrent_buffer ();
+ else
+ buffer = Fget_buffer (buffer_or_name);
+ if (NILP (buffer))
+ nsberror (buffer_or_name);
+
+ b = XBUFFER (buffer);
+
+ unsigned char *start = BUF_BEG_ADDR (b);
+ ptrdiff_t area = BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b), pre_gap = 0;
+
+ /* Process the first part of the buffer. */
+ while (area > 0)
+ {
+ unsigned char *n = memchr (start, '\n', area);
+
+ if (n)
+ {
+ ptrdiff_t this_line = n - start;
+ if (this_line > longest)
+ longest = this_line;
+ lines++;
+ /* Blame Knuth. */
+ mean = mean + (this_line - mean) / lines;
+ area = area - this_line - 1;
+ start += this_line + 1;
+ }
+ else
+ {
+ /* Didn't have a newline here, so save the rest for the
+ post-gap calculation. */
+ pre_gap = area;
+ area = 0;
+ }
+ }
+
+ /* If the gap is before the end of the buffer, process the last half
+ of the buffer. */
+ if (BUF_GPT_BYTE (b) < BUF_Z_BYTE (b))
+ {
+ start = BUF_GAP_END_ADDR (b);
+ area = BUF_Z_ADDR (b) - BUF_GAP_END_ADDR (b);
+
+ while (area > 0)
+ {
+ unsigned char *n = memchr (start, '\n', area);
+ ptrdiff_t this_line = n? n - start + pre_gap: area + pre_gap;
+
+ if (this_line > longest)
+ longest = this_line;
+ lines++;
+ /* Blame Knuth again. */
+ mean = mean + (this_line - mean) / lines;
+ area = area - this_line - 1;
+ start += this_line + 1;
+ pre_gap = 0;
+ }
+ }
+ else if (pre_gap > 0)
+ {
+ if (pre_gap > longest)
+ longest = pre_gap;
+ lines++;
+ mean = mean + (pre_gap - mean) / lines;
+ }
+
+ return list3 (make_int (lines), make_int (longest), make_float (mean));
+}
+
static bool
string_ascii_p (Lisp_Object string)
{
@@ -5871,4 +5955,5 @@ this variable. */);
defsubr (&Ssecure_hash);
defsubr (&Sbuffer_hash);
defsubr (&Slocale_info);
+ defsubr (&Sbuffer_line_statistics);
}
diff --git a/src/keymap.c b/src/keymap.c
index 1197f6f..de9b2b5 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1646,39 +1646,6 @@ specified buffer position instead of point are used.
/* GC is possible in this function if it autoloads a keymap. */
-DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
- doc: /* Return the binding for command KEYS in current local keymap
only.
-KEYS is a string or vector, a sequence of keystrokes.
-The binding is probably a symbol with a function definition.
-
-If optional argument ACCEPT-DEFAULT is non-nil, recognize default
-bindings; see the description of `lookup-key' for more details about this. */)
- (Lisp_Object keys, Lisp_Object accept_default)
-{
- register Lisp_Object map = BVAR (current_buffer, keymap);
- if (NILP (map))
- return Qnil;
- return Flookup_key (map, keys, accept_default);
-}
-
-/* GC is possible in this function if it autoloads a keymap. */
-
-DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
- doc: /* Return the binding for command KEYS in current global keymap
only.
-KEYS is a string or vector, a sequence of keystrokes.
-The binding is probably a symbol with a function definition.
-This function's return values are the same as those of `lookup-key'
-\(which see).
-
-If optional argument ACCEPT-DEFAULT is non-nil, recognize default
-bindings; see the description of `lookup-key' for more details about this. */)
- (Lisp_Object keys, Lisp_Object accept_default)
-{
- return Flookup_key (current_global_map, keys, accept_default);
-}
-
-/* GC is possible in this function if it autoloads a keymap. */
-
DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding,
Sminor_mode_key_binding, 1, 2, 0,
doc: /* Find the visible minor mode bindings of KEY.
Return an alist of pairs (MODENAME . BINDING), where MODENAME is
@@ -3253,8 +3220,6 @@ be preferred. */);
defsubr (&Scopy_keymap);
defsubr (&Scommand_remapping);
defsubr (&Skey_binding);
- defsubr (&Slocal_key_binding);
- defsubr (&Sglobal_key_binding);
defsubr (&Sminor_mode_key_binding);
defsubr (&Sdefine_key);
defsubr (&Slookup_key);
diff --git a/src/lisp.h b/src/lisp.h
index b6182c3..296f9af 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -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);
diff --git a/src/lread.c b/src/lread.c
index e308fa8..4cf4f8c 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -767,11 +767,16 @@ is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
-floating-point value. */)
+floating-point value.
+
+If `inhibit-interaction' is non-nil, this function will signal an
+`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
Lisp_Object val;
+ barf_if_interaction_inhibited ();
+
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
@@ -782,6 +787,12 @@ floating-point value. */)
DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
doc: /* Read an event object from the input stream.
+
+If you want to read non-character events, consider calling `read-key'
+instead. `read-key' will decode events via `input-decode-map' that
+`read-event' will not. On a terminal this includes function keys such
+as <F7> and <RIGHT>, or mouse events generated by `xterm-mouse-mode'.
+
If the optional argument PROMPT is non-nil, display that as a prompt.
If PROMPT is nil or the string \"\", the key sequence/events that led
to the current command is used as the prompt.
@@ -793,9 +804,14 @@ is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
-floating-point value. */)
+floating-point value.
+
+If `inhibit-interaction' is non-nil, this function will signal an
+`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
+ barf_if_interaction_inhibited ();
+
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
@@ -822,11 +838,16 @@ is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
-floating-point value. */)
- (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
+floating-point value.
+
+If `inhibit-interaction' is non-nil, this function will signal an
+`inhibited-interaction' error. */)
+(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
Lisp_Object val;
+ barf_if_interaction_inhibited ();
+
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
diff --git a/src/minibuf.c b/src/minibuf.c
index 5ee440f..5df1045 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -63,10 +63,31 @@ 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;
-
- 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);
- }
+ {
+ Lisp_Object tail, frame;
+ struct frame *of;
+
+ 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);
diff --git a/src/pdumper.c b/src/pdumper.c
index 7eefcc8..f071107 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -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
diff --git a/src/process.c b/src/process.c
index 06d750d..dac7d04 100644
--- a/src/process.c
+++ b/src/process.c
@@ -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);
diff --git a/src/sysdep.c b/src/sysdep.c
index 6ede06b..941b4e2 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -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
diff --git a/src/w32term.c b/src/w32term.c
index e5a8a82..109aa58 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -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 */
diff --git a/src/window.c b/src/window.c
index 5e78aa4..e025e0b 100644
--- a/src/window.c
+++ b/src/window.c
@@ -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;
diff --git a/src/window.h b/src/window.h
index 332cb30..79eb44e 100644
--- a/src/window.h
+++ b/src/window.h
@@ -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'. */
diff --git a/src/xdisp.c b/src/xdisp.c
index 6a4304d..ea67329 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -9285,8 +9285,8 @@ move_it_in_display_line_to (struct it *it,
if (may_wrap && char_can_wrap_before (it))
{
/* We have reached a glyph that follows one or more
- whitespace characters or a character that allows
- wrapping after it. If this character allows
+ whitespace characters or characters that allow
+ wrapping after them. If this character allows
wrapping before it, save this position as a
wrapping point. */
if (atpos_it.sp >= 0)
@@ -9303,7 +9303,6 @@ move_it_in_display_line_to (struct it *it,
}
/* Otherwise, we can wrap here. */
SAVE_IT (wrap_it, *it, wrap_data);
- next_may_wrap = false;
}
/* Update may_wrap for the next iteration. */
may_wrap = next_may_wrap;
@@ -10650,9 +10649,10 @@ include the height of both, if present, in the return
value. */)
bpos = BEGV_BYTE;
while (bpos < ZV_BYTE)
{
- c = fetch_char_advance (&start, &bpos);
+ c = FETCH_BYTE (bpos);
if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
break;
+ inc_both (&start, &bpos);
}
while (bpos > BEGV_BYTE)
{
@@ -10681,7 +10681,10 @@ include the height of both, if present, in the return
value. */)
dec_both (&end, &bpos);
c = FETCH_BYTE (bpos);
if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
- break;
+ {
+ inc_both (&end, &bpos);
+ break;
+ }
}
while (bpos < ZV_BYTE)
{
diff --git a/src/xfaces.c b/src/xfaces.c
index b3b19a9..258b365 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -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");
diff --git a/test/Makefile.in b/test/Makefile.in
index 68ad1a3..849fbbf 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -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)
diff --git a/test/README b/test/README
index ec566cb..38f4a10 100644
--- a/test/README
+++ b/test/README
@@ -39,6 +39,12 @@ The Makefile in this directory supports the following
targets:
* make check-all
Like "make check", but run all tests.
+* make check-lisp
+ Like "make check", but run only the tests in test/lisp/*.el
+
+* make check-net
+ Like "make check", but run only the tests in test/lisp/net/*.el
+
* make <filename> -or- make <filename>.log
Run all tests declared in <filename>.el. This includes expensive
tests. In the former case the output is shown on the terminal, in
diff --git a/test/file-organization.org b/test/file-organization.org
index 64c0755..efc3545 100644
--- a/test/file-organization.org
+++ b/test/file-organization.org
@@ -57,3 +57,8 @@ directory called ~test/lisp/progmodes/flymake-resources~.
No guidance is given for the organization of resource files inside the
~-resources~ directory; files can be organized at the author's
discretion.
+
+** Testing Infrastructure Files
+
+Files used to support testing infrastructure such as EMBA should be
+placed in ~infra~.
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba
new file mode 100644
index 0000000..dd41982
--- /dev/null
+++ b/test/infra/Dockerfile.emba
@@ -0,0 +1,71 @@
+# Copyright (C) 2021 Free Software Foundation, Inc.
+#
+# This file is part of GNU Emacs.
+#
+# GNU Emacs is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# GNU Emacs is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+# GNU Emacs support for the GitLab-specific build of Docker images.
+
+# The presence of this file does not imply any FSF/GNU endorsement of
+# Docker or any other particular tool. Also, it is intended for
+# evaluation purposes, thus possibly temporary.
+
+# Maintainer: Ted Zlatanov <tzz@lifelogs.com>
+# URL: https://emba.gnu.org/emacs/emacs
+
+FROM debian:stretch as emacs-base
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
+ libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev git \
+ && rm -rf /var/lib/apt/lists/*
+
+FROM emacs-base as emacs-inotify
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0
inotify-tools \
+ && rm -rf /var/lib/apt/lists/*
+
+COPY . /checkout
+WORKDIR /checkout
+RUN ./autogen.sh autoconf
+RUN ./configure --without-makeinfo
+RUN make bootstrap
+RUN make -j4
+
+FROM emacs-base as emacs-filenotify-gio
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0
libglib2.0-dev libglib2.0-bin libglib2.0-0 \
+ && rm -rf /var/lib/apt/lists/*
+
+COPY . /checkout
+WORKDIR /checkout
+RUN ./autogen.sh autoconf
+RUN ./configure --without-makeinfo --with-file-notification=gfile
+RUN make bootstrap
+RUN make -j4
+
+FROM emacs-base as emacs-gnustep
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0
gnustep-devel \
+ && rm -rf /var/lib/apt/lists/*
+
+COPY . /checkout
+WORKDIR /checkout
+RUN ./autogen.sh autoconf
+RUN ./configure --without-makeinfo --with-ns
+RUN make bootstrap
+RUN make -j4
diff --git a/test/lisp/calendar/lunar-tests.el
b/test/lisp/calendar/lunar-tests.el
index 5f1f678..268dcfd 100644
--- a/test/lisp/calendar/lunar-tests.el
+++ b/test/lisp/calendar/lunar-tests.el
@@ -27,39 +27,37 @@
(defmacro with-lunar-test (&rest body)
`(let ((calendar-latitude 40.1)
(calendar-longitude -88.2)
- (calendar-location-name "Urbana, IL")
- (calendar-time-zone -360)
- (calendar-standard-time-zone-name "CST")
- (calendar-time-display-form '(12-hours ":" minutes am-pm)))
+ (calendar-location-name "Paris")
+ (calendar-time-zone 0)
+ (calendar-standard-time-zone-name "UTC")
+ ;; Make sure daylight saving is disabled to avoid interference
+ ;; from the system settings (see bug#45818).
+ (calendar-daylight-savings-starts nil)
+ (calendar-time-display-form '(24-hours ":" minutes)))
,@body))
(ert-deftest lunar-test-phase ()
(with-lunar-test
(should (equal (lunar-phase 1)
- '((1 7 1900) "11:40pm" 1 "")))))
+ '((1 8 1900) "05:40" 1 "")))))
(ert-deftest lunar-test-eclipse-check ()
(with-lunar-test
(should (equal (eclipse-check 1 1) "** Eclipse **"))))
-;; This fails in certain time zones.
-;; Eg TZ=America/Phoenix make lisp/calendar/lunar-tests
-;; Similarly with TZ=UTC.
-;; Daylight saving related?
(ert-deftest lunar-test-phase-list ()
- :tags '(:unstable)
(with-lunar-test
(should (equal (lunar-phase-list 3 1871)
- '(((3 20 1871) "11:03pm" 0 "")
- ((3 29 1871) "1:46am" 1 "** Eclipse **")
- ((4 5 1871) "9:20am" 2 "")
- ((4 12 1871) "12:57am" 3 "** Eclipse possible **")
- ((4 19 1871) "2:06pm" 0 "")
- ((4 27 1871) "6:49pm" 1 "")
- ((5 4 1871) "5:57pm" 2 "")
- ((5 11 1871) "9:29am" 3 "")
- ((5 19 1871) "5:46am" 0 "")
- ((5 27 1871) "8:02am" 1 ""))))))
+ '(((3 21 1871) "04:03" 0 "")
+ ((3 29 1871) "06:46" 1 "** Eclipse **")
+ ((4 5 1871) "14:20" 2 "")
+ ((4 12 1871) "05:57" 3 "** Eclipse possible **")
+ ((4 19 1871) "19:06" 0 "")
+ ((4 27 1871) "23:49" 1 "")
+ ((5 4 1871) "22:57" 2 "")
+ ((5 11 1871) "14:29" 3 "")
+ ((5 19 1871) "10:46" 0 "")
+ ((5 27 1871) "13:02" 1 ""))))))
(ert-deftest lunar-test-new-moon-time ()
(with-lunar-test
diff --git a/test/lisp/calendar/solar-tests.el
b/test/lisp/calendar/solar-tests.el
index 7a37f8d..337deb8 100644
--- a/test/lisp/calendar/solar-tests.el
+++ b/test/lisp/calendar/solar-tests.el
@@ -26,7 +26,9 @@
(calendar-longitude 75.8)
(calendar-time-zone +330)
(calendar-standard-time-zone-name "IST")
- (calendar-daylight-time-zone-name "IST")
+ ;; Make sure our clockwork isn't confused by daylight saving rules
+ ;; in effect for any other time zone (bug#45818).
+ (calendar-daylight-savings-starts nil)
(epsilon (/ 60.0))) ; Minute accuracy is good enough.
(let* ((sunrise-sunset (solar-sunrise-sunset '(12 30 2020)))
(sunrise (car (nth 0 sunrise-sunset)))
diff --git a/test/lisp/cedet/semantic-utest.el
b/test/lisp/cedet/semantic-utest.el
index c009938..67de4a5 100644
--- a/test/lisp/cedet/semantic-utest.el
+++ b/test/lisp/cedet/semantic-utest.el
@@ -577,10 +577,8 @@ INSERTME is the text to be inserted after the deletion."
(ert-deftest semantic-utest-Javascript()
- (if (fboundp 'javascript-mode)
- (semantic-utest-generic (semantic-utest-fname "javascripttest.js")
semantic-utest-Javascript-buffer-contents
semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line")
- (message "Skipping JavaScript test: NO major mode."))
- )
+ (skip-unless (fboundp 'javascript-mode))
+ (semantic-utest-generic (semantic-utest-fname "javascripttest.js")
semantic-utest-Javascript-buffer-contents
semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line"))
(ert-deftest semantic-utest-Java()
;; If JDE is installed, it might mess things up depending on the version
diff --git a/test/lisp/cedet/srecode-utest-getset.el
b/test/lisp/cedet/srecode-utest-getset.el
index 0497dea..1c65780 100644
--- a/test/lisp/cedet/srecode-utest-getset.el
+++ b/test/lisp/cedet/srecode-utest-getset.el
@@ -128,7 +128,6 @@ private:
(srecode-utest-getset-jumptotag "miscFunction"))
(let ((pos (point)))
- (skip-chars-backward " \t\n") ; xemacs forward-comment is different.
(forward-comment -1)
(re-search-forward "miscFunction" pos))
diff --git a/test/lisp/cedet/srecode-utest-template.el
b/test/lisp/cedet/srecode-utest-template.el
index 57d8a64..f97ff18 100644
--- a/test/lisp/cedet/srecode-utest-template.el
+++ b/test/lisp/cedet/srecode-utest-template.el
@@ -307,13 +307,9 @@ INSIDE SECTION: ARG HANDLER ONE")
(should (srecode-table major-mode))
;; Loop over the output testpoints.
-
(dolist (p srecode-utest-output-entries)
- (set-buffer testbuff) ;; XEmacs causes a buffer switch. I don't know
why
- (should-not (srecode-utest-test p))
- )
+ (should-not (srecode-utest-test p)))))
- ))
(when (file-exists-p srecode-utest-testfile)
(delete-file srecode-utest-testfile)))
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el
b/test/lisp/emacs-lisp/cl-macs-tests.el
index 446983c..bcd63f7 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -610,4 +610,27 @@ collection clause."
;; Just make sure the function can be instrumented.
(edebug-defun)))
+;;; cl-labels
+
+(ert-deftest cl-macs--labels ()
+ ;; Simple recursive function.
+ (cl-labels ((len (xs) (if xs (1+ (len (cdr xs))) 0)))
+ (should (equal (len (make-list 42 t)) 42)))
+
+ ;; Simple tail-recursive function.
+ (cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)))
+ (should (equal (len (make-list 42 t) 0) 42))
+ ;; Should not bump into stack depth limits.
+ (should (equal (len (make-list 42000 t) 0) 42000)))
+
+ ;; Check that non-recursive functions are handled more efficiently.
+ (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5)))
+ (`(let* ,_ (funcall ,_ 5)) t)))
+
+ ;; Case of "tail-recursive lambdas".
+ (should (pcase (macroexpand
+ '(cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)))
+ #'len))
+ (`(function (lambda (,_ ,_) . ,_)) t))))
+
;;; cl-macs-tests.el ends here
diff --git a/test/lisp/emacs-lisp/timer-tests.el
b/test/lisp/emacs-lisp/timer-tests.el
index 74da33e..7856c21 100644
--- a/test/lisp/emacs-lisp/timer-tests.el
+++ b/test/lisp/emacs-lisp/timer-tests.el
@@ -36,8 +36,8 @@
(ert-deftest timer-tests-debug-timer-check ()
;; This function exists only if --enable-checking.
- (if (fboundp 'debug-timer-check)
- (should (debug-timer-check)) t))
+ (skip-unless (fboundp 'debug-timer-check))
+ (should (debug-timer-check)))
(ert-deftest timer-test-multiple-of-time ()
(should (time-equal-p
diff --git a/test/lisp/gnus/mm-decode-resources/win1252-multipart.bin
b/test/lisp/gnus/mm-decode-resources/win1252-multipart.bin
new file mode 100644
index 0000000..d3c5026
--- /dev/null
+++ b/test/lisp/gnus/mm-decode-resources/win1252-multipart.bin
@@ -0,0 +1,44 @@
+To: example <example@example.org>
+From: example <example@example.org>
+Date: Tue, 5 Jan 2021 10:30:34 +0100
+MIME-Version: 1.0
+Content-Type: multipart/mixed; boundary="------------FB569A4368539497CC91D1DC"
+Content-Language: fr
+Subject: test
+
+--------------FB569A4368539497CC91D1DC
+Content-Type: multipart/alternative;
+ boundary="------------61C81A7DC7592E4C6F856A85"
+
+
+--------------61C81A7DC7592E4C6F856A85
+Content-Type: text/plain; charset=windows-1252; format=flowed
+Content-Transfer-Encoding: 8bit
+
+d�j� rat�
+
+--------------61C81A7DC7592E4C6F856A85
+Content-Type: text/html; charset=windows-1252
+Content-Transfer-Encoding: 8bit
+
+<html>
+ <head>
+ <meta http-equiv="content-type" content="text/html; charset=windows-1252">
+ </head>
+ <body>
+ d�j� rat�
+ </body>
+</html>
+
+--------------61C81A7DC7592E4C6F856A85--
+
+--------------FB569A4368539497CC91D1DC
+Content-Type: text/plain; charset="us-ascii"
+MIME-Version: 1.0
+Content-Transfer-Encoding: 7bit
+Content-Disposition: inline
+
+mailing list signature
+
+--------------FB569A4368539497CC91D1DC--
+
diff --git a/test/lisp/gnus/mm-decode-tests.el
b/test/lisp/gnus/mm-decode-tests.el
index 74591f9..7d059cb 100644
--- a/test/lisp/gnus/mm-decode-tests.el
+++ b/test/lisp/gnus/mm-decode-tests.el
@@ -70,20 +70,33 @@
'charset)))
"ääää\n"))))))
-(ert-deftest test-mm-with-part-multibyte ()
+(ert-deftest test-mm-dissect-buffer-win1252 ()
(with-temp-buffer
- (set-buffer-multibyte t)
- (nnheader-insert-file-contents (ert-resource-file "8bit-multipart.bin"))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n"))
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally (ert-resource-file
"win1252-multipart.bin"))
(let ((handle (mm-dissect-buffer)))
+ (should (equal (mm-handle-media-type handle) "multipart/mixed"))
+ ;; Skip multipart type.
+ (pop handle)
+ (setq handle (car handle))
(pop handle)
(let ((part (pop handle)))
- (should (equal (decode-coding-string
- (mm-with-part part
- (buffer-string))
- (intern (mail-content-type-get (mm-handle-type part)
- 'charset)))
- "ääää\n"))))))
+ (should (equal (mm-handle-media-type part) "text/plain"))
+ (should (eq (mm-handle-encoding part) '8bit))
+ (with-current-buffer (mm-handle-buffer part)
+ (should (equal (decode-coding-string
+ (buffer-string)
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "déjà raté\n"))))
+ (let ((part (pop handle)))
+ (should (equal (mm-handle-media-type part) "text/html"))
+ (should (eq (mm-handle-encoding part) '8bit))
+ (with-current-buffer (mm-handle-buffer part)
+ (should (equal (decode-coding-string
+ (buffer-string)
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "<html>\n <head>\n <meta
http-equiv=\"content-type\" content=\"text/html; charset=windows-1252\">\n
</head>\n <body>\n déjà raté\n </body>\n</html>\n")))))))
;;; mm-decode-tests.el ends here
diff --git a/test/lisp/help-mode-tests.el b/test/lisp/help-mode-tests.el
index e0e82c9..43db59d 100644
--- a/test/lisp/help-mode-tests.el
+++ b/test/lisp/help-mode-tests.el
@@ -72,14 +72,19 @@ Lisp concepts such as car, cdr, cons cell and list.")
#'info)))))
(ert-deftest help-mode-tests-xref-button ()
- (with-temp-buffer
- (insert "See also the function ‘interactive’.")
- (string-match help-xref-symbol-regexp (buffer-string))
- (help-xref-button 8 'help-function)
- (should-not (button-at 22))
- (should-not (button-at 35))
- (let ((button (button-at 30)))
- (should (eq (button-type button) 'help-function)))))
+ (let* ((fmt "See also the function ‘%s’.")
+ ;; 1+ translates string index to buffer position.
+ (beg (1+ (string-search "%" fmt))))
+ (with-temp-buffer
+ (dolist (fn '(interactive \` = + - * / %))
+ (erase-buffer)
+ (insert (format fmt fn))
+ (goto-char (point-min))
+ (re-search-forward help-xref-symbol-regexp)
+ (help-xref-button 8 'help-function)
+ (should-not (button-at (1- beg)))
+ (should-not (button-at (+ beg (length (symbol-name fn)))))
+ (should (eq (button-type (button-at beg)) 'help-function))))))
(ert-deftest help-mode-tests-insert-xref-button ()
(with-temp-buffer
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 835d9fe..8034764 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -95,7 +95,7 @@
key binding
--- -------
-C-g abort-recursive-edit
+C-g abort-minibuffers
TAB minibuffer-complete
C-j minibuffer-complete-and-exit
RET minibuffer-complete-and-exit
@@ -122,7 +122,7 @@ M-s next-matching-history-element
(ert-deftest help-tests-substitute-command-keys/keymap-change ()
(with-substitute-command-keys-test
- (test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-g")
+ (test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-]")
(test "\\<emacs-lisp-mode-map>\\[eval-defun]" "C-M-x")))
(defvar help-tests-remap-map
diff --git a/test/lisp/net/nsm-tests.el b/test/lisp/net/nsm-tests.el
index 88c30c2..ff45331 100644
--- a/test/lisp/net/nsm-tests.el
+++ b/test/lisp/net/nsm-tests.el
@@ -49,15 +49,17 @@
(should (eq nil (nsm-should-check "127.0.0.1")))
(should (eq nil (nsm-should-check "localhost"))))))
-(defun nsm-ipv6-is-available ()
+;; This will need updating when IANA assign more IPv6 global ranges.
+(defun ipv6-is-available ()
(and (featurep 'make-network-process '(:family ipv6))
(cl-rassoc-if
(lambda (elt)
- (eq 9 (length elt)))
+ (and (eq 9 (length elt))
+ (= (logand (aref elt 0) #xe000) #x2000)))
(network-interface-list))))
(ert-deftest nsm-check-local-subnet-ipv6 ()
- (skip-unless (nsm-ipv6-is-available))
+ (skip-unless (ipv6-is-available))
(let ((local-ip '[123 456 789 11 172 26 128 160 0])
(mask '[255 255 255 255 255 255 255 0 0])
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
new file mode 100644
index 0000000..b378ed2
--- /dev/null
+++ b/test/lisp/net/socks-tests.el
@@ -0,0 +1,103 @@
+;;; socks-tests.el --- tests for SOCKS -*- coding: utf-8; lexical-binding: t;
-*-
+
+;; 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/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'socks)
+(require 'url-http)
+
+(defvar socks-tests-canned-server-port nil)
+
+(defun socks-tests-canned-server-create (verbatim patterns)
+ "Create a fake SOCKS server and return the process.
+
+`VERBATIM' and `PATTERNS' are dotted alists containing responses.
+Requests are tried in order. On failure, an error is raised."
+ (let* ((buf (generate-new-buffer "*canned-socks-server*"))
+ (filt (lambda (proc line)
+ (let ((resp (or (assoc-default line verbatim
+ (lambda (k s) ; s is line
+ (string= (concat k) s)))
+ (assoc-default line patterns
+ (lambda (p s)
+ (string-match-p p s))))))
+ (unless resp
+ (error "Unknown request: %s" line))
+ (let ((print-escape-control-characters t))
+ (princ (format "<- %s\n" (prin1-to-string line)) buf)
+ (princ (format "-> %s\n" (prin1-to-string resp)) buf))
+ (process-send-string proc (concat resp)))))
+ (srv (make-network-process :server 1
+ :buffer buf
+ :filter filt
+ :name "server"
+ :family 'ipv4
+ :host 'local
+ :service socks-tests-canned-server-port)))
+ (set-process-query-on-exit-flag srv nil)
+ (princ (format "[%s] Listening on localhost:10080\n" srv) buf)
+ srv))
+
+;; Add ([5 3 0 1 2] . [5 2]) to the `verbatim' list below to validate
+;; against curl 7.71 with the following options:
+;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com
+;;
+;; If later implementing version 4a, try these:
+;; [4 1 0 80 0 0 0 1 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] . [0 90 0 0 0 0 0 0]
+;; $ curl --verbose --proxy socks4a://127.0.0.1:10080 example.com
+
+(ert-deftest socks-tests-auth-filter-url-http ()
+ "Verify correct handling of SOCKS5 user/pass authentication."
+ (let* ((socks-server '("server" "127.0.0.1" 10080 5))
+ (socks-username "foo")
+ (socks-password "bar")
+ (url-gateway-method 'socks)
+ (url (url-generic-parse-url "http://example.com";))
+ (verbatim '(([5 2 0 2] . [5 2])
+ ([1 3 ?f ?o ?o 3 ?b ?a ?r] . [1 0])
+ ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
+ . [5 0 0 1 0 0 0 0 0 0])))
+ (patterns
+ `(("^GET /" . ,(concat "HTTP/1.1 200 OK\r\n"
+ "Content-Type: text/plain; charset=UTF-8\r\n"
+ "Content-Length: 13\r\n\r\n"
+ "Hello World!\n"))))
+ (socks-tests-canned-server-port 10080)
+ (server (socks-tests-canned-server-create verbatim patterns))
+ (tries 10)
+ ;;
+ done
+ ;;
+ (cb (lambda (&rest _r)
+ (goto-char (point-min))
+ (should (search-forward "Hello World" nil t))
+ (setq done t)))
+ (buf (url-http url cb '(nil))))
+ (ert-info ("Connect to HTTP endpoint over SOCKS5 with USER/PASS method")
+ (while (and (not done) (< 0 (cl-decf tries))) ; cl-lib via url-http
+ (sleep-for 0.1)))
+ (should done)
+ (delete-process server)
+ (kill-buffer (process-buffer server))
+ (kill-buffer buf)
+ (ignore url-gateway-method)))
+
+;;; socks-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index e1cb993..ef0968a 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -78,6 +78,8 @@
;; Needed for Emacs 27.
(defvar process-file-return-signal-string)
(defvar shell-command-dont-erase-buffer)
+;; Needed for Emacs 28.
+(defvar dired-copy-dereference)
;; Beautify batch mode.
(when noninteractive
@@ -98,7 +100,6 @@
'("mock"
(tramp-login-program "sh")
(tramp-login-args (("-i")))
- (tramp-direct-async-args (("-c")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
@@ -2438,7 +2439,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
;; We must check the last line. There could be
;; other messages from the progress reporter.
(should
- (string-match
+ (string-match-p
(if (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(format "^Wrote %s\n\\'" (regexp-quote tmp-name))
@@ -2833,6 +2834,7 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ert-deftest tramp-test15-copy-directory ()
"Check `copy-directory'."
(skip-unless (tramp--test-enabled))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
@@ -3067,9 +3069,7 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(regexp-opt (directory-files tmp-name1))
(length (directory-files tmp-name1)))))))
- ;; Check error case. We do not check for the error type,
- ;; because ls-lisp returns `file-error', and native Tramp
- ;; returns `file-missing'.
+ ;; Check error case.
(delete-directory tmp-name1 'recursive)
(with-temp-buffer
(should-error
@@ -3188,6 +3188,59 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ignore-errors (delete-directory tmp-name1 'recursive))
(ignore-errors (delete-directory tmp-name2 'recursive))))))
+;; The following test is inspired by Bug#45691.
+(ert-deftest tramp-test17-insert-directory-one-file ()
+ "Check `insert-directory' inside directory listing."
+ (skip-unless (tramp--test-enabled))
+
+ (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (let* ((tmp-name1
+ (expand-file-name (tramp--test-make-temp-name nil quoted)))
+ (tmp-name2 (expand-file-name "foo" tmp-name1))
+ (tmp-name3 (expand-file-name "bar" tmp-name1))
+ (dired-copy-preserve-time t)
+ (dired-recursive-copies 'top)
+ dired-copy-dereference
+ buffer)
+ (unwind-protect
+ (progn
+ (make-directory tmp-name1)
+ (write-region "foo" nil tmp-name2)
+ (should (file-directory-p tmp-name1))
+ (should (file-exists-p tmp-name2))
+
+ ;; Check, that `insert-directory' works properly.
+ (with-current-buffer
+ (setq buffer (dired-noselect tmp-name1 "--dired -al"))
+ (read-only-mode -1)
+ (goto-char (point-min))
+ (while (not (or (eobp)
+ (string-equal
+ (dired-get-filename 'localp 'no-error)
+ (file-name-nondirectory tmp-name2))))
+ (forward-line 1))
+ (should-not (eobp))
+ (copy-file tmp-name2 tmp-name3)
+ (insert-directory
+ (file-name-nondirectory tmp-name3) "--dired -al -d")
+ ;; Point shall still be the recent file.
+ (should
+ (string-equal
+ (dired-get-filename 'localp 'no-error)
+ (file-name-nondirectory tmp-name2)))
+ (should-not (re-search-forward "dired" nil t))
+ ;; The copied file has been inserted the line before.
+ (forward-line -1)
+ (should
+ (string-equal
+ (dired-get-filename 'localp 'no-error)
+ (file-name-nondirectory tmp-name3))))
+ (kill-buffer buffer))
+
+ ;; Cleanup.
+ (ignore-errors (kill-buffer buffer))
+ (ignore-errors (delete-directory tmp-name1 'recursive))))))
+
;; Method "smb" supports `make-symbolic-link' only if the remote host
;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el and
;; tramp-rclone.el do not support symbolic links at all.
@@ -3561,8 +3614,8 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
`(condition-case err
(progn ,@body)
(file-error
- (unless (string-match "^error with add-name-to-file"
- (error-message-string err))
+ (unless (string-match-p "^error with add-name-to-file"
+ (error-message-string err))
(signal (car err) (cdr err))))))
(ert-deftest tramp-test21-file-links ()
@@ -4337,7 +4390,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; there's an indication for a signal describing string.
(let ((process-file-return-signal-string t))
(should
- (string-match
+ (string-match-p
"Interrupt\\|Signal 2"
(process-file
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
@@ -4405,7 +4458,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4424,7 +4477,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors
@@ -4446,7 +4499,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4488,8 +4541,6 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(cons '(nil "direct-async-process" t)
tramp-connection-properties)))
(skip-unless (tramp-direct-async-process-p))
- ;; For whatever reason, it doesn't cooperate with the "mock" method.
- (skip-unless (not (tramp--test-mock-p)))
;; We do expect an established connection already,
;; `file-truename' does it by side-effect. Suppress
;; `tramp--test-enabled', in order to keep the connection.
@@ -4535,7 +4586,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4556,7 +4607,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors
@@ -4580,9 +4631,9 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
- (while (not (string-match "foo" (buffer-string)))
+ (while (not (string-match-p "foo" (buffer-string)))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4607,7 +4658,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
;; On some MS Windows systems, it returns "unknown signal".
- (should (string-match "unknown signal\\|killed" (buffer-string))))
+ (should (string-match-p "unknown signal\\|killed" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4631,7 +4682,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(delete-process proc)
(with-current-buffer stderr
(should
- (string-match
+ (string-match-p
"cat:.* No such file or directory" (buffer-string)))))
;; Cleanup.
@@ -4658,7 +4709,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(with-temp-buffer
(insert-file-contents tmpfile)
(should
- (string-match
+ (string-match-p
"cat:.* No such file or directory" (buffer-string)))))
;; Cleanup.
@@ -4801,7 +4852,7 @@ INPUT, if non-nil, is a string sent to the process."
(should
(string-equal
;; tramp-adb.el echoes, so we must add the string.
- (if (tramp--test-adb-p)
+ (if (and (tramp--test-adb-p) (not (tramp-direct-async-process-p)))
(format
"%s\n%s\n"
(file-name-nondirectory tmp-name)
@@ -4992,7 +5043,7 @@ INPUT, if non-nil, is a string sent to the process."
(cons (concat envvar "=foo") process-environment)))
;; Default value.
(should
- (string-match
+ (string-match-p
"foo"
(funcall
this-shell-command-to-string
@@ -5003,13 +5054,13 @@ INPUT, if non-nil, is a string sent to the process."
(cons (concat envvar "=") process-environment)))
;; Value is null.
(should
- (string-match
+ (string-match-p
"bla"
(funcall
this-shell-command-to-string (format "echo \"${%s:-bla}\"" envvar))))
;; Variable is set.
(should
- (string-match
+ (string-match-p
(regexp-quote envvar)
(funcall this-shell-command-to-string "set"))))
@@ -5021,7 +5072,7 @@ INPUT, if non-nil, is a string sent to the process."
(cons (concat envvar "=foo") tramp-remote-process-environment)))
;; Set the initial value, we want to unset below.
(should
- (string-match
+ (string-match-p
"foo"
(funcall
this-shell-command-to-string
@@ -5029,14 +5080,14 @@ INPUT, if non-nil, is a string sent to the process."
(let ((process-environment (cons envvar process-environment)))
;; Variable is unset.
(should
- (string-match
+ (string-match-p
"bla"
(funcall
this-shell-command-to-string
(format "echo \"${%s:-bla}\"" envvar))))
;; Variable is unset.
(should-not
- (string-match
+ (string-match-p
(regexp-quote envvar)
;; We must remove PS1, the output is truncated otherwise.
(funcall
@@ -5074,7 +5125,7 @@ Use direct async.")
(format "%s=%d" envvar port)
tramp-remote-process-environment)))
(should
- (string-match
+ (string-match-p
(number-to-string port)
(shell-command-to-string (format "echo $%s" envvar))))))
@@ -5202,7 +5253,7 @@ Use direct async.")
(with-timeout (10)
(while (accept-process-output
(get-buffer-process (current-buffer)) nil nil t)))
- (should (string-match "^foo$" (buffer-string)))))
+ (should (string-match-p "^foo$" (buffer-string)))))
;; Cleanup.
(put 'explicit-shell-file-name 'permanent-local nil)
@@ -5337,25 +5388,27 @@ Use direct async.")
(tramp-remote-process-environment tramp-remote-process-environment)
(inhibit-message t)
(vc-handled-backends
- (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
- (cond
- ((tramp-find-executable
- v vc-git-program (tramp-get-remote-path v))
- '(Git))
- ((tramp-find-executable
- v vc-hg-program (tramp-get-remote-path v))
- '(Hg))
- ((tramp-find-executable
- v vc-bzr-program (tramp-get-remote-path v))
- (setq tramp-remote-process-environment
- (cons (format "BZR_HOME=%s"
- (file-remote-p tmp-name1 'localname))
- tramp-remote-process-environment))
- ;; We must force a reconnect, in order to activate $BZR_HOME.
- (tramp-cleanup-connection
- tramp-test-vec 'keep-debug 'keep-password)
- '(Bzr))
- (t nil))))
+ (cond
+ ((tramp-find-executable
+ tramp-test-vec vc-git-program
+ (tramp-get-remote-path tramp-test-vec))
+ '(Git))
+ ((tramp-find-executable
+ tramp-test-vec vc-hg-program
+ (tramp-get-remote-path tramp-test-vec))
+ '(Hg))
+ ((tramp-find-executable
+ tramp-test-vec vc-bzr-program
+ (tramp-get-remote-path tramp-test-vec))
+ (setq tramp-remote-process-environment
+ (cons (format "BZR_HOME=%s"
+ (file-remote-p tmp-name1 'localname))
+ tramp-remote-process-environment))
+ ;; We must force a reconnect, in order to activate $BZR_HOME.
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ '(Bzr))
+ (t nil)))
;; Suppress nasty messages.
(inhibit-message t))
(skip-unless vc-handled-backends)
@@ -5681,7 +5734,7 @@ This does not support some special file names."
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
;; Globbing characters are ??, ?* and ?\[.
- (string-match
+ (string-match-p
"ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
(defun tramp--test-gvfs-p (&optional method)
@@ -5695,18 +5748,18 @@ If optional METHOD is given, it is checked first."
"Check, whether the remote host runs HP-UX.
Several special characters do not work properly there."
;; We must refill the cache. `file-truename' does it.
- (with-parsed-tramp-file-name
- (file-truename tramp-test-temporary-file-directory) nil
- (string-match "^HP-UX" (tramp-get-connection-property v "uname" ""))))
+ (file-truename tramp-test-temporary-file-directory) nil
+ (string-match-p
+ "^HP-UX" (tramp-get-connection-property tramp-test-vec "uname" "")))
(defun tramp--test-ksh-p ()
"Check, whether the remote shell is ksh.
ksh93 makes some strange conversions of non-latin characters into
a $'' syntax."
;; We must refill the cache. `file-truename' does it.
- (with-parsed-tramp-file-name
- (file-truename tramp-test-temporary-file-directory) nil
- (string-match "ksh$" (tramp-get-connection-property v "remote-shell" ""))))
+ (file-truename tramp-test-temporary-file-directory) nil
+ (string-match-p
+ "ksh$" (tramp-get-connection-property tramp-test-vec "remote-shell" "")))
(defun tramp--test-mock-p ()
"Check, whether the mock method is used.
@@ -5758,7 +5811,7 @@ This does not support special characters."
"Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
This does not support utf8 based file transfer."
(and (eq system-type 'windows-nt)
- (string-match
+ (string-match-p
(regexp-opt '("pscp" "psftp"))
(file-remote-p tramp-test-temporary-file-directory 'method))))
@@ -6021,6 +6074,7 @@ This requires restrictions of file name syntax."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(tramp--test-special-characters))
@@ -6032,6 +6086,8 @@ Use the `stat' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ ;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -6050,6 +6106,8 @@ Use the `perl' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ ;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -6072,6 +6130,7 @@ Use the `ls' command."
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(let ((tramp-connection-properties
(append
@@ -6140,6 +6199,7 @@ Use the `ls' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(tramp--test-utf8))
@@ -6155,6 +6215,8 @@ Use the `stat' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ ;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -6177,6 +6239,8 @@ Use the `perl' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ ;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -6202,6 +6266,7 @@ Use the `ls' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(let ((tramp-connection-properties
(append
@@ -6490,7 +6555,7 @@ process sentinels. They shall not disturb each other."
(message \"Tramp loaded: %%s\" (and (file-remote-p %S) t)))"
tramp-test-temporary-file-directory)))
(should
- (string-match
+ (string-match-p
"Tramp loaded: t[\n\r]+"
(shell-command-to-string
(format
@@ -6521,7 +6586,7 @@ process sentinels. They shall not disturb each other."
;; Tramp doesn't load when `tramp-mode' is nil.
(dolist (tm '(t nil))
(should
- (string-match
+ (string-match-p
(format
"Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded:
%s[\n\r]+"
tm)
@@ -6547,7 +6612,7 @@ process sentinels. They shall not disturb each other."
tramp-test-temporary-file-directory
temporary-file-directory)))
(should-not
- (string-match
+ (string-match-p
"Recursive load"
(shell-command-to-string
(format
@@ -6572,7 +6637,7 @@ process sentinels. They shall not disturb each other."
(load-path (cons \"/foo:bar:\" load-path))) \
(tramp-cleanup-all-connections))"))
(should
- (string-match
+ (string-match-p
(format
"Loading %s"
(regexp-quote
@@ -6619,11 +6684,11 @@ Since it unloads Tramp, it shall be the last test to
run."
(lambda (x)
(and (or (and (boundp x) (null (local-variable-if-set-p x)))
(and (functionp x) (null (autoloadp (symbol-function x)))))
- (string-match "^tramp" (symbol-name x))
+ (string-match-p "^tramp" (symbol-name x))
;; `tramp-completion-mode' is autoloaded in Emacs < 28.1.
(not (eq 'tramp-completion-mode x))
- (not (string-match "^tramp\\(-archive\\)?--?test" (symbol-name x)))
- (not (string-match "unload-hook$" (symbol-name x)))
+ (not (string-match-p "^tramp\\(-archive\\)?--?test" (symbol-name x)))
+ (not (string-match-p "unload-hook$" (symbol-name x)))
(ert-fail (format "`%s' still bound" x)))))
;; The defstruct `tramp-file-name' and all its internal functions
;; shall be purged.
@@ -6631,15 +6696,15 @@ Since it unloads Tramp, it shall be the last test to
run."
(mapatoms
(lambda (x)
(and (functionp x)
- (string-match "tramp-file-name" (symbol-name x))
+ (string-match-p "tramp-file-name" (symbol-name x))
(ert-fail (format "Structure function `%s' still exists" x)))))
;; There shouldn't be left a hook function containing a Tramp
;; function. We do not regard the Tramp unload hooks.
(mapatoms
(lambda (x)
(and (boundp x)
- (string-match "-\\(hook\\|function\\)s?$" (symbol-name x))
- (not (string-match "unload-hook$" (symbol-name x)))
+ (string-match-p "-\\(hook\\|function\\)s?$" (symbol-name x))
+ (not (string-match-p "unload-hook$" (symbol-name x)))
(consp (symbol-value x))
(ignore-errors (all-completions "tramp" (symbol-value x)))
(ert-fail (format "Hook `%s' still contains Tramp function" x))))))
diff --git a/test/lisp/progmodes/tcl-tests.el b/test/lisp/progmodes/tcl-tests.el
index 8ff8547..cf1ed28 100644
--- a/test/lisp/progmodes/tcl-tests.el
+++ b/test/lisp/progmodes/tcl-tests.el
@@ -50,14 +50,14 @@
(insert "proc notinthis {} {\n # nothing\n}\n\n")
(should-not (add-log-current-defun))))
-(ert-deftest tcl-mode-function-name ()
+(ert-deftest tcl-mode-function-name-2 ()
(with-temp-buffer
(tcl-mode)
(insert "proc simple {} {\n # nothing\n}")
(backward-char 3)
(should (equal "simple" (add-log-current-defun)))))
-(ert-deftest tcl-mode-function-name ()
+(ert-deftest tcl-mode-function-name-3 ()
(with-temp-buffer
(tcl-mode)
(insert "proc inthis {} {\n # nothing\n")
@@ -72,6 +72,16 @@
(indent-region (point-min) (point-max))
(should (equal (buffer-string) text)))))
+;; From bug#44834
+(ert-deftest tcl-mode-namespace-indent-2 ()
+ :expected-result :failed
+ (with-temp-buffer
+ (tcl-mode)
+ (let ((text "namespace eval Foo {\n proc foo {} {}\n\n proc bar
{}{}}\n"))
+ (insert text)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) text)))))
+
(provide 'tcl-tests)
;;; tcl-tests.el ends here
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 245a4a7..843981f 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -87,6 +87,17 @@
;; Returns the symbol.
(should (eq (define-prefix-command 'foo-bar) 'foo-bar)))
+(ert-deftest subr-test-local-key-binding ()
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (should (keymapp (local-key-binding [menu-bar])))
+ (should-not (local-key-binding [f12]))))
+
+(ert-deftest subr-test-global-key-binding ()
+ (should (eq (global-key-binding [f1]) 'help-command))
+ (should (eq (global-key-binding "x") 'self-insert-command))
+ (should-not (global-key-binding [f12])))
+
;;;; Mode hooks.
@@ -433,6 +444,15 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350.";
(should (equal (flatten-tree '(1 ("foo" "bar") 2))
'(1 "foo" "bar" 2))))
+(ert-deftest subr--tests-letrec ()
+ ;; Test that simple cases of `letrec' get optimized back to `let*'.
+ (should (equal (macroexpand '(letrec ((subr-tests-var1 1)
+ (subr-tests-var2 subr-tests-var1))
+ (+ subr-tests-var1 subr-tests-var2)))
+ '(let* ((subr-tests-var1 1)
+ (subr-tests-var2 subr-tests-var1))
+ (+ subr-tests-var1 subr-tests-var2)))))
+
(defvar subr-tests--hook nil)
(ert-deftest subr-tests-add-hook-depth ()
diff --git a/test/lisp/textmodes/fill-tests.el
b/test/lisp/textmodes/fill-tests.el
index f2c63a9..21efe62 100644
--- a/test/lisp/textmodes/fill-tests.el
+++ b/test/lisp/textmodes/fill-tests.el
@@ -44,6 +44,37 @@
(fill-paragraph)
(should (string= (buffer-string) "Abc\nd efg\n(h ijk)."))))
+(ert-deftest fill-test-unbreakable-paragraph ()
+ (with-temp-buffer
+ (let ((string "aaa = baaaaaaaaaaaaaaaaaaaaaaaaaaaa\n"))
+ (insert string)
+ (goto-char (point-min))
+ (search-forward "b")
+ (let* ((pos (point))
+ (beg (line-beginning-position))
+ (end (line-end-position))
+ (fill-prefix (make-string (- pos beg) ?\s))
+ ;; `fill-column' is too small to accomodate the current line
+ (fill-column (- end beg 10)))
+ (fill-region-as-paragraph beg end nil nil pos))
+ (should (equal (buffer-string) string)))))
+
+(ert-deftest fill-test-breakable-paragraph ()
+ (with-temp-buffer
+ (let ((string "aaa = baaaaaaaa aaaaaaaaaa aaaaaaaaaa\n"))
+ (insert string)
+ (goto-char (point-min))
+ (search-forward "b")
+ (let* ((pos (point))
+ (beg (line-beginning-position))
+ (end (line-end-position))
+ (fill-prefix (make-string (- pos beg) ?\s))
+ ;; `fill-column' is too small to accomodate the current line
+ (fill-column (- end beg 10)))
+ (fill-region-as-paragraph beg end nil nil pos))
+ (should (equal
+ (buffer-string)
+ "aaa = baaaaaaaa aaaaaaaaaa\n aaaaaaaaaa\n")))))
(provide 'fill-tests)
diff --git a/test/src/decompress-tests.el b/test/src/decompress-tests.el
index 67a7fef..520445c 100644
--- a/test/src/decompress-tests.el
+++ b/test/src/decompress-tests.el
@@ -29,16 +29,16 @@
(ert-deftest zlib--decompress ()
"Test decompressing a gzipped file."
- (when (and (fboundp 'zlib-available-p)
- (zlib-available-p))
- (should (string=
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-file-contents-literally
- (expand-file-name "foo.gz" zlib-tests-data-directory))
- (zlib-decompress-region (point-min) (point-max))
- (buffer-string))
- "foo\n"))))
+ (skip-unless (and (fboundp 'zlib-available-p)
+ (zlib-available-p)))
+ (should (string=
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally
+ (expand-file-name "foo.gz" zlib-tests-data-directory))
+ (zlib-decompress-region (point-min) (point-max))
+ (buffer-string))
+ "foo\n")))
(provide 'decompress-tests)
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index a9daf87..e0aed2a 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -1040,3 +1040,61 @@
(let ((list (list 1)))
(setcdr list list)
(length< list #x1fffe))))
+
+(defun approx-equal (list1 list2)
+ (and (equal (length list1) (length list2))
+ (cl-loop for v1 in list1
+ for v2 in list2
+ when (not (or (= v1 v2)
+ (< (abs (- v1 v2)) 0.1)))
+ return nil
+ finally return t)))
+
+(ert-deftest test-buffer-line-stats-nogap ()
+ (with-temp-buffer
+ (insert "")
+ (should (approx-equal (buffer-line-statistics) '(0 0 0))))
+ (with-temp-buffer
+ (insert "123\n")
+ (should (approx-equal (buffer-line-statistics) '(1 3 3))))
+ (with-temp-buffer
+ (insert "123\n12345\n123\n")
+ (should (approx-equal (buffer-line-statistics) '(3 5 3.66))))
+ (with-temp-buffer
+ (insert "123\n12345\n123")
+ (should (approx-equal (buffer-line-statistics) '(3 5 3.66))))
+ (with-temp-buffer
+ (insert "123\n12345")
+ (should (approx-equal (buffer-line-statistics) '(2 5 4))))
+
+ (with-temp-buffer
+ (insert "123\n12é45\n123\n")
+ (should (approx-equal (buffer-line-statistics) '(3 6 4))))
+
+ (with-temp-buffer
+ (insert "\n\n\n")
+ (should (approx-equal (buffer-line-statistics) '(3 0 0)))))
+
+(ert-deftest test-buffer-line-stats-gap ()
+ (with-temp-buffer
+ (dotimes (_ 1000)
+ (insert "12345678901234567890123456789012345678901234567890\n"))
+ (goto-char (point-min))
+ ;; This should make a gap appear.
+ (insert "123\n")
+ (delete-region (point-min) (point))
+ (should (approx-equal (buffer-line-statistics) '(1000 50 50.0))))
+ (with-temp-buffer
+ (dotimes (_ 1000)
+ (insert "12345678901234567890123456789012345678901234567890\n"))
+ (goto-char (point-min))
+ (insert "123\n")
+ (should (approx-equal (buffer-line-statistics) '(1001 50 49.9))))
+ (with-temp-buffer
+ (dotimes (_ 1000)
+ (insert "12345678901234567890123456789012345678901234567890\n"))
+ (goto-char (point-min))
+ (insert "123\n")
+ (goto-char (point-max))
+ (insert "fóo")
+ (should (approx-equal (buffer-line-statistics) '(1002 50 49.9)))))
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index edf8821..f2a60bc 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -190,4 +190,10 @@ literals (Bug#20852)."
(ert-deftest lread-circular-hash ()
(should-error (read "#s(hash-table data #0=(#0# . #0#))")))
+(ert-deftest test-inhibit-interaction ()
+ (let ((inhibit-interaction t))
+ (should-error (read-char "foo: "))
+ (should-error (read-event "foo: "))
+ (should-error (read-char-exclusive "foo: "))))
+
;;; lread-tests.el ends here
diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el
index b9cd255..28119fc 100644
--- a/test/src/minibuf-tests.el
+++ b/test/src/minibuf-tests.el
@@ -410,5 +410,20 @@
(should (equal (try-completion "baz" '("bAz" "baz"))
(try-completion "baz" '("baz" "bAz"))))))
+(ert-deftest test-inhibit-interaction ()
+ (let ((inhibit-interaction t))
+ (should-error (read-from-minibuffer "foo: "))
+
+ (should-error (y-or-n-p "foo: "))
+ (should-error (yes-or-no-p "foo: "))
+ (should-error (read-blanks-no-input "foo: "))
+
+ ;; See that we get the expected error.
+ (should (eq (condition-case nil
+ (read-from-minibuffer "foo: ")
+ (inhibited-interaction 'inhibit)
+ (error nil))
+ 'inhibit))))
+
;;; minibuf-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index ca98f54..57097cf 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -28,6 +28,7 @@
(require 'puny)
(require 'rx)
(require 'subr-x)
+(require 'dns)
;; Timeout in seconds; the test fails if the timeout is reached.
(defvar process-test-sentinel-wait-timeout 2.0)
@@ -350,14 +351,23 @@ See Bug#30460."
;; All the following tests require working DNS, which appears not to
;; be the case for hydra.nixos.org, so disable them there for now.
+;; This will need updating when IANA assign more IPv6 global ranges.
+(defun ipv6-is-available ()
+ (and (featurep 'make-network-process '(:family ipv6))
+ (cl-rassoc-if
+ (lambda (elt)
+ (and (eq 9 (length elt))
+ (= (logand (aref elt 0) #xe000) #x2000)))
+ (network-interface-list))))
+
(ert-deftest lookup-family-specification ()
"`network-lookup-address-info' should only accept valid family symbols."
(skip-unless (not (getenv "EMACS_HYDRA_CI")))
(with-timeout (60 (ert-fail "Test timed out"))
- (should-error (network-lookup-address-info "google.com" 'both))
- (should (network-lookup-address-info "google.com" 'ipv4))
- (when (featurep 'make-network-process '(:family ipv6))
- (should (network-lookup-address-info "google.com" 'ipv6)))))
+ (should-error (network-lookup-address-info "localhost" 'both))
+ (should (network-lookup-address-info "localhost" 'ipv4))
+ (when (ipv6-is-available)
+ (should (network-lookup-address-info "localhost" 'ipv6)))))
(ert-deftest lookup-unicode-domains ()
"Unicode domains should fail."
@@ -380,7 +390,8 @@ See Bug#30460."
(addresses-v4 (network-lookup-address-info "google.com" 'ipv4)))
(should addresses-both)
(should addresses-v4))
- (when (featurep 'make-network-process '(:family ipv6))
+ (when (and (ipv6-is-available)
+ (dns-query "google.com" 'AAAA))
(should (network-lookup-address-info "google.com" 'ipv6)))))
(ert-deftest non-existent-lookup-failure ()
@@ -565,6 +576,11 @@ FD_SETSIZE file descriptors (Bug#24325)."
(should (memq (process-status process) '(run exit)))
(when (process-live-p process)
(process-send-eof process))
+ ;; FIXME: This `sleep-for' shouldn't be needed. It
+ ;; indicates a bug in Emacs; perhaps SIGCHLD is
+ ;; received in parallel with `accept-process-output',
+ ;; causing the latter to hang.
+ (sleep-for 0.1)
(while (accept-process-output process))
(should (eq (process-status process) 'exit))
;; If there's an error between fork and exec, Emacs
diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el
index d13ce77..ec96d77 100644
--- a/test/src/xdisp-tests.el
+++ b/test/src/xdisp-tests.el
@@ -72,4 +72,34 @@
(should (equal (nth 0 posns) (nth 1 posns)))
(should (equal (nth 1 posns) (nth 2 posns)))))
+(ert-deftest xdisp-tests--window-text-pixel-size () ;; bug#45748
+ (with-temp-buffer
+ (insert "xxx")
+ (let* ((window
+ (display-buffer (current-buffer) '(display-buffer-in-child-frame .
nil)))
+ (char-width (frame-char-width))
+ (size (window-text-pixel-size nil t t)))
+ (delete-frame (window-frame window))
+ (should (equal (/ (car size) char-width) 3)))))
+
+(ert-deftest xdisp-tests--window-text-pixel-size-leading-space () ;; bug#45748
+ (with-temp-buffer
+ (insert " xx")
+ (let* ((window
+ (display-buffer (current-buffer) '(display-buffer-in-child-frame .
nil)))
+ (char-width (frame-char-width))
+ (size (window-text-pixel-size nil t t)))
+ (delete-frame (window-frame window))
+ (should (equal (/ (car size) char-width) 3)))))
+
+(ert-deftest xdisp-tests--window-text-pixel-size-trailing-space () ;; bug#45748
+ (with-temp-buffer
+ (insert "xx ")
+ (let* ((window
+ (display-buffer (current-buffer) '(display-buffer-in-child-frame .
nil)))
+ (char-width (frame-char-width))
+ (size (window-text-pixel-size nil t t)))
+ (delete-frame (window-frame window))
+ (should (equal (/ (car size) char-width) 3)))))
+
;;; xdisp-tests.el ends here
diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el
index 632cf96..a35b4d2 100644
--- a/test/src/xml-tests.el
+++ b/test/src/xml-tests.el
@@ -44,12 +44,12 @@
(ert-deftest libxml-tests ()
"Test libxml."
- (when (fboundp 'libxml-parse-xml-region)
- (with-temp-buffer
- (dolist (test libxml-tests--data-comments-preserved)
- (erase-buffer)
- (insert (car test))
- (should (equal (cdr test)
- (libxml-parse-xml-region (point-min) (point-max))))))))
+ (skip-unless (fboundp 'libxml-parse-xml-region))
+ (with-temp-buffer
+ (dolist (test libxml-tests--data-comments-preserved)
+ (erase-buffer)
+ (insert (car test))
+ (should (equal (cdr test)
+ (libxml-parse-xml-region (point-min) (point-max)))))))
;;; libxml-tests.el ends here