aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Corallo2021-01-16 13:26:10 +0100
committerAndrea Corallo2021-01-16 13:26:10 +0100
commit0a7ac0b5504e75275699a3d8d2d5d94bcfda8708 (patch)
treebb6158c8a9edeb1e716718abfc98dca16aef9e9e
parentf1efac1f9efbfa15b6434ebef507c00c1277633f (diff)
parent0732fc31932c75c682c8b65b4dcb4376ca63e8fd (diff)
downloademacs-0a7ac0b5504e75275699a3d8d2d5d94bcfda8708.tar.gz
emacs-0a7ac0b5504e75275699a3d8d2d5d94bcfda8708.zip
Merge remote-tracking branch 'savannah/master' into native-comp
-rw-r--r--.gitignore1
-rw-r--r--.gitlab-ci.yml196
-rw-r--r--admin/notes/elpa32
-rw-r--r--admin/nt/dist-build/README-scripts38
-rw-r--r--admin/nt/dist-build/README-windows-binaries49
-rwxr-xr-xadmin/nt/dist-build/build-dep-zips.py188
-rwxr-xr-xadmin/nt/dist-build/build-zips.sh90
-rw-r--r--admin/nt/dist-build/emacs.nsi31
-rw-r--r--configure.ac21
-rw-r--r--doc/emacs/mini.texi10
-rw-r--r--doc/emacs/trouble.texi7
-rw-r--r--doc/lispref/commands.texi14
-rw-r--r--doc/lispref/display.texi17
-rw-r--r--doc/lispref/elisp.texi1
-rw-r--r--doc/lispref/errors.texi5
-rw-r--r--doc/lispref/minibuf.texi57
-rw-r--r--doc/lispref/modes.texi2
-rw-r--r--doc/misc/auth.texi12
-rw-r--r--doc/misc/gnus.texi2
-rw-r--r--doc/misc/tramp.texi28
-rw-r--r--doc/misc/trampver.texi2
-rw-r--r--etc/NEWS52
-rw-r--r--etc/PROBLEMS5
-rw-r--r--etc/w32-feature.el35
-rw-r--r--lisp/calc/calc.el10
-rw-r--r--lisp/cedet/ede/auto.el24
-rw-r--r--lisp/comint.el26
-rw-r--r--lisp/cus-face.el1
-rw-r--r--lisp/cus-start.el6
-rw-r--r--lisp/custom.el13
-rw-r--r--lisp/dired-x.el2
-rw-r--r--lisp/emacs-lisp/cl-generic.el26
-rw-r--r--lisp/emacs-lisp/cl-macs.el123
-rw-r--r--lisp/emacs-lisp/eieio-base.el135
-rw-r--r--lisp/emacs-lisp/lisp-mode.el6
-rw-r--r--lisp/emacs-lisp/macroexp.el29
-rw-r--r--lisp/emacs-lisp/pcase.el27
-rw-r--r--lisp/emacs-lisp/shortdoc.el13
-rw-r--r--lisp/erc/erc-services.el56
-rw-r--r--lisp/foldout.el2
-rw-r--r--lisp/frame.el8
-rw-r--r--lisp/gnus/gnus-search.el11
-rw-r--r--lisp/gnus/gnus-win.el1
-rw-r--r--lisp/gnus/message.el12
-rw-r--r--lisp/gnus/mm-decode.el19
-rw-r--r--lisp/gnus/nnmaildir.el3
-rw-r--r--lisp/help-fns.el4
-rw-r--r--lisp/help-mode.el3
-rw-r--r--lisp/info.el2
-rw-r--r--lisp/isearch.el61
-rw-r--r--lisp/minibuffer.el8
-rw-r--r--lisp/mouse-drag.el4
-rw-r--r--lisp/mouse.el2
-rw-r--r--lisp/net/nsm.el2
-rw-r--r--lisp/net/tramp-adb.el6
-rw-r--r--lisp/net/tramp-sh.el162
-rw-r--r--lisp/net/tramp.el24
-rw-r--r--lisp/net/trampver.el6
-rw-r--r--lisp/pixel-scroll.el12
-rw-r--r--lisp/progmodes/flymake.el7
-rw-r--r--lisp/progmodes/project.el19
-rw-r--r--lisp/progmodes/prolog.el6
-rw-r--r--lisp/progmodes/python.el6
-rw-r--r--lisp/progmodes/xref.el15
-rw-r--r--lisp/ruler-mode.el4
-rw-r--r--lisp/shell.el1
-rw-r--r--lisp/simple.el34
-rw-r--r--lisp/startup.el37
-rw-r--r--lisp/strokes.el23
-rw-r--r--lisp/subr.el112
-rw-r--r--lisp/textmodes/artist.el6
-rw-r--r--lisp/textmodes/fill.el11
-rw-r--r--lisp/textmodes/reftex-vars.el18
-rw-r--r--lisp/vc/ediff-wind.el5
-rw-r--r--lisp/vc/ediff.el2
-rw-r--r--lisp/wid-edit.el14
-rw-r--r--lisp/window.el13
-rw-r--r--src/buffer.c2
-rw-r--r--src/callproc.c33
-rw-r--r--src/data.c3
-rw-r--r--src/dispnew.c16
-rw-r--r--src/emacs.c4
-rw-r--r--src/eval.c26
-rw-r--r--src/fns.c85
-rw-r--r--src/keymap.c35
-rw-r--r--src/lisp.h8
-rw-r--r--src/lread.c29
-rw-r--r--src/minibuf.c211
-rw-r--r--src/pdumper.c2
-rw-r--r--src/process.c13
-rw-r--r--src/sysdep.c217
-rw-r--r--src/w32term.c3
-rw-r--r--src/window.c5
-rw-r--r--src/window.h4
-rw-r--r--src/xdisp.c13
-rw-r--r--src/xfaces.c8
-rw-r--r--test/Makefile.in6
-rw-r--r--test/README6
-rw-r--r--test/file-organization.org5
-rw-r--r--test/infra/Dockerfile.emba71
-rw-r--r--test/lisp/calendar/lunar-tests.el38
-rw-r--r--test/lisp/calendar/solar-tests.el4
-rw-r--r--test/lisp/cedet/semantic-utest.el6
-rw-r--r--test/lisp/cedet/srecode-utest-getset.el1
-rw-r--r--test/lisp/cedet/srecode-utest-template.el6
-rw-r--r--test/lisp/emacs-lisp/cl-macs-tests.el23
-rw-r--r--test/lisp/emacs-lisp/timer-tests.el4
-rw-r--r--test/lisp/gnus/mm-decode-resources/win1252-multipart.bin44
-rw-r--r--test/lisp/gnus/mm-decode-tests.el35
-rw-r--r--test/lisp/help-mode-tests.el21
-rw-r--r--test/lisp/help-tests.el4
-rw-r--r--test/lisp/net/nsm-tests.el8
-rw-r--r--test/lisp/net/socks-tests.el103
-rw-r--r--test/lisp/net/tramp-tests.el197
-rw-r--r--test/lisp/progmodes/tcl-tests.el14
-rw-r--r--test/lisp/subr-tests.el20
-rw-r--r--test/lisp/textmodes/fill-tests.el31
-rw-r--r--test/src/decompress-tests.el20
-rw-r--r--test/src/fns-tests.el58
-rw-r--r--test/src/lread-tests.el6
-rw-r--r--test/src/minibuf-tests.el15
-rw-r--r--test/src/process-tests.el26
-rw-r--r--test/src/xdisp-tests.el30
-rw-r--r--test/src/xml-tests.el14
124 files changed, 2562 insertions, 1048 deletions
diff --git a/.gitignore b/.gitignore
index 4c7c1ad61b7..63fa4203b58 100644
--- a/.gitignore
+++ b/.gitignore
@@ -299,3 +299,4 @@ nt/emacs.rc
299nt/emacsclient.rc 299nt/emacsclient.rc
300src/gdb.ini 300src/gdb.ini
301/var/ 301/var/
302src/fingerprint.c
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index bd012bf395f..1be92cff161 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -24,74 +24,114 @@
24# Maintainer: Ted Zlatanov <tzz@lifelogs.com> 24# Maintainer: Ted Zlatanov <tzz@lifelogs.com>
25# URL: https://emba.gnu.org/emacs/emacs 25# URL: https://emba.gnu.org/emacs/emacs
26 26
27image: debian:stretch 27# Never run merge request pipelines, they usually duplicate push pipelines
28# see https://docs.gitlab.com/ee/ci/yaml/README.html#common-if-clauses-for-rules
29workflow:
30 rules:
31 - if: '$CI_PIPELINE_SOURCE == "merge_request_event"'
32 when: never
33 - when: always
28 34
29variables: 35variables:
30 GIT_STRATEGY: fetch 36 GIT_STRATEGY: fetch
31 EMACS_EMBA_CI: 1 37 EMACS_EMBA_CI: 1
32 38
33before_script: 39default:
34 - apt update -qq 40 image: docker:19.03.12
35 - 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 41 timeout: 3 hours
42 before_script:
43 - docker info
36 44
37stages: 45.job-template:
38 - test 46 # these will be cached across builds
47 cache:
48 key: ${CI_COMMIT_REF_SLUG}
49 paths: []
50 policy: pull-push
51 # these will be saved for followup builds
52 artifacts:
53 expire_in: 24 hrs
54 paths: []
55 # - "test/**/*.log"
56 # - "**/*.log"
39 57
40test-all: 58.test-template:
41 # This tests also file monitor libraries inotify and inotifywatch. 59 rules:
42 stage: test 60 - changes:
43 only: 61 - "**/Makefile.in"
44 changes: 62 - .gitlab-ci.yml
45 - "Makefile.in" 63 - aclocal.m4
46 - .gitlab-ci.yml 64 - autogen.sh
47 - aclocal.m4 65 - configure.ac
48 - autogen.sh 66 - lib/*.{h,c}
49 - configure.ac 67 - lisp/**/*.el
50 - lib/*.{h,c} 68 - src/*.{h,c}
51 - lisp/*.el 69 - test/infra/*
52 - lisp/**/*.el 70 - test/lisp/**/*.el
53 - src/*.{h,c} 71 - test/src/*.el
54 - test/lisp/*.el 72 - changes:
55 - test/lisp/**/*.el 73 # gfilemonitor, kqueue
56 - test/src/*.el 74 - src/gfilenotify.c
57 except: 75 - src/kqueue.c
58 changes: 76 # MS Windows
59 # gfilemonitor, kqueue 77 - "**/w32*"
60 - src/gfilenotify.c 78 # GNUstep
61 - src/kqueue.c 79 - lisp/term/ns-win.el
62 # MS Windows 80 - src/ns*.{h,m}
63 - lisp/w32*.el 81 - src/macfont.{h,m}
64 - lisp/term/w32*.el 82 when: never
65 - src/w32*.{h,c} 83
66 # GNUstep 84 # using the variables for each job
67 - lisp/term/ns-win.el
68 - src/ns*.{h,m}
69 - src/macfont.{h,m}
70 script: 85 script:
71 - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 inotify-tools 86 - docker build --target ${target} -t ${target}:${CI_COMMIT_REF_SLUG} -t ${target}:${CI_COMMIT_SHA} -f test/infra/Dockerfile.emba .
72 - ./autogen.sh autoconf 87 # TODO: with make -j4 several of the tests were failing, for example shadowfile-tests, but passed without it
73 - ./configure --without-makeinfo 88 - docker run -i --rm -e EMACS_EMBA_CI=${EMACS_EMBA_CI} ${target}:${CI_COMMIT_SHA} make ${make_params}
74 - make bootstrap 89
75 - make check-expensive 90stages:
91 - fast
92 - normal
93 - slow
94
95test-fast:
96 stage: fast
97 extends: [.job-template, .test-template]
98 variables:
99 target: emacs-inotify
100 make_params: "-C test check"
101
102test-lisp:
103 stage: normal
104 extends: [.job-template, .test-template]
105 variables:
106 target: emacs-inotify
107 make_params: "-C test check-lisp"
108
109test-net:
110 stage: normal
111 extends: [.job-template, .test-template]
112 variables:
113 target: emacs-inotify
114 make_params: "-C test check-net"
76 115
77test-filenotify-gio: 116test-filenotify-gio:
78 stage: test
79 # This tests file monitor libraries gfilemonitor and gio. 117 # This tests file monitor libraries gfilemonitor and gio.
80 only: 118 stage: normal
81 changes: 119 extends: [.job-template, .test-template]
82 - .gitlab-ci.yml 120 rules:
83 - lisp/autorevert.el 121 - if: '$CI_PIPELINE_SOURCE == "schedule"'
84 - lisp/filenotify.el 122 changes:
85 - lisp/net/tramp-sh.el 123 - "**/Makefile.in"
86 - src/gfilenotify.c 124 - .gitlab-ci.yml
87 - test/lisp/autorevert-tests.el 125 - lisp/autorevert.el
88 - test/lisp/filenotify-tests.el 126 - lisp/filenotify.el
89 script: 127 - lisp/net/tramp-sh.el
90 - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libglib2.0-dev libglib2.0-bin libglib2.0-0 128 - src/gfilenotify.c
91 - ./autogen.sh autoconf 129 - test/infra/*
92 - ./configure --without-makeinfo --with-file-notification=gfile 130 - test/lisp/autorevert-tests.el
93 - make bootstrap 131 - test/lisp/filenotify-tests.el
94 - make -k -C test autorevert-tests filenotify-tests 132 variables:
133 target: emacs-filenotify-gio
134 make_params: "-k -C test autorevert-tests filenotify-tests"
95 135
96test-native-bootstrap-speed0: 136test-native-bootstrap-speed0:
97 # Test a full native bootstrap 137 # Test a full native bootstrap
@@ -126,19 +166,31 @@ test-native-bootstrap-speed2:
126 timeout: 8 hours 166 timeout: 8 hours
127 167
128test-gnustep: 168test-gnustep:
129 stage: test
130 # This tests the GNUstep build process 169 # This tests the GNUstep build process
131 only: 170 stage: normal
132 changes: 171 extends: [.job-template, .test-template]
133 - .gitlab-ci.yml 172 rules:
134 - configure.ac 173 - if: '$CI_PIPELINE_SOURCE == "schedule"'
135 - src/ns*.{h,m} 174 changes:
136 - src/macfont.{h,m} 175 - "**/Makefile.in"
137 - lisp/term/ns-win.el 176 - .gitlab-ci.yml
138 - nextstep/**/* 177 - configure.ac
139 script: 178 - src/ns*.{h,m}
140 - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 gnustep-devel 179 - src/macfont.{h,m}
141 - ./autogen.sh autoconf 180 - lisp/term/ns-win.el
142 - ./configure --without-makeinfo --with-ns 181 - nextstep/**/*
143 - make bootstrap 182 - test/infra/*
144 - make install 183 variables:
184 target: emacs-gnustep
185 make_params: install
186
187test-all:
188 # This tests also file monitor libraries inotify and inotifywatch.
189 stage: slow
190 extends: [.job-template, .test-template]
191 rules:
192 # note there's no "changes" section, so this always runs on a schedule
193 - if: '$CI_PIPELINE_SOURCE == "schedule"'
194 variables:
195 target: emacs-inotify
196 make_params: check-expensive
diff --git a/admin/notes/elpa b/admin/notes/elpa
index ea6c132fe19..1e9e7a9f52b 100644
--- a/admin/notes/elpa
+++ b/admin/notes/elpa
@@ -5,17 +5,31 @@ repository named "elpa", hosted on Savannah. To check it out:
5 5
6 git clone git://git.sv.gnu.org/emacs/elpa 6 git clone git://git.sv.gnu.org/emacs/elpa
7 cd elpa 7 cd elpa
8 git remote set-url --push origin git+ssh://git.sv.gnu.org/srv/git/emacs/elpa 8 make setup
9 [create task branch for edits, etc.]
10 9
11Changes to this branch propagate to elpa.gnu.org via a "deployment" script run 10That leaves the elpa/packages directory empty; you must check out the
12daily. This script (which is kept in elpa/admin/update-archive.sh) generates 11ones you want.
13the content visible at https://elpa.gnu.org/packages.
14 12
15A new package is released as soon as the "version number" of that package is 13If you wish to check out all the packages into the packages directory,
16changed. So you can use 'elpa' to work on a package without fear of releasing 14you can run the command:
17those changes prematurely. And once the code is ready, just bump the 15
18version number to make a new release of the package. 16 make worktrees
17
18You can check out a specific package <pkgname> into the packages
19directory with:
20
21 make packages/<pkgname>
22
23
24Changes to this repository propagate to elpa.gnu.org via a
25"deployment" script run daily. This script generates the content
26visible at https://elpa.gnu.org/packages.
27
28A new package is released as soon as the "version number" of that
29package is changed. So you can use 'elpa' to work on a package
30without fear of releasing those changes prematurely. And once the
31code is ready, just bump the version number to make a new release of
32the package.
19 33
20It is easy to use the elpa branch to deploy a "local" copy of the 34It is easy to use the elpa branch to deploy a "local" copy of the
21package archive. For details, see the README file in the elpa branch. 35package 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 4c3554e8df5..f27bcd3bd66 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.
33A location for the dependencies. This needs to contain two zip files 33A location for the dependencies. This needs to contain two zip files
34with the dependencies. build-dep-zips.py will create these files for you. 34with the dependencies. build-dep-zips.py will create these files for you.
35 35
36~/emacs-build/deps/libXpm/i686 36~/emacs-build/deps/libXpm
37~/emacs-build/deps/libXpm/x86_64
38 37
39Contain libXpm-noX4.dll. This file is used to load images for the 38Contain libXpm-noX4.dll. This file is used to load images for the
40splash screen, menu items and so on. Emacs runs without it, but looks 39splash screen, menu items and so on. Emacs runs without it, but looks
41horrible. The x86_64 comes from msys2, while the i686 comes from 40horrible. The files came original from msys2, and contains no
42ezwinports because it itself has no dependencies. These have to be 41dependencies. It has to be placed manually (but probably never
43placed manually (but probably never need updating). 42need updating).
44 43
45 44~/emacs-build/build/$version
46~/emacs-build/build/$version/i686
47~/emacs-build/build/$version/x86_64
48 45
49We build Emacs out-of-source here. This directory is created by 46We build Emacs out-of-source here. This directory is created by
50build-zips.sh. This directory can be freely deleted after zips have 47build-zips.sh. This directory can be freely deleted after zips have
51been created 48been created
52 49
53 50~/emacs-build/install/$version
54~/emacs-build/install/$version/i686
55~/emacs-build/install/$version/x86_64
56 51
57We install Emacs here. This directory is created by build-zips.sh. 52We install Emacs here. This directory is created by build-zips.sh.
58This directory can and *should* be deleted after zips have been 53This directory can and *should* be deleted after zips have been
@@ -79,9 +74,9 @@ To do this:
79 74
80Update msys to the latest version with `pacman -Syu`. 75Update msys to the latest version with `pacman -Syu`.
81 76
82Then run build-dep-zips.py, in the ~/emacs-build/deps directory. Three 77Then run build-dep-zips.py, in the ~/emacs-build/deps directory. Two
83zips will be created, containing the 64bit and 32bit dependencies, as 78zips will be created, containing the dependencies, as well as the
84well as the source for these. 79source for these.
85 80
86For emacs release or pre-test version: 81For emacs release or pre-test version:
87 82
@@ -105,12 +100,12 @@ To do this:
105 100
106Update msys to the latest version with `pacman -Syu`. 101Update msys to the latest version with `pacman -Syu`.
107 102
108Then run build-dep-zips.py, in ~/emacs-build/deps directory. Three 103Then run build-dep-zips.py, in ~/emacs-build/deps directory. Two zips
109zips will be created, containing the 64bit and 32bit dependencies, as 104will be created, containing the dependencies, as well as the source
110well as the source for these. These deps files contain the date of 105for these. These deps files contain the date of creation in their
111creation in their name. The deps file can be reused as desired, or a 106name. The deps file can be reused as desired, or a new version
112new version created. Where multiple deps files exist, the most 107created. Where multiple deps files exist, the most recent will be
113recent will be used. 108used.
114 109
115Now, run `build-zips.sh -s` to build a snapshot release. 110Now, run `build-zips.sh -s` to build a snapshot release.
116 111
@@ -134,4 +129,5 @@ For snapshots from another branch
134Snapshots can be build from any other branch. There is rarely a need 129Snapshots can be build from any other branch. There is rarely a need
135to do this, except where some significant, wide-ranging feature is 130to do this, except where some significant, wide-ranging feature is
136being added on a feature branch. In this case, the branch can be 131being added on a feature branch. In this case, the branch can be
137given using `build-zips.sh -b pdumper -s` for example. 132given using `build-zips.sh -b pdumper -s` for example. Any "/"
133characters 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 001bdd73f7b..b6f6e55d8c6 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.
4 Precompiled Distributions of 4 Precompiled Distributions of
5 Emacs for Windows 5 Emacs for Windows
6 6
7 Jan 1, 2020 7 Jan 14, 2021
8 8
9 This directory contains precompiled distributions for GNU Emacs on 9 This directory contains precompiled distributions for GNU Emacs on
10 Windows 10 Windows
@@ -25,51 +25,33 @@ old binaries.
25Windows Binaries 25Windows Binaries
26================ 26================
27 27
28Currently, we provide six different binary packages for Emacs, which 28Currently, we provide three different binary packages for Emacs, which
29are: 29are:
30 30
31emacs-$VERSION-x86_64-installer.exe 31emacs-$VERSION-installer.exe
32 32
33Contains a 64-bit build of Emacs with dependencies as an installer 33Contains Emacs with dependencies as an installer
34package. Mostly, this is the best one to install. 34package. Mostly, this is the best one to install.
35 35
36emacs-$VERSION-x86_64.zip 36emacs-$VERSION.zip
37 37
38Contains a 64-bit build of Emacs with dependencies. This contains the 38Contains Emacs with dependencies. This contains the same files as the
39same files as the installer but as a zip file which some users may 39installer but as a zip file which some users may prefer.
40prefer.
41 40
42emacs-$VERSION-x86_64-no-deps.zip 41emacs-$VERSION-no-deps.zip
43 42
44Contains a 64-bit build of Emacs without any dependencies. This may be 43Contains Emacs without any dependencies. This may be useful if you
45useful if you wish to install where the dependencies are already 44wish to install where the dependencies are already available, or if
46available, or if you want the small possible Emacs. 45you want the small possible Emacs.
47
48emacs-$VERSION-i686-installer.exe
49
50Contains a 32-bit build of Emacs with dependencies as an installer
51package. This is useful for running on a 32-bit machine.
52
53emacs-$VERSION-i686.zip
54
55Contains a 32-bit build of Emacs with dependencies.
56
57emacs-$VERSION-i686-no-deps.zip
58
59Contains a 32-bit build of Emacs without dependencies
60 46
61In addition, we provide the following files which will not be useful 47In addition, we provide the following files which will not be useful
62for most end-users. 48for most end-users.
63 49
64emacs-$VERSION-x86_64-deps.zip 50emacs-$VERSION-deps.zip
65 51
66The dependencies. Unzipping this file on top of 52The dependencies. Unzipping this file on top of
67emacs-$VERSION-x86_64-no-deps.zip should result in the same install as 53emacs-$VERSION-no-deps.zip should result in the same install as
68emacs-$VERSION-x86_64.zip. 54emacs-$VERSION.zip.
69
70emacs-$VERSION-i686-deps.zip
71
72The 32-bit version of the dependencies.
73 55
74emacs-$VERSION-deps-mingw-w64-src.zip 56emacs-$VERSION-deps-mingw-w64-src.zip
75 57
@@ -85,7 +67,8 @@ Snapshots
85 67
86We also distribute "snapshots" of Emacs built at points throughout the 68We also distribute "snapshots" of Emacs built at points throughout the
87development cycle, for those interested in following this cycle. They 69development cycle, for those interested in following this cycle. They
88are not recommended for normal users. 70are not recommended for normal users; however, they are useful for
71people who want to report bugs against the current master.
89 72
90The files follow the same naming convention, but also include a date 73The files follow the same naming convention, but also include a date
91(and sometimes information about their branch). The Emacs source at 74(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 47185dbb1ba..19168e7ff25 100755
--- a/admin/nt/dist-build/build-dep-zips.py
+++ b/admin/nt/dist-build/build-dep-zips.py
@@ -17,7 +17,6 @@
17## You should have received a copy of the GNU General Public License 17## You should have received a copy of the GNU General Public License
18## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 18## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
19import argparse 19import argparse
20import multiprocessing as mp
21import os 20import os
22import shutil 21import shutil
23import re 22import re
@@ -40,21 +39,84 @@ mingw-w64-x86_64-libtiff
40mingw-w64-x86_64-libxml2 39mingw-w64-x86_64-libxml2
41mingw-w64-x86_64-xpm-nox'''.split() 40mingw-w64-x86_64-xpm-nox'''.split()
42 41
42DLL_REQ='''libgif
43libgnutls
44libharfbuzz
45libjansson
46liblcms2
47libturbojpeg
48libpng
49librsvg
50libtiff
51libxml
52libXpm'''.split()
53
43 54
44## Options 55## Options
45DRY_RUN=False 56DRY_RUN=False
46 57
58
59def check_output_maybe(*args,**kwargs):
60 if(DRY_RUN):
61 print("Calling: {}{}".format(args,kwargs))
62 else:
63 return check_output(*args,**kwargs)
64
65## DLL Capture
66def gather_deps():
67
68 os.mkdir("x86_64")
69 os.chdir("x86_64")
70
71 for dep in full_dll_dependency():
72 check_output_maybe(["cp /mingw64/bin/{}*.dll .".format(dep)],
73 shell=True)
74
75 print("Zipping")
76 check_output_maybe("zip -9r ../emacs-{}-{}deps.zip *"
77 .format(EMACS_MAJOR_VERSION, DATE),
78 shell=True)
79 os.chdir("../")
80
81## Return all Emacs dependencies
82def full_dll_dependency():
83 deps = [dll_dependency(dep) for dep in DLL_REQ]
84 return set(sum(deps, []) + DLL_REQ)
85
86## Dependencies for a given DLL
87def dll_dependency(dll):
88 output = check_output(["/mingw64/bin/ntldd", "--recursive",
89 "/mingw64/bin/{}*.dll".format(dll)]).decode("utf-8")
90 ## munge output
91 return ntldd_munge(output)
92
93def ntldd_munge(out):
94 deps = out.splitlines()
95 rtn = []
96 for dep in deps:
97 ## Output looks something like this
98
99 ## KERNEL32.dll => C:\Windows\SYSTEM32\KERNEL32.dll (0x0000000002a30000)
100 ## libwinpthread-1.dll => C:\msys64\mingw64\bin\libwinpthread-1.dll (0x0000000000090000)
101
102 ## if it's the former, we want it, if its the later we don't
103 splt = dep.split()
104 if len(splt) > 2 and "msys64" in splt[2]:
105 print("Adding dep", splt[0])
106 rtn.append(splt[0].split(".")[0])
107
108 return rtn
109
110#### Source Capture
111
47## Packages to fiddle with 112## Packages to fiddle with
48## Source for gcc-libs is part of gcc 113## Source for gcc-libs is part of gcc
49SKIP_SRC_PKGS=["mingw-w64-gcc-libs"] 114SKIP_SRC_PKGS=["mingw-w64-gcc-libs"]
50SKIP_DEP_PKGS=["mingw-w64-x86_64-glib2"] 115SKIP_DEP_PKGS=["mingw-w64-glib2"]
51MUNGE_SRC_PKGS={"mingw-w64-libwinpthread-git":"mingw-w64-winpthreads-git"} 116MUNGE_SRC_PKGS={"mingw-w64-libwinpthread-git":"mingw-w64-winpthreads-git"}
52MUNGE_DEP_PKGS={ 117MUNGE_DEP_PKGS={
53 "mingw-w64-i686-libwinpthread":"mingw-w64-i686-libwinpthread-git",
54 "mingw-w64-x86_64-libwinpthread":"mingw-w64-x86_64-libwinpthread-git", 118 "mingw-w64-x86_64-libwinpthread":"mingw-w64-x86_64-libwinpthread-git",
55
56 "mingw-w64-x86_64-libtre": "mingw-w64-x86_64-libtre-git", 119 "mingw-w64-x86_64-libtre": "mingw-w64-x86_64-libtre-git",
57 "mingw-w64-i686-libtre": "mingw-w64-i686-libtre-git"
58} 120}
59 121
60## Currently no packages seem to require this! 122## Currently no packages seem to require this!
@@ -62,12 +124,6 @@ ARCH_PKGS=[]
62SRC_REPO="https://sourceforge.net/projects/msys2/files/REPOS/MINGW/Sources" 124SRC_REPO="https://sourceforge.net/projects/msys2/files/REPOS/MINGW/Sources"
63 125
64 126
65def check_output_maybe(*args,**kwargs):
66 if(DRY_RUN):
67 print("Calling: {}{}".format(args,kwargs))
68 else:
69 return check_output(*args,**kwargs)
70
71def immediate_deps(pkg): 127def immediate_deps(pkg):
72 package_info = check_output(["pacman", "-Si", pkg]).decode("utf-8").split("\n") 128 package_info = check_output(["pacman", "-Si", pkg]).decode("utf-8").split("\n")
73 129
@@ -87,92 +143,50 @@ def immediate_deps(pkg):
87 return dependencies 143 return dependencies
88 144
89 145
146## Extract all the msys2 packages that are dependencies of our direct dependencies
90def extract_deps(): 147def extract_deps():
91 148
92 print( "Extracting deps" ) 149 print( "Extracting deps" )
93 150
94 # Get a list of all dependencies needed for packages mentioned above. 151 # Get a list of all dependencies needed for packages mentioned above.
95 pkgs = PKG_REQ[:] 152 pkgs = PKG_REQ[:]
96 print("Initial pkgs", pkgs)
97 n = 0 153 n = 0
98 while n < len(pkgs): 154 while n < len(pkgs):
99 subdeps = immediate_deps(pkgs[n]) 155 subdeps = immediate_deps(pkgs[n])
100 for p in subdeps: 156 for p in subdeps:
101 if not (p in pkgs or p in SKIP_DEP_PKGS): 157 if not (p in pkgs or p in SKIP_DEP_PKGS):
102 print("adding", p)
103 pkgs.append(p) 158 pkgs.append(p)
104 n = n + 1 159 n = n + 1
105 160
106 return sorted(pkgs) 161 return sorted(pkgs)
107 162
108def gather_deps(deps, arch, directory):
109
110 os.mkdir(arch)
111 os.chdir(arch)
112
113 ## Replace the architecture with the correct one
114 deps = [re.sub(r"x86_64",arch,x) for x in deps]
115
116 ## find all files the transitive dependencies
117 deps_files = check_output(
118 ["pacman", "-Ql"] + deps
119 ).decode("utf-8").split("\n")
120
121 ## Produces output like
122 ## mingw-w64-x86_64-zlib /mingw64/lib/libminizip.a
123
124 ## drop the package name
125 tmp = deps_files.copy()
126 deps_files=[]
127 for d in tmp:
128 slt = d.split()
129 if(not slt==[]):
130 deps_files.append(slt[1])
131
132 ## sort uniq
133 deps_files = sorted(list(set(deps_files)))
134 ## copy all files into local
135 print("Copying dependencies: {}".format(arch))
136 check_output_maybe(["rsync", "-R"] + deps_files + ["."])
137
138 ## And package them up
139 os.chdir(directory)
140 print("Zipping: {}".format(arch))
141 check_output_maybe("zip -9r ../../emacs-{}-{}{}-deps.zip *"
142 .format(EMACS_MAJOR_VERSION, DATE, arch),
143 shell=True)
144 os.chdir("../../")
145
146 163
147def download_source(tarball): 164def download_source(tarball):
148 print("Acquiring {}...".format(tarball)) 165 print("Acquiring {}...".format(tarball))
149 166
150 if os.path.exists("../emacs-src-cache/{}".format(tarball)): 167 if not os.path.exists("../emacs-src-cache/{}".format(tarball)):
151 print("Copying {} from local".format(tarball))
152 shutil.copyfile("../emacs-src-cache/{}".format(tarball),
153 "{}".format(tarball))
154 else:
155 print("Downloading {}...".format(tarball)) 168 print("Downloading {}...".format(tarball))
156 check_output_maybe( 169 check_output_maybe(
157 "wget -a ../download.log -O {} {}/{}/download" 170 "wget -a ../download.log -O ../emacs-src-cache/{} {}/{}/download"
158 .format(tarball, SRC_REPO, tarball), 171 .format(tarball, SRC_REPO, tarball),
159 shell=True 172 shell=True
160 ) 173 )
161 print("Downloading {}... done".format(tarball)) 174 print("Downloading {}... done".format(tarball))
162 175
163def gather_source(deps): 176 print("Copying {} from local".format(tarball))
177 shutil.copyfile("../emacs-src-cache/{}".format(tarball),
178 "{}".format(tarball))
164 179
165 180
166 ## Source for gcc-libs is part of gcc 181## Fetch all the source code
167 ## Source for libwinpthread is in libwinpthreads 182def gather_source(deps):
168 ## mpc, termcap, xpm -- has x86_64, and i686 versions 183
184 if not os.path.exists("emacs-src-cache"):
185 os.mkdir("emacs-src-cache")
169 186
170 ## This needs to have been run first at the same time as the
171 ## system was updated.
172 os.mkdir("emacs-src") 187 os.mkdir("emacs-src")
173 os.chdir("emacs-src") 188 os.chdir("emacs-src")
174 189
175 to_download = []
176 for pkg in deps: 190 for pkg in deps:
177 pkg_name_and_version= \ 191 pkg_name_and_version= \
178 check_output(["pacman","-Q", pkg]).decode("utf-8").strip() 192 check_output(["pacman","-Q", pkg]).decode("utf-8").strip()
@@ -183,31 +197,18 @@ def gather_source(deps):
183 pkg_name=pkg_name_components[0] 197 pkg_name=pkg_name_components[0]
184 pkg_version=pkg_name_components[1] 198 pkg_version=pkg_name_components[1]
185 199
186 ## make a simple name to make lookup easier 200 ## source pkgs don't have an architecture in them
187 simple_pkg_name = re.sub(r"x86_64-","",pkg_name) 201 pkg_name = re.sub(r"x86_64-","",pkg_name)
188 202
189 if(simple_pkg_name in SKIP_SRC_PKGS): 203 if(pkg_name in SKIP_SRC_PKGS):
190 continue 204 continue
191 205
192 ## Some packages have different source files for different 206 ## Switch names if necessary
193 ## architectures. For these we need two downloads. 207 pkg_name = MUNGE_SRC_PKGS.get(pkg_name,pkg_name)
194 if(simple_pkg_name in ARCH_PKGS):
195 downloads = [pkg_name,
196 re.sub(r"x86_64","i686",pkg_name)]
197 else:
198 downloads = [simple_pkg_name]
199
200 for d in downloads:
201 ## Switch names if necessary
202 d = MUNGE_SRC_PKGS.get(d,d)
203 208
204 tarball = "{}-{}.src.tar.gz".format(d,pkg_version) 209 tarball = "{}-{}.src.tar.gz".format(pkg_name,pkg_version)
205 210
206 to_download.append(tarball) 211 download_source(tarball)
207
208 ## Download in parallel or it is just too slow
209 p = mp.Pool(16)
210 p.map(download_source,to_download)
211 212
212 print("Zipping") 213 print("Zipping")
213 check_output_maybe("zip -9 ../emacs-{}-{}deps-mingw-w64-src.zip *" 214 check_output_maybe("zip -9 ../emacs-{}-{}deps-mingw-w64-src.zip *"
@@ -220,7 +221,6 @@ def gather_source(deps):
220def clean(): 221def clean():
221 print("Cleaning") 222 print("Cleaning")
222 os.path.isdir("emacs-src") and shutil.rmtree("emacs-src") 223 os.path.isdir("emacs-src") and shutil.rmtree("emacs-src")
223 os.path.isdir("i686") and shutil.rmtree("i686")
224 os.path.isdir("x86_64") and shutil.rmtree("x86_64") 224 os.path.isdir("x86_64") and shutil.rmtree("x86_64")
225 os.path.isfile("download.log") and os.remove("download.log") 225 os.path.isfile("download.log") and os.remove("download.log")
226 226
@@ -234,12 +234,6 @@ parser = argparse.ArgumentParser()
234parser.add_argument("-s", help="snapshot build", 234parser.add_argument("-s", help="snapshot build",
235 action="store_true") 235 action="store_true")
236 236
237parser.add_argument("-t", help="32 bit deps only",
238 action="store_true")
239
240parser.add_argument("-f", help="64 bit deps only",
241 action="store_true")
242
243parser.add_argument("-r", help="source code only", 237parser.add_argument("-r", help="source code only",
244 action="store_true") 238 action="store_true")
245 239
@@ -253,9 +247,9 @@ parser.add_argument("-l", help="list dependencies only",
253 action="store_true") 247 action="store_true")
254 248
255args = parser.parse_args() 249args = parser.parse_args()
256do_all=not (args.c or args.r or args.f or args.t) 250do_all=not (args.c or args.r)
251
257 252
258deps=extract_deps()
259 253
260DRY_RUN=args.d 254DRY_RUN=args.d
261 255
@@ -269,13 +263,11 @@ if args.s:
269else: 263else:
270 DATE="" 264 DATE=""
271 265
272if( do_all or args.t ): 266if( do_all):
273 gather_deps(deps,"i686","mingw32") 267 gather_deps()
274
275if( do_all or args.f ):
276 gather_deps(deps,"x86_64","mingw64")
277 268
278if( do_all or args.r ): 269if( do_all or args.r ):
270 deps=extract_deps()
279 gather_source(deps) 271 gather_source(deps)
280 272
281if( args.c ): 273if( args.c ):
diff --git a/admin/nt/dist-build/build-zips.sh b/admin/nt/dist-build/build-zips.sh
index 4a9a7b596e7..7bc6ea6a9e5 100755
--- a/admin/nt/dist-build/build-zips.sh
+++ b/admin/nt/dist-build/build-zips.sh
@@ -29,72 +29,62 @@ function git_up {
29} 29}
30 30
31function build_zip { 31function build_zip {
32 32 echo [build] Building Emacs-$VERSION
33 ARCH=$1
34 PKG=$2
35 HOST=$3
36
37 echo [build] Building Emacs-$VERSION for $ARCH
38 if [ $ARCH == "i686" ]
39 then
40 PATH=/mingw32/bin:$PATH
41 MSYSTEM=MINGW32
42 fi
43 33
44 ## Clean the install location because we use it twice 34 ## Clean the install location because we use it twice
45 rm -rf $HOME/emacs-build/install/emacs-$VERSION/$ARCH 35 rm -rf $HOME/emacs-build/install/emacs-$VERSION
46 mkdir --parents $HOME/emacs-build/build/emacs-$VERSION/$ARCH 36 mkdir --parents $HOME/emacs-build/build/emacs-$VERSION
47 cd $HOME/emacs-build/build/emacs-$VERSION/$ARCH 37 cd $HOME/emacs-build/build/emacs-$VERSION
38
39 ## Do we need this or is it the default?
40 export PKG_CONFIG_PATH=/mingw64/lib/pkgconfig
48 41
49 export PKG_CONFIG_PATH=$PKG
50 42
51 ## Running configure forces a rebuild of the C core which takes 43 ## Running configure forces a rebuild of the C core which takes
52 ## time that is not always needed, so do not do it unless we have 44 ## time that is not always needed, so do not do it unless we have
53 ## to. 45 ## to.
54 if [ ! -f Makefile ] || (($CONFIG)) 46 if [ ! -f Makefile ] || (($CONFIG))
55 then 47 then
56 echo [build] Configuring Emacs $ARCH 48 echo [build] Configuring Emacs
57 $REPO_DIR/$BRANCH/configure \ 49 $REPO_DIR/$BRANCH/configure \
58 --without-dbus \ 50 --without-dbus \
59 --host=$HOST --without-compress-install \ 51 --without-compress-install \
60 $CACHE \ 52 $CACHE \
61 CFLAGS="$CFLAGS" 53 CFLAGS="$CFLAGS"
62 fi 54 fi
63 55
64 make -j 4 $INSTALL_TARGET \ 56 make -j 4 $INSTALL_TARGET \
65 prefix=$HOME/emacs-build/install/emacs-$VERSION/$ARCH 57 prefix=$HOME/emacs-build/install/emacs-$VERSION
66 cd $HOME/emacs-build/install/emacs-$VERSION/$ARCH 58 cd $HOME/emacs-build/install/emacs-$VERSION
67 cp $HOME/emacs-build/deps/libXpm/$ARCH/libXpm-noX4.dll bin 59 zip -r -9 emacs-$OF_VERSION-no-deps.zip *
68 zip -r -9 emacs-$OF_VERSION-$ARCH-no-deps.zip * 60 mv emacs-$OF_VERSION-no-deps.zip $HOME/emacs-upload
69 mv emacs-$OF_VERSION-$ARCH-no-deps.zip $HOME/emacs-upload
70 rm bin/libXpm-noX4.dll
71 61
72 if [ -z $SNAPSHOT ]; 62 if [ -z $SNAPSHOT ];
73 then 63 then
74 DEPS_FILE=$HOME/emacs-build/deps/emacs-$MAJOR_VERSION-$ARCH-deps.zip 64 DEPS_FILE=$HOME/emacs-build/deps/emacs-$MAJOR_VERSION-deps.zip
75 else 65 else
76 ## Pick the most recent snapshot whatever that is 66 ## Pick the most recent snapshot whatever that is
77 DEPS_FILE=`ls $HOME/emacs-build/deps/emacs-$MAJOR_VERSION-*-$ARCH-deps.zip | tail -n 1` 67 DEPS_FILE=`ls $HOME/emacs-build/deps/emacs-$MAJOR_VERSION-*-deps.zip | tail -n 1`
78 fi 68 fi
79 69
80 echo [build] Using $DEPS_FILE 70 echo [build] Using $DEPS_FILE
81 unzip $DEPS_FILE 71 unzip -d bin $DEPS_FILE
82 72
83 zip -r -9 emacs-$OF_VERSION-$ARCH.zip * 73 zip -r -9 emacs-$OF_VERSION.zip *
84 mv emacs-$OF_VERSION-$ARCH.zip ~/emacs-upload 74 mv emacs-$OF_VERSION.zip ~/emacs-upload
85} 75}
86 76
87function build_installer { 77function build_installer {
88 ARCH=$1 78 cd $HOME/emacs-build/install/
89 cd $HOME/emacs-build/install/emacs-$VERSION
90 echo [build] Calling makensis in `pwd` 79 echo [build] Calling makensis in `pwd`
91 cp $REPO_DIR/$BRANCH/admin/nt/dist-build/emacs.nsi . 80 cp $REPO_DIR/$BRANCH/admin/nt/dist-build/emacs.nsi .
92 81
93 makensis -v4 \ 82 makensis -v4 \
94 -DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \ 83 -DEMACS_VERSION=$ACTUAL_VERSION \
84 -DVERSION_BRANCH=$VERSION \
95 -DOUT_VERSION=$OF_VERSION emacs.nsi 85 -DOUT_VERSION=$OF_VERSION emacs.nsi
96 rm emacs.nsi 86 rm emacs.nsi
97 mv emacs-$OF_VERSION-$ARCH-installer.exe ~/emacs-upload 87 mv emacs-$OF_VERSION-installer.exe ~/emacs-upload
98} 88}
99 89
100set -o errexit 90set -o errexit
@@ -103,7 +93,6 @@ SNAPSHOT=
103CACHE= 93CACHE=
104 94
105BUILD=1 95BUILD=1
106BUILD_32=1
107BUILD_64=1 96BUILD_64=1
108GIT_UP=0 97GIT_UP=0
109CONFIG=1 98CONFIG=1
@@ -114,19 +103,8 @@ INSTALL_TARGET="install-strip"
114REPO_DIR=$HOME/emacs-build/git/ 103REPO_DIR=$HOME/emacs-build/git/
115 104
116 105
117while getopts "36gb:hnsiV:" opt; do 106while getopts "gb:hnsiV:" opt; do
118 case $opt in 107 case $opt in
119 3)
120 BUILD_32=1
121 BUILD_64=0
122 GIT_UP=0
123 ;;
124 6)
125 BUILD_32=0
126 BUILD_64=1
127 GIT_UP=0
128 ;;
129
130 g) 108 g)
131 BUILD_32=0 109 BUILD_32=0
132 BUILD_64=0 110 BUILD_64=0
@@ -152,10 +130,11 @@ while getopts "36gb:hnsiV:" opt; do
152 ;; 130 ;;
153 h) 131 h)
154 echo "build-zips.sh" 132 echo "build-zips.sh"
155 echo " -3 32 bit build only" 133 echo " -b args -- build args branch"
156 echo " -6 64 bit build only"
157 echo " -g git update and worktree only" 134 echo " -g git update and worktree only"
158 echo " -i build installer only" 135 echo " -i build installer only"
136 echo " -n do not configure"
137 echo " -s snaphot build"
159 exit 0 138 exit 0
160 ;; 139 ;;
161 \?) 140 \?)
@@ -208,7 +187,7 @@ then
208else 187else
209 BRANCH=$REQUIRED_BRANCH 188 BRANCH=$REQUIRED_BRANCH
210 echo [build] Building from Branch $BRANCH 189 echo [build] Building from Branch $BRANCH
211 VERSION=$VERSION-$BRANCH 190 VERSION=$VERSION-${BRANCH/\//_}
212 OF_VERSION="$VERSION-`date +%Y-%m-%d`" 191 OF_VERSION="$VERSION-`date +%Y-%m-%d`"
213 ## Use snapshot dependencies 192 ## Use snapshot dependencies
214 SNAPSHOT=1 193 SNAPSHOT=1
@@ -225,18 +204,7 @@ if (($BUILD_64))
225then 204then
226 if (($BUILD)) 205 if (($BUILD))
227 then 206 then
228 build_zip x86_64 /mingw64/lib/pkgconfig x86_64-w64-mingw32 207 build_zip
229 fi
230 build_installer x86_64
231fi
232
233## Do the 64 bit build first, because we reset some environment
234## variables during the 32 bit which will break the build.
235if (($BUILD_32))
236then
237 if (($BUILD))
238 then
239 build_zip i686 /mingw32/lib/pkgconfig i686-w64-mingw32
240 fi 208 fi
241 build_installer i686 209 build_installer
242fi 210fi
diff --git a/admin/nt/dist-build/emacs.nsi b/admin/nt/dist-build/emacs.nsi
index dce8f3db4a3..557bb106dde 100644
--- a/admin/nt/dist-build/emacs.nsi
+++ b/admin/nt/dist-build/emacs.nsi
@@ -2,7 +2,7 @@
2!include LogicLib.nsh 2!include LogicLib.nsh
3!include x64.nsh 3!include x64.nsh
4 4
5Outfile "emacs-${OUT_VERSION}-${ARCH}-installer.exe" 5Outfile "emacs-${OUT_VERSION}-installer.exe"
6 6
7 7
8SetCompressor /solid lzma 8SetCompressor /solid lzma
@@ -14,15 +14,15 @@ Var StartMenuFolder
14!define MUI_WELCOMEPAGE_TITLE_3LINES 14!define MUI_WELCOMEPAGE_TITLE_3LINES
15!define MUI_WELCOMEPAGE_TEXT "Welcome to Emacs -- the editor of a lifetime." 15!define MUI_WELCOMEPAGE_TEXT "Welcome to Emacs -- the editor of a lifetime."
16 16
17!define MUI_WELCOMEFINISHPAGE_BITMAP "${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\splash.bmp" 17!define MUI_WELCOMEFINISHPAGE_BITMAP "emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\etc\images\splash.bmp"
18!define MUI_ICON "${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico" 18!define MUI_ICON "emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
19!define MUI_UNICON "${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico" 19!define MUI_UNICON "emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
20 20
21!insertmacro MUI_PAGE_WELCOME 21!insertmacro MUI_PAGE_WELCOME
22 22
23 23
24!define MUI_LICENSEPAGE_TEXT_TOP "The GNU General Public License" 24!define MUI_LICENSEPAGE_TEXT_TOP "The GNU General Public License"
25!insertmacro MUI_PAGE_LICENSE "${ARCH}\share\emacs\${EMACS_VERSION}\lisp\COPYING" 25!insertmacro MUI_PAGE_LICENSE "emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\lisp\COPYING"
26 26
27!insertmacro MUI_PAGE_DIRECTORY 27!insertmacro MUI_PAGE_DIRECTORY
28!insertmacro MUI_PAGE_INSTFILES 28!insertmacro MUI_PAGE_INSTFILES
@@ -36,19 +36,7 @@ Var StartMenuFolder
36Name Emacs-${EMACS_VERSION} 36Name Emacs-${EMACS_VERSION}
37 37
38function .onInit 38function .onInit
39 ${If} ${RunningX64} 39 StrCpy $INSTDIR "$PROGRAMFILES64\Emacs"
40 ${If} ${ARCH} == "x86_64"
41 StrCpy $INSTDIR "$PROGRAMFILES64\Emacs"
42 ${Else}
43 StrCpy $INSTDIR "$PROGRAMFILES32\Emacs"
44 ${Endif}
45 ${Else}
46 ${If} ${ARCH} == "x86_64"
47 Quit
48 ${Else}
49 StrCpy $INSTDIR "$PROGRAMFILES\Emacs"
50 ${Endif}
51 ${EndIf}
52functionend 40functionend
53 41
54 42
@@ -56,7 +44,8 @@ Section
56 44
57 SetOutPath $INSTDIR 45 SetOutPath $INSTDIR
58 46
59 File /r ${ARCH} 47 File /r emacs-${VERSION_BRANCH}
48
60 # define uninstaller name 49 # define uninstaller name
61 WriteUninstaller $INSTDIR\Uninstall.exe 50 WriteUninstaller $INSTDIR\Uninstall.exe
62 51
@@ -66,7 +55,7 @@ Section
66 CreateShortcut "$SMPROGRAMS\$StartMenuFolder\Uninstall.lnk" "$INSTDIR\Uninstall.exe" 55 CreateShortcut "$SMPROGRAMS\$StartMenuFolder\Uninstall.lnk" "$INSTDIR\Uninstall.exe"
67 56
68 !insertmacro MUI_STARTMENU_WRITE_END 57 !insertmacro MUI_STARTMENU_WRITE_END
69 CreateShortCut "$SMPROGRAMS\$StartMenuFolder\Emacs.lnk" "$INSTDIR\${ARCH}\bin\runemacs.exe" 58 CreateShortCut "$SMPROGRAMS\$StartMenuFolder\Emacs.lnk" "$INSTDIR\emacs-${VERSION_BRANCH}\bin\runemacs.exe"
70SectionEnd 59SectionEnd
71 60
72 61
@@ -78,7 +67,7 @@ Section "Uninstall"
78 Delete "$INSTDIR\Uninstall.exe" 67 Delete "$INSTDIR\Uninstall.exe"
79 68
80 # now delete installed directory 69 # now delete installed directory
81 RMDir /r "$INSTDIR\${ARCH}" 70 RMDir /r "$INSTDIR"
82 RMDir "$INSTDIR" 71 RMDir "$INSTDIR"
83 72
84 !insertmacro MUI_STARTMENU_GETFOLDER Application $StartMenuFolder 73 !insertmacro MUI_STARTMENU_GETFOLDER Application $StartMenuFolder
diff --git a/configure.ac b/configure.ac
index 2a4a373371c..1bff666ad50 100644
--- a/configure.ac
+++ b/configure.ac
@@ -5769,6 +5769,12 @@ else
5769 ACL_SUMMARY=no 5769 ACL_SUMMARY=no
5770fi 5770fi
5771 5771
5772if test -z "$GMP_H"; then
5773 HAVE_GMP=yes
5774else
5775 HAVE_GMP=no
5776fi
5777
5772emacs_standard_dirs='Standard dirs' 5778emacs_standard_dirs='Standard dirs'
5773AS_ECHO([" 5779AS_ECHO(["
5774Configured for '${canonical}'. 5780Configured for '${canonical}'.
@@ -5783,12 +5789,14 @@ Configured for '${canonical}'.
5783 Where do we find X Windows header files? ${x_includes:-$emacs_standard_dirs} 5789 Where do we find X Windows header files? ${x_includes:-$emacs_standard_dirs}
5784 Where do we find X Windows libraries? ${x_libraries:-$emacs_standard_dirs}"]) 5790 Where do we find X Windows libraries? ${x_libraries:-$emacs_standard_dirs}"])
5785 5791
5792#### Please respect alphabetical ordering when making additions.
5786optsep= 5793optsep=
5787emacs_config_features= 5794emacs_config_features=
5788for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \ 5795for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \
5789 GCONF GSETTINGS GLIB NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE HARFBUZZ M17N_FLT \ 5796 HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \
5790 LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 XDBE XIM \ 5797 M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SOUND \
5791 NS MODULES NATIVE_COMP THREADS XWIDGETS LIBSYSTEMD JSON PDUMPER UNEXEC LCMS2 GMP; do 5798 THREADS TIFF TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS \
5799 X_TOOLKIT ZLIB; do
5792 5800
5793 case $opt in 5801 case $opt in
5794 PDUMPER) val=${with_pdumper} ;; 5802 PDUMPER) val=${with_pdumper} ;;
@@ -5825,11 +5833,6 @@ done
5825AC_DEFINE_UNQUOTED(EMACS_CONFIG_FEATURES, "${emacs_config_features}", 5833AC_DEFINE_UNQUOTED(EMACS_CONFIG_FEATURES, "${emacs_config_features}",
5826 [Summary of some of the main features enabled by configure.]) 5834 [Summary of some of the main features enabled by configure.])
5827 5835
5828if test -z "$GMP_H"; then
5829 HAVE_GMP=yes
5830else
5831 HAVE_GMP=no
5832fi
5833AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D} 5836AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D}
5834 Does Emacs use -lXpm? ${HAVE_XPM} 5837 Does Emacs use -lXpm? ${HAVE_XPM}
5835 Does Emacs use -ljpeg? ${HAVE_JPEG} 5838 Does Emacs use -ljpeg? ${HAVE_JPEG}
diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index c7c8fb30ac6..f81e64bdf9b 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
76the user option @code{minibuffer-follows-selected-frame} to 76the user option @code{minibuffer-follows-selected-frame} to
77@code{nil}, then the minibuffer stays in the frame where you opened 77@code{nil}, then the minibuffer stays in the frame where you opened
78it, and you must switch back to that frame in order to complete (or 78it, and you must switch back to that frame in order to complete (or
79abort) the current command. Note that the effect of the command, when 79abort) the current command. If you set that option to a value which
80you finally finish using the minibuffer, always takes place in the 80is neither @code{nil} nor @code{t}, the minibuffer moves frame only
81frame where you first opened it. 81after a recursive minibuffer has been opened in the current command
82(@pxref{Recursive Mini,,, elisp}). This option is mainly to retain
83(approximately) the behavior prior to Emacs 28.1. Note that the
84effect of the command, when you finally finish using the minibuffer,
85always takes place in the frame where you first opened it.
82 86
83@node Minibuffer File 87@node Minibuffer File
84@section Minibuffers for File Names 88@section Minibuffers for File Names
diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi
index 4da3d4a3e89..9a638818c91 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
57successive @kbd{C-g} characters to get out of a search. 57successive @kbd{C-g} characters to get out of a search.
58@xref{Incremental Search}, for details. 58@xref{Incremental Search}, for details.
59 59
60 If you type @kbd{C-g} in a minibuffer, this quits the command that
61opened that minibuffer, closing it. If that minibuffer is not the
62most recently opened one (which can happen when
63@code{minibuffer-follows-selected-frame} is @code{nil} (@pxref{Basic
64Minibuffer})), @kbd{C-g} also closes the more recently opened ones,
65quitting their associated commands, after asking you for confirmation.
66
60 On MS-DOS, the character @kbd{C-@key{Break}} serves as a quit character 67 On MS-DOS, the character @kbd{C-@key{Break}} serves as a quit character
61like @kbd{C-g}. The reason is that it is not feasible, on MS-DOS, to 68like @kbd{C-g}. The reason is that it is not feasible, on MS-DOS, to
62recognize @kbd{C-g} while a command is running, between interactions 69recognize @kbd{C-g} while a command is running, between interactions
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 6c68f70482a..3a2c7d019ef 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.
2696@code{read-event}, @code{read-char}, and @code{read-char-exclusive} do 2696@code{read-event}, @code{read-char}, and @code{read-char-exclusive} do
2697not perform the translations described in @ref{Translation Keymaps}. 2697not perform the translations described in @ref{Translation Keymaps}.
2698If you wish to read a single key taking these translations into 2698If you wish to read a single key taking these translations into
2699account, use the function @code{read-key}: 2699account (for example, to read @ref{Function Keys} in a terminal or
2700@ref{Mouse Events} from @code{xterm-mouse-mode}), use the function
2701@code{read-key}:
2700 2702
2701@defun read-key &optional prompt 2703@defun read-key &optional prompt disable-fallbacks
2702This function reads a single key. It is intermediate between 2704This function reads a single key. It is intermediate between
2703@code{read-key-sequence} and @code{read-event}. Unlike the former, it 2705@code{read-key-sequence} and @code{read-event}. Unlike the former, it
2704reads a single key, not a key sequence. Unlike the latter, it does 2706reads a single key, not a key sequence. Unlike the latter, it does
@@ -2708,6 +2710,14 @@ and @code{key-translation-map} (@pxref{Translation Keymaps}).
2708 2710
2709The argument @var{prompt} is either a string to be displayed in the 2711The argument @var{prompt} is either a string to be displayed in the
2710echo area as a prompt, or @code{nil}, meaning not to display a prompt. 2712echo area as a prompt, or @code{nil}, meaning not to display a prompt.
2713
2714If argument @var{disable-fallbacks} is non-@code{nil} then the usual
2715fallback logic for unbound keys in @code{read-key-sequence} is not
2716applied. This means that mouse button-down and multi-click events
2717will not be discarded and @code{local-function-key-map} and
2718@code{key-translation-map} will not get applied. If @code{nil} or
2719unspecified, the only fallback disabled is downcasing of the last
2720event.
2711@end defun 2721@end defun
2712 2722
2713@defun read-char-choice prompt chars &optional inhibit-quit 2723@defun read-char-choice prompt chars &optional inhibit-quit
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index b149a665fed..93e935ccf86 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
2485the width could be specified with only a single number @var{n} instead 2485the width could be specified with only a single number @var{n} instead
2486of a list, such case is equivalent to @code{((abs @var{n}) . @var{n})}. 2486of a list, such case is equivalent to @code{((abs @var{n}) . @var{n})}.
2487 2487
2488The value @var{color} specifies the color to draw with. The default is
2489the foreground color of the face for simple boxes, and the background
2490color of the face for 3D boxes.
2491
2492The value @var{style} specifies whether to draw a 3D box. If it is 2488The value @var{style} specifies whether to draw a 3D box. If it is
2493@code{released-button}, the box looks like a 3D button that is not being 2489@code{released-button}, the box looks like a 3D button that is not
2494pressed. If it is @code{pressed-button}, the box looks like a 3D button 2490being pressed. If it is @code{pressed-button}, the box looks like a
2495that is being pressed. If it is @code{nil} or omitted, a plain 2D box 24913D button that is being pressed. If it is @code{nil},
2496is used. 2492@code{flat-button} or omitted, a plain 2D box is used.
2493
2494The value @var{color} specifies the color to draw with. The default
2495is the background color of the face for 3D boxes and
2496@code{flat-button}, and the foreground color of the face for other
2497boxes.
2497@end table 2498@end table
2498 2499
2499@item :inverse-video 2500@item :inverse-video
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index fa548b503aa..12255d122f9 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -739,6 +739,7 @@ Minibuffers
739* Minibuffer Windows:: Operating on the special minibuffer windows. 739* Minibuffer Windows:: Operating on the special minibuffer windows.
740* Minibuffer Contents:: How such commands access the minibuffer text. 740* Minibuffer Contents:: How such commands access the minibuffer text.
741* Recursive Mini:: Whether recursive entry to minibuffer is allowed. 741* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
742* Inhibiting Interaction:: Running Emacs when no interaction is possible.
742* Minibuffer Misc:: Various customization hooks and variables. 743* Minibuffer Misc:: Various customization hooks and variables.
743 744
744Completion 745Completion
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index 9ec12714991..fb393b951f1 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}.
230 230
231@item unknown-image-type 231@item unknown-image-type
232The message is @samp{Cannot determine image type}. @xref{Images}. 232The message is @samp{Cannot determine image type}. @xref{Images}.
233
234@item inhibited-interaction
235The message is @samp{User interaction while inhibited}. This error is
236signalled when @code{inhibit-interaction} is non-@code{nil} and a user
237interaction function (like @code{read-from-minibuffer}) is called.
233@end table 238@end table
234 239
235@ignore The following seem to be unused now. 240@ignore The following seem to be unused now.
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index f0036f0ccfc..0ce17ed571a 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -32,6 +32,7 @@ argument.
32* Minibuffer Windows:: Operating on the special minibuffer windows. 32* Minibuffer Windows:: Operating on the special minibuffer windows.
33* Minibuffer Contents:: How such commands access the minibuffer text. 33* Minibuffer Contents:: How such commands access the minibuffer text.
34* Recursive Mini:: Whether recursive entry to minibuffer is allowed. 34* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
35* Inhibiting Interaction:: Running Emacs when no interaction is possible.
35* Minibuffer Misc:: Various customization hooks and variables. 36* Minibuffer Misc:: Various customization hooks and variables.
36@end menu 37@end menu
37 38
@@ -82,10 +83,12 @@ there is an active minibuffer; such a minibuffer is called a
82incrementing the number at the end of the name. (The names begin with 83incrementing the number at the end of the name. (The names begin with
83a space so that they won't show up in normal buffer lists.) Of 84a space so that they won't show up in normal buffer lists.) Of
84several recursive minibuffers, the innermost (or most recently 85several recursive minibuffers, the innermost (or most recently
85entered) is the active minibuffer. We usually call this @emph{the} 86entered) is the @dfn{active minibuffer}--it is the one you can
86minibuffer. You can permit or forbid recursive minibuffers by setting 87terminate by typing @key{RET} (@code{exit-minibuffer}) in. We usually
87the variable @code{enable-recursive-minibuffers}, or by putting 88call this @emph{the} minibuffer. You can permit or forbid recursive
88properties of that name on command symbols (@xref{Recursive Mini}.) 89minibuffers by setting the variable
90@code{enable-recursive-minibuffers}, or by putting properties of that
91name on command symbols (@xref{Recursive Mini}.)
89 92
90 Like other buffers, a minibuffer uses a local keymap 93 Like other buffers, a minibuffer uses a local keymap
91(@pxref{Keymaps}) to specify special key bindings. The function that 94(@pxref{Keymaps}) to specify special key bindings. The function that
@@ -2380,7 +2383,8 @@ minibuffer.
2380 2383
2381@deffn Command exit-minibuffer 2384@deffn Command exit-minibuffer
2382This command exits the active minibuffer. It is normally bound to 2385This command exits the active minibuffer. It is normally bound to
2383keys in minibuffer local keymaps. 2386keys in minibuffer local keymaps. The command throws an error if the
2387current buffer is not the active minibuffer.
2384@end deffn 2388@end deffn
2385 2389
2386@deffn Command self-insert-and-exit 2390@deffn Command self-insert-and-exit
@@ -2594,8 +2598,11 @@ returns zero.
2594If this variable is non-@code{nil}, you can invoke commands (such as 2598If this variable is non-@code{nil}, you can invoke commands (such as
2595@code{find-file}) that use minibuffers even while the minibuffer is 2599@code{find-file}) that use minibuffers even while the minibuffer is
2596active. Such invocation produces a recursive editing level for a new 2600active. Such invocation produces a recursive editing level for a new
2597minibuffer. The outer-level minibuffer is invisible while you are 2601minibuffer. By default, the outer-level minibuffer is invisible while
2598editing the inner one. 2602you are editing the inner one. If you have
2603@code{minibuffer-follows-selected-frame} set to @code{nil}, you can
2604have minibuffers visible on several frames at the same time.
2605@xref{Basic Minibuffer,,, emacs}.
2599 2606
2600If this variable is @code{nil}, you cannot invoke minibuffer commands 2607If this variable is @code{nil}, you cannot invoke minibuffer commands
2601when the minibuffer is active, not even if you switch to another window 2608when 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}).
2611The minibuffer command @code{next-matching-history-element} (normally 2618The minibuffer command @code{next-matching-history-element} (normally
2612@kbd{M-s} in the minibuffer) does the latter. 2619@kbd{M-s} in the minibuffer) does the latter.
2613 2620
2621@node Inhibiting Interaction
2622@section Inhibiting Interaction
2623
2624It's sometimes useful to be able to run Emacs as a headless server
2625process that responds to commands given over a network connection.
2626However, Emacs is primarily a platform for interactive usage, so many
2627commands prompt the user for feedback in certain anomalous situations.
2628This makes this use case more difficult, since the server process will
2629just hang waiting for user input.
2630
2631@vindex inhibit-interaction
2632Binding the @code{inhibit-interaction} variable to something
2633non-@code{nil} makes Emacs signal a @code{inhibited-interaction} error
2634instead of prompting, which can then be used by the server process to
2635handle these situations.
2636
2637Here's a typical use case:
2638
2639@lisp
2640(let ((inhibit-interaction t))
2641 (respond-to-client
2642 (condition-case err
2643 (my-client-handling-function)
2644 (inhibited-interaction err))))
2645@end lisp
2646
2647If @code{my-client-handling-function} ends up calling something that
2648asks the user for something (via @code{y-or-n-p} or
2649@code{read-from-minibuffer} or the like), an
2650@code{inhibited-interaction} error is signalled instead. The server
2651code then catches that error and reports it to the client.
2652
2614@node Minibuffer Misc 2653@node Minibuffer Misc
2615@section Minibuffer Miscellany 2654@section Minibuffer Miscellany
2616 2655
@@ -2623,7 +2662,7 @@ active minibuffer.
2623@end defun 2662@end defun
2624 2663
2625@defvar minibuffer-setup-hook 2664@defvar minibuffer-setup-hook
2626This is a normal hook that is run whenever the minibuffer is entered. 2665This is a normal hook that is run whenever a minibuffer is entered.
2627@xref{Hooks}. 2666@xref{Hooks}.
2628@end defvar 2667@end defvar
2629 2668
@@ -2641,7 +2680,7 @@ called once, for the outermost use of the minibuffer.
2641@end defmac 2680@end defmac
2642 2681
2643@defvar minibuffer-exit-hook 2682@defvar minibuffer-exit-hook
2644This is a normal hook that is run whenever the minibuffer is exited. 2683This is a normal hook that is run whenever a minibuffer is exited.
2645@xref{Hooks}. 2684@xref{Hooks}.
2646@end defvar 2685@end defvar
2647 2686
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 9d38fe6af95..abc12546410 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -4241,7 +4241,7 @@ Here is an example of an indentation function:
4241 (`(:elem . basic) sample-indent-basic) 4241 (`(:elem . basic) sample-indent-basic)
4242 (`(,_ . ",") (smie-rule-separator kind)) 4242 (`(,_ . ",") (smie-rule-separator kind))
4243 (`(:after . ":=") sample-indent-basic) 4243 (`(:after . ":=") sample-indent-basic)
4244 (`(:before . ,(or `"begin" `"(" `"@{"))) 4244 (`(:before . ,(or `"begin" `"(" `"@{"))
4245 (if (smie-rule-hanging-p) (smie-rule-parent))) 4245 (if (smie-rule-hanging-p) (smie-rule-parent)))
4246 (`(:before . "if") 4246 (`(:before . "if")
4247 (and (not (smie-rule-bolp)) (smie-rule-prev-p "else") 4247 (and (not (smie-rule-bolp)) (smie-rule-prev-p "else")
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index d810f15c802..034004d1df4 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
107@code{auth-source-search} queries. You can also use @code{login} and 107@code{auth-source-search} queries. You can also use @code{login} and
108@code{account}. 108@code{account}.
109 109
110Matching entries are usually used in the order they appear, so placing
111the most specific entries first in the file is a good idea. For
112instance:
113
114@example
115machine example.com login foobar password geheimnis port smtp
116machine example.com login foobar password hemmelig
117@end example
118
119Here we're using one password for the @code{smtp} service, and a
120different one for all the other services.
121
110You can also use this file to specify client certificates to use when 122You can also use this file to specify client certificates to use when
111setting up TLS connections. The format is: 123setting up TLS connections. The format is:
112 124
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 797315d5b81..5a79cbc08fc 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -20195,7 +20195,7 @@ Phu.
20195For example, to do hierarchical scoring but use a non-server-specific 20195For example, to do hierarchical scoring but use a non-server-specific
20196overall score file, you could use the value 20196overall score file, you could use the value
20197@example 20197@example
20198(list (lambda (group) ("all.SCORE")) 20198(list (lambda (group) (list "all.SCORE"))
20199 'gnus-score-find-hierarchical) 20199 'gnus-score-find-hierarchical)
20200@end example 20200@end example
20201 20201
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 358f6fc542e..2c4b792cc21 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.
443The default value for an empty local file name part is the remote 443The default value for an empty local file name part is the remote
444user's home directory. The shortest remote file name is 444user's home directory. The shortest remote file name is
445@file{@trampfn{-,,}}, therefore. The @samp{-} notation for the 445@file{@trampfn{-,,}}, therefore. The @samp{-} notation for the
446default host is used for syntactical reasons, @ref{Default Host}. 446default method is used for syntactical reasons, @ref{Default Method}.
447 447
448The @code{method} part describes the connection method used to reach 448The @code{method} part describes the connection method used to reach
449the remote host, see below. 449the remote host, see below.
@@ -1622,6 +1622,7 @@ support this command.
1622 1622
1623@subsection Tunneling with ssh 1623@subsection Tunneling with ssh
1624 1624
1625@vindex ProxyCommand@r{, ssh option}
1625With @command{ssh}, you could use the @option{ProxyCommand} entry in 1626With @command{ssh}, you could use the @option{ProxyCommand} entry in
1626@file{~/.ssh/config}: 1627@file{~/.ssh/config}:
1627 1628
@@ -2056,9 +2057,11 @@ default value is @t{"/data/local/tmp"} for the @option{adb} method,
2056@item @t{"direct-async-process"} 2057@item @t{"direct-async-process"}
2057 2058
2058When this property is non-@code{nil}, an alternative, more performant 2059When this property is non-@code{nil}, an alternative, more performant
2059implementation of @code{make-process} and 2060implementation of @code{make-process} and @code{start-file-process} is
2060@code{start-file-process} is applied. @ref{Improving performance of 2061applied. The connection method must also be marked with a
2061asynchronous remote processes} for a discussion of constraints. 2062non-@code{nil} @code{tramp-direct-async} parameter in
2063@code{tramp-methods}. @ref{Improving performance of asynchronous
2064remote processes} for a discussion of constraints.
2062 2065
2063@item @t{"posix"} 2066@item @t{"posix"}
2064 2067
@@ -2214,6 +2217,11 @@ overwrite this, you might apply
2214 2217
2215This uses also the settings in @code{tramp-sh-extra-args}. 2218This uses also the settings in @code{tramp-sh-extra-args}.
2216 2219
2220@vindex RemoteCommand@r{, ssh option}
2221@strong{Note}: If you use an @option{ssh}-based method for connection,
2222do @emph{not} set the @option{RemoteCommand} option in your
2223@command{ssh} configuration, for example to @command{screen}.
2224
2217 2225
2218@subsection Other remote shell setup hints 2226@subsection Other remote shell setup hints
2219@cindex remote shell setup 2227@cindex remote shell setup
@@ -3304,6 +3312,8 @@ whatever reason, then replace @code{(getenv "DISPLAY")} with a
3304hard-coded, fixed name. Note that using @code{:0} for X11 display name 3312hard-coded, fixed name. Note that using @code{:0} for X11 display name
3305here will not work as expected. 3313here will not work as expected.
3306 3314
3315@vindex ForwardX11@r{, ssh option}
3316@vindex ForwardX11Trusted@r{, ssh option}
3307An alternate approach is specify @option{ForwardX11 yes} or 3317An alternate approach is specify @option{ForwardX11 yes} or
3308@option{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local 3318@option{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local
3309host. 3319host.
@@ -3566,6 +3576,7 @@ Furthermore, this approach has the following limitations:
3566It works only for connection methods defined in @file{tramp-sh.el} and 3576It works only for connection methods defined in @file{tramp-sh.el} and
3567@file{tramp-adb.el}. 3577@file{tramp-adb.el}.
3568 3578
3579@vindex ControlMaster@r{, ssh option}
3569@item 3580@item
3570It does not support interactive user authentication. With 3581It does not support interactive user authentication. With
3571@option{ssh}-based methods, this can be avoided by using a password 3582@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
4269@item 4280@item
4270@value{tramp} does not recognize if a @command{ssh} session hangs 4281@value{tramp} does not recognize if a @command{ssh} session hangs
4271 4282
4283@vindex ServerAliveInterval@r{, ssh option}
4272@command{ssh} sessions on the local host hang when the network is 4284@command{ssh} sessions on the local host hang when the network is
4273down. @value{tramp} cannot safely detect such hangs. The network 4285down. @value{tramp} cannot safely detect such hangs. The network
4274configuration for @command{ssh} can be configured to kill such hangs 4286configuration for @command{ssh} can be configured to kill such hangs
@@ -4285,6 +4297,8 @@ Host *
4285@item 4297@item
4286@value{tramp} does not use default @command{ssh} @option{ControlPath} 4298@value{tramp} does not use default @command{ssh} @option{ControlPath}
4287 4299
4300@vindex ControlPath@r{, ssh option}
4301@vindex ControlPersist@r{, ssh option}
4288@value{tramp} overwrites @option{ControlPath} settings when initiating 4302@value{tramp} overwrites @option{ControlPath} settings when initiating
4289@command{ssh} sessions. @value{tramp} does this to fend off a stall 4303@command{ssh} sessions. @value{tramp} does this to fend off a stall
4290if a master session opened outside the Emacs session is no longer 4304if 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
4306@end group 4320@end group
4307@end lisp 4321@end lisp
4308 4322
4309Note how "%r", "%h" and "%p" must be encoded as "%%r", "%%h" and 4323Note how @samp{%r}, @samp{%h} and @samp{%p} must be encoded as
4310"%%p". 4324@samp{%%r}, @samp{%%h} and @samp{%%p}.
4311 4325
4312@vindex tramp-use-ssh-controlmaster-options 4326@vindex tramp-use-ssh-controlmaster-options
4313If the @file{~/.ssh/config} is configured appropriately for the above 4327If the @file{~/.ssh/config} is configured appropriately for the above
@@ -4318,6 +4332,8 @@ this @code{nil} setting:
4318(customize-set-variable 'tramp-use-ssh-controlmaster-options nil) 4332(customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
4319@end lisp 4333@end lisp
4320 4334
4335@vindex ProxyCommand@r{, ssh option}
4336@vindex ProxyJump@r{, ssh option}
4321This shall also be set to @code{nil} if you use the 4337This shall also be set to @code{nil} if you use the
4322@option{ProxyCommand} or @option{ProxyJump} options in your 4338@option{ProxyCommand} or @option{ProxyJump} options in your
4323@command{ssh} configuration. 4339@command{ssh} configuration.
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index 6970c46aef4..827c4773285 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -8,7 +8,7 @@
8@c In the Tramp GIT, the version numbers are auto-frobbed from 8@c In the Tramp GIT, the version numbers are auto-frobbed from
9@c tramp.el, and the bug report address is auto-frobbed from 9@c tramp.el, and the bug report address is auto-frobbed from
10@c configure.ac. 10@c configure.ac.
11@set trampver 2.5.0 11@set trampver 2.5.1-pre
12@set trampurl https://www.gnu.org/software/tramp/ 12@set trampurl https://www.gnu.org/software/tramp/
13@set tramp-bug-report-address tramp-devel@@gnu.org 13@set tramp-bug-report-address tramp-devel@@gnu.org
14@set emacsver 25.1 14@set emacsver 25.1
diff --git a/etc/NEWS b/etc/NEWS
index 6d7aa5042f4..19ad35032a2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -102,12 +102,13 @@ effect should be negligible in the vast majority of cases anyway.
102By default, when you switch to another frame, an active minibuffer now 102By default, when you switch to another frame, an active minibuffer now
103moves to the newly selected frame. Nevertheless, the effect of what 103moves to the newly selected frame. Nevertheless, the effect of what
104you type in the minibuffer happens in the frame where the minibuffer 104you type in the minibuffer happens in the frame where the minibuffer
105was first activated, even if it moved to another frame. An 105was first activated. An alternative behavior is available by
106alternative behavior is available by customizing 106customizing 'minibuffer-follows-selected-frame' to nil. Here, the
107'minibuffer-follows-selected-frame' to nil. Here, the minibuffer 107minibuffer stays in the frame where you first opened it, and you must
108stays in the frame where you first opened it, and you must switch back 108switch back to this frame to continue or abort its command. The old
109to this frame to continue or abort its command. The old, somewhat 109behavior, which mixed these two, can be approximated by customizing
110unsystematic behavior, which mixed these two is no longer available. 110'minibuffer-follows-selected-frame' to a value which is neither nil
111nor t.
111 112
112+++ 113+++
113** New system for displaying documentation for groups of functions. 114** New system for displaying documentation for groups of functions.
@@ -347,6 +348,8 @@ is set to nil, this message is inhibited.
347 348
348** Python mode 349** Python mode
349 350
351*** 'python-shell-interpreter' now defaults to python3 on systems with python3.
352
350*** 'C-c C-r' can now be used on arbitrary regions. 353*** 'C-c C-r' can now be used on arbitrary regions.
351The command previously extended the start of the region to the start 354The command previously extended the start of the region to the start
352of the line, but will now actually send the marked region, as 355of the line, but will now actually send the marked region, as
@@ -699,6 +702,13 @@ not.
699 702
700** Message 703** Message
701 704
705---
706*** Respect 'message-forward-ignored-headers' more.
707Previously, this variable would not be consulted if
708'message-forward-show-mml' was nil. It's now always used, except if
709'message-forward-show-mml' is 'best', and we're forwarding an
710encrypted/signed message.
711
702+++ 712+++
703*** Message now supports the OpenPGP header. 713*** Message now supports the OpenPGP header.
704To generate these headers, add the new function 714To generate these headers, add the new function
@@ -1337,6 +1347,11 @@ have been renamed to have "proper" public names and documented
1337('xref-show-definitions-buffer' and 1347('xref-show-definitions-buffer' and
1338'xref-show-definitions-buffer-at-bottom'). 1348'xref-show-definitions-buffer-at-bottom').
1339 1349
1350*** New command 'xref-quit-and-pop-marker-stack' and a binding for it
1351in Xref buffers ('M-,'). This combination is easy to press
1352semi-accidentally if the user wants to go back in the middle of
1353choosing the exact definition to go to, and this should do TRT.
1354
1340--- 1355---
1341*** New value 'project-relative' for 'xref-file-name-display' 1356*** New value 'project-relative' for 'xref-file-name-display'
1342If chosen, file names in *xref* buffers will be displayed relative 1357If 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.
1361** erc 1376** erc
1362 1377
1363--- 1378---
1379*** erc-services.el now supports NickServ passwords from auth-source.
1380The 'erc-use-auth-source-for-nickserv-password' variable enables querying
1381auth-source for NickServ passwords. To enable this, add the following
1382to your init file:
1383
1384 (setq erc-prompt-for-nickserv-password nil
1385 erc-use-auth-source-for-nickserv-password t)
1386
1387---
1364*** The '/ignore' command will now ask for a timeout to stop ignoring the user. 1388*** The '/ignore' command will now ask for a timeout to stop ignoring the user.
1365Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m". 1389Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m".
1366 1390
@@ -1517,8 +1541,22 @@ that makes it a valid button.
1517 1541
1518** Miscellaneous 1542** Miscellaneous
1519 1543
1544*** New function 'buffer-line-statistics'.
1545This function returns some statistics about the line lengths in a buffer.
1546
1547+++
1548*** New variable 'inhibit-interaction' to make user prompts signal an error.
1549If this is bound to something non-nil, functions like
1550`read-from-minibuffer', `read-char' (and related) will signal an
1551`inhibited-interaction' error.
1552
1553---
1554*** 'process-attributes' now works under OpenBSD, too.
1555
1520+++ 1556+++
1521*** 'add-to-ordered-list' can now take a test predicate. 1557*** New button face 'flat-button'.
1558This is a plain 2D button, but uses the background color instead of
1559the foreground color.
1522 1560
1523+++ 1561+++
1524*** New predicate functions 'length<', 'length>' and 'length='. 1562*** New predicate functions 'length<', 'length>' and 'length='.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 25e129bcd99..15e34ea06f8 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -746,6 +746,11 @@ versions of gnutls-cli, or use Emacs's built-in gnutls support.
746 746
747** Characters are displayed as empty boxes or with wrong font under X. 747** Characters are displayed as empty boxes or with wrong font under X.
748 748
749*** This may be due to your local fontconfig customization.
750Try removing or moving aside "$XDG_CONFIG_HOME/fontconfig/conf.d" and
751"$XDG_CONFIG_HOME/fontconfig/fonts.conf"
752($XDG_CONFIG_HOME is treated as "~/.config" if not set)
753
749*** This can occur when two different versions of FontConfig are used. 754*** This can occur when two different versions of FontConfig are used.
750For example, XFree86 4.3.0 has one version and Gnome usually comes 755For example, XFree86 4.3.0 has one version and Gnome usually comes
751with a newer version. Emacs compiled with Gtk+ will then use the 756with a newer version. Emacs compiled with Gtk+ will then use the
diff --git a/etc/w32-feature.el b/etc/w32-feature.el
index c5f2cd548ad..364e9341ae3 100644
--- a/etc/w32-feature.el
+++ b/etc/w32-feature.el
@@ -25,9 +25,21 @@
25;; designed to check whether bundled binary distributions of Emacs on 25;; designed to check whether bundled binary distributions of Emacs on
26;; windows are fully functional. 26;; windows are fully functional.
27 27
28;; By default is checks whether the features that we are expect to be
29;; available on Emacs for Windows are reported to be available. It
30;; should be possible to run these tests from a distributed version of
31;; Emacs.
32
33;; In addition, it provides a single command
34;; `w32-feature-load-tests'. If the full source repository of Emacs is
35;; available, this will load selected files from the repository which
36;; test these features.
37
28;;; Code: 38;;; Code:
29(require 'ert) 39(require 'ert)
30 40
41(defvar w32-feature-core-tests nil)
42
31(ert-deftest feature-optimization () 43(ert-deftest feature-optimization ()
32 (should 44 (should
33 (string-match-p "CFLAGS=-O2" system-configuration-options))) 45 (string-match-p "CFLAGS=-O2" system-configuration-options)))
@@ -41,16 +53,24 @@
41(ert-deftest feature-gnutls () 53(ert-deftest feature-gnutls ()
42 (should (gnutls-available-p))) 54 (should (gnutls-available-p)))
43 55
56(add-to-list 'w32-feature-core-tests "lisp/net/gnutls-tests.el")
57
44(ert-deftest feature-zlib () 58(ert-deftest feature-zlib ()
45 (should (zlib-available-p))) 59 (should (zlib-available-p)))
46 60
61(add-to-list 'w32-feature-core-tests "src/decompress-tests.el")
62
47(ert-deftest feature-thread () 63(ert-deftest feature-thread ()
48 (should (fboundp 'make-thread))) 64 (should (fboundp 'make-thread)))
49 65
66(add-to-list 'w32-feature-core-tests "lisp/thread-tests.el")
67
50(ert-deftest feature-json () 68(ert-deftest feature-json ()
51 (should 69 (should
52 (fboundp 'json-serialize))) 70 (fboundp 'json-serialize)))
53 71
72(add-to-list 'w32-feature-core-tests "src/json-tests.el")
73
54(ert-deftest feature-gmp () 74(ert-deftest feature-gmp ()
55 (should 75 (should
56 (string-match-p "GMP" system-configuration-features))) 76 (string-match-p "GMP" system-configuration-features)))
@@ -61,9 +81,13 @@
61(ert-deftest feature-libxml () 81(ert-deftest feature-libxml ()
62 (should (libxml-available-p))) 82 (should (libxml-available-p)))
63 83
84(add-to-list 'w32-feature-core-tests "src/xml-tests.el")
85
64(ert-deftest feature-lcms2 () 86(ert-deftest feature-lcms2 ()
65 (should (lcms2-available-p))) 87 (should (lcms2-available-p)))
66 88
89(add-to-list 'w32-feature-core-tests "src/lcms-tests.el")
90
67(ert-deftest feature-xpm () 91(ert-deftest feature-xpm ()
68 (should (image-type-available-p 'xpm))) 92 (should (image-type-available-p 'xpm)))
69 93
@@ -73,8 +97,7 @@
73(ert-deftest feature-png () 97(ert-deftest feature-png ()
74 (should (image-type-available-p 'png))) 98 (should (image-type-available-p 'png)))
75 99
76(ert-deftest feature-xpm () 100(add-to-list 'w32-feature-core-tests "lisp/image-file-tests.el")
77 (should (image-type-available-p 'xpm)))
78 101
79(ert-deftest feature-jpeg () 102(ert-deftest feature-jpeg ()
80 (should (image-type-available-p 'jpeg))) 103 (should (image-type-available-p 'jpeg)))
@@ -84,4 +107,12 @@
84 107
85(ert-deftest feature-svg () 108(ert-deftest feature-svg ()
86 (should (image-type-available-p 'svg))) 109 (should (image-type-available-p 'svg)))
110
111(defun w32-feature-load-tests (dir)
112 (interactive "D")
113 (mapc
114 (lambda(f)
115 (load-file (concat dir "test/" f)))
116 w32-feature-core-tests))
117
87;;; feature.el ends here 118;;; feature.el ends here
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 68ae4685898..d684c7ba97f 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1095,15 +1095,7 @@ Used by `calc-user-invocation'.")
1095 (ignore-errors 1095 (ignore-errors
1096 (define-key calc-digit-map x 'calcDigit-delchar) 1096 (define-key calc-digit-map x 'calcDigit-delchar)
1097 (define-key calc-mode-map x 'calc-pop) 1097 (define-key calc-mode-map x 'calc-pop)
1098 (define-key calc-mode-map 1098 (define-key calc-mode-map (vconcat "\e" x) 'calc-pop-above)))
1099 (if (and (vectorp x) (featurep 'xemacs))
1100 (if (= (length x) 1)
1101 (vector (if (consp (aref x 0))
1102 (cons 'meta (aref x 0))
1103 (list 'meta (aref x 0))))
1104 "\e\C-d")
1105 (vconcat "\e" x))
1106 'calc-pop-above)))
1107 (if calc-scan-for-dels 1099 (if calc-scan-for-dels
1108 (append (where-is-internal 'delete-forward-char global-map) 1100 (append (where-is-internal 'delete-forward-char global-map)
1109 '("\C-d")) 1101 '("\C-d"))
diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el
index ee75e297993..e1417d7806c 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
64can be used to define that match without loading the specific project 64can be used to define that match without loading the specific project
65into memory.") 65into memory.")
66 66
67(cl-defmethod ede-calc-fromconfig ((dirmatch ede-project-autoload-dirmatch))
68 "Calculate the value of :fromconfig from DIRMATCH."
69 (let* ((fc (oref dirmatch fromconfig))
70 (found (cond ((stringp fc) fc)
71 ((functionp fc) (funcall fc))
72 (t (error "Unknown dirmatch object match style.")))))
73 (expand-file-name found)
74 ))
75
67(cl-defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch)) 76(cl-defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
68 "Return non-nil if the tool DIRMATCH might match is installed on the system." 77 "Return non-nil if the tool DIRMATCH might match is installed on the system."
69 (let ((fc (oref dirmatch fromconfig))) 78 (file-exists-p (ede-calc-fromconfig dirmatch)))
70
71 (cond
72 ;; If the thing to match is stored in a config file.
73 ((stringp fc)
74 (file-exists-p fc))
75
76 ;; Add new types of dirmatches here.
77
78 ;; Error for weird stuff
79 (t (error "Unknown dirmatch type.")))))
80
81 79
82(cl-defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file) 80(cl-defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
83 "Does DIRMATCH match the filename FILE." 81 "Does DIRMATCH match the filename FILE."
84 (let ((fc (oref dirmatch fromconfig))) 82 (let ((fc (ede-calc-fromconfig dirmatch)))
85 83
86 (cond 84 (cond
87 ;; If the thing to match is stored in a config file. 85 ;; If the thing to match is stored in a config file.
diff --git a/lisp/comint.el b/lisp/comint.el
index 2e683a75724..53153af7d27 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -979,6 +979,7 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
979 (ring (make-ring ring-size)) 979 (ring (make-ring ring-size))
980 ;; Use possibly buffer-local values of these variables. 980 ;; Use possibly buffer-local values of these variables.
981 (ring-separator comint-input-ring-separator) 981 (ring-separator comint-input-ring-separator)
982 (ring-file-prefix comint-input-ring-file-prefix)
982 (history-ignore comint-input-history-ignore) 983 (history-ignore comint-input-history-ignore)
983 (ignoredups comint-input-ignoredups)) 984 (ignoredups comint-input-ignoredups))
984 (with-temp-buffer 985 (with-temp-buffer
@@ -990,24 +991,15 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
990 (while (and (< count comint-input-ring-size) 991 (while (and (< count comint-input-ring-size)
991 (re-search-backward ring-separator nil t) 992 (re-search-backward ring-separator nil t)
992 (setq end (match-beginning 0))) 993 (setq end (match-beginning 0)))
993 (setq start 994 (goto-char (if (re-search-backward ring-separator nil t)
994 (if (re-search-backward ring-separator nil t) 995 (match-end 0)
995 (progn 996 (point-min)))
996 (when (and comint-input-ring-file-prefix 997 (when (and ring-file-prefix
997 (looking-at 998 (looking-at ring-file-prefix))
998 comint-input-ring-file-prefix)) 999 ;; Skip zsh extended_history stamps
999 ;; Skip zsh extended_history stamps 1000 (goto-char (match-end 0)))
1000 (goto-char (match-end 0))) 1001 (setq start (point))
1001 (match-end 0))
1002 (progn
1003 (goto-char (point-min))
1004 (when (and comint-input-ring-file-prefix
1005 (looking-at
1006 comint-input-ring-file-prefix))
1007 (goto-char (match-end 0)))
1008 (point))))
1009 (setq history (buffer-substring start end)) 1002 (setq history (buffer-substring start end))
1010 (goto-char start)
1011 (when (and (not (string-match history-ignore history)) 1003 (when (and (not (string-match history-ignore history))
1012 (or (null ignoredups) 1004 (or (null ignoredups)
1013 (ring-empty-p ring) 1005 (ring-empty-p ring)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 5dcb2842a21..21fe89c6214 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -175,6 +175,7 @@
175 (choice :tag "Style" 175 (choice :tag "Style"
176 (const :tag "Raised" released-button) 176 (const :tag "Raised" released-button)
177 (const :tag "Sunken" pressed-button) 177 (const :tag "Sunken" pressed-button)
178 (const :tag "Flat" flat-button)
178 (const :tag "None" nil)))) 179 (const :tag "None" nil))))
179 ;; filter to make value suitable for customize 180 ;; filter to make value suitable for customize
180 (lambda (real-value) 181 (lambda (real-value)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 85dd14f6282..0293d34d1cd 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
394 ;; (directory :format "%v")))) 394 ;; (directory :format "%v"))))
395 (load-prefer-newer lisp boolean "24.4") 395 (load-prefer-newer lisp boolean "24.4")
396 ;; minibuf.c 396 ;; minibuf.c
397 (minibuffer-follows-selected-frame minibuffer boolean "28.1") 397 (minibuffer-follows-selected-frame
398 minibuffer (choice (const :tag "Always" t)
399 (const :tag "When used" hybrid)
400 (const :tag "Never" nil))
401 "28.1")
398 (enable-recursive-minibuffers minibuffer boolean) 402 (enable-recursive-minibuffers minibuffer boolean)
399 (history-length minibuffer 403 (history-length minibuffer
400 (choice (const :tag "Infinite" t) integer) 404 (choice (const :tag "Infinite" t) integer)
diff --git a/lisp/custom.el b/lisp/custom.el
index d9d0898dcb7..58ecd0439ad 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
136 ;; No longer true: 136 ;; No longer true:
137 ;; "See `send-mail-function' in sendmail.el for an example." 137 ;; "See `send-mail-function' in sendmail.el for an example."
138 138
139 ;; Defvar it so as to mark it special, etc (bug#25770).
140 (internal--define-uninitialized-variable symbol)
141
139 ;; Until the var is actually initialized, it is kept unbound. 142 ;; Until the var is actually initialized, it is kept unbound.
140 ;; This seemed to be at least as good as setting it to an arbitrary 143 ;; This seemed to be at least as good as setting it to an arbitrary
141 ;; value like nil (evaluating `value' is not an option because it 144 ;; value like nil (evaluating `value' is not an option because it
@@ -237,6 +240,8 @@ The following keywords are meaningful:
237 240
238:type VALUE should be a widget type for editing the symbol's value. 241:type VALUE should be a widget type for editing the symbol's value.
239 Every `defcustom' should specify a value for this keyword. 242 Every `defcustom' should specify a value for this keyword.
243 See Info node `(elisp) Customization Types' for a list of
244 base types and useful composite types.
240:options VALUE should be a list of valid members of the widget type. 245:options VALUE should be a list of valid members of the widget type.
241:initialize 246:initialize
242 VALUE should be a function used to initialize the 247 VALUE should be a function used to initialize the
@@ -778,8 +783,7 @@ Return non-nil if the `customized-value' property actually changed."
778Use the :set function to do so. This is useful for customizable options 783Use the :set function to do so. This is useful for customizable options
779that are defined before their standard value can really be computed. 784that are defined before their standard value can really be computed.
780E.g. dumped variables whose default depends on run-time information." 785E.g. dumped variables whose default depends on run-time information."
781 ;; If it has never been set at all, defvar it so as to mark it 786 ;; We are initializing
782 ;; special, etc (bug#25770). This means we are initializing
783 ;; the variable, and normally any :set function would not apply. 787 ;; the variable, and normally any :set function would not apply.
784 ;; For custom-initialize-delay, however, it is documented that "the 788 ;; For custom-initialize-delay, however, it is documented that "the
785 ;; (delayed) initialization is performed with the :set function". 789 ;; (delayed) initialization is performed with the :set function".
@@ -787,11 +791,10 @@ E.g. dumped variables whose default depends on run-time information."
787 ;; custom-initialize-delay but needs the :set function custom-set-minor-mode 791 ;; custom-initialize-delay but needs the :set function custom-set-minor-mode
788 ;; to also run during initialization. So, long story short, we 792 ;; to also run during initialization. So, long story short, we
789 ;; always do the funcall step, even if symbol was not bound before. 793 ;; always do the funcall step, even if symbol was not bound before.
790 (or (default-boundp symbol)
791 (eval `(defvar ,symbol nil))) ; reset below, so any value is fine
792 (funcall (or (get symbol 'custom-set) #'set-default) 794 (funcall (or (get symbol 'custom-set) #'set-default)
793 symbol 795 symbol
794 (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value)))))) 796 (eval (car (or (get symbol 'saved-value)
797 (get symbol 'standard-value))))))
795 798
796 799
797;;; Custom Themes 800;;; Custom Themes
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 5a52eccbbe3..aebffe339eb 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."
1483;;; Internal functions. 1483;;; Internal functions.
1484 1484
1485;; Fixme: This should probably use `thing-at-point'. -- fx 1485;; Fixme: This should probably use `thing-at-point'. -- fx
1486(define-obsolete-function-alias 'dired-filename-at-point 1486(define-obsolete-function-alias 'dired-file-name-at-point
1487 #'dired-x-guess-file-name-at-point "28.1") 1487 #'dired-x-guess-file-name-at-point "28.1")
1488(defun dired-x-guess-file-name-at-point () 1488(defun dired-x-guess-file-name-at-point ()
1489 "Return the filename closest to point, expanded. 1489 "Return the filename closest to point, expanded.
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 19dd54c8645..8e36dbe4a36 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."
304 (lambda ,args ,@body)))) 304 (lambda ,args ,@body))))
305 305
306(eval-and-compile ;Needed while compiling the cl-defmethod calls below! 306(eval-and-compile ;Needed while compiling the cl-defmethod calls below!
307 (defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el.
308 "Check which of the symbols VARS appear in SEXP."
309 (let ((res '()))
310 (while (consp sexp)
311 (dolist (var (cl--generic-fgrep vars (pop sexp)))
312 (unless (memq var res) (push var res))))
313 (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
314 res))
315
316 (defun cl--generic-split-args (args) 307 (defun cl--generic-split-args (args)
317 "Return (SPEC-ARGS . PLAIN-ARGS)." 308 "Return (SPEC-ARGS . PLAIN-ARGS)."
318 (let ((plain-args ()) 309 (let ((plain-args ())
@@ -375,11 +366,11 @@ the specializer used will be the one returned by BODY."
375 ;; is used. 366 ;; is used.
376 ;; FIXME: Also, optimize the case where call-next-method is 367 ;; FIXME: Also, optimize the case where call-next-method is
377 ;; only called with explicit arguments. 368 ;; only called with explicit arguments.
378 (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody))) 369 (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)))
379 (cons (not (not uses-cnm)) 370 (cons (not (not uses-cnm))
380 `#'(lambda (,@(if uses-cnm (list cnm)) ,@args) 371 `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
381 ,@(car parsed-body) 372 ,@(car parsed-body)
382 ,(if (not (memq nmp uses-cnm)) 373 ,(if (not (assq nmp uses-cnm))
383 nbody 374 nbody
384 `(let ((,nmp (lambda () 375 `(let ((,nmp (lambda ()
385 (cl--generic-isnot-nnm-p ,cnm)))) 376 (cl--generic-isnot-nnm-p ,cnm))))
@@ -617,11 +608,11 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
617 (lambda (,@fixedargs &rest args) 608 (lambda (,@fixedargs &rest args)
618 (let ,bindings 609 (let ,bindings
619 (apply (cl--generic-with-memoization 610 (apply (cl--generic-with-memoization
620 (gethash ,tag-exp method-cache) 611 (gethash ,tag-exp method-cache)
621 (cl--generic-cache-miss 612 (cl--generic-cache-miss
622 generic ',dispatch-arg dispatches-left methods 613 generic ',dispatch-arg dispatches-left methods
623 ,(if (cdr typescodes) 614 ,(if (cdr typescodes)
624 `(append ,@typescodes) (car typescodes)))) 615 `(append ,@typescodes) (car typescodes))))
625 ,@fixedargs args))))))))) 616 ,@fixedargs args)))))))))
626 617
627(defun cl--generic-make-function (generic) 618(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."
1110 (if (not (eq (car-safe specializer) 'head)) 1101 (if (not (eq (car-safe specializer) 'head))
1111 (cl-call-next-method) 1102 (cl-call-next-method)
1112 (cl--generic-with-memoization 1103 (cl--generic-with-memoization
1113 (gethash (cadr specializer) cl--generic-head-used) specializer) 1104 (gethash (cadr specializer) cl--generic-head-used)
1105 specializer)
1114 (list cl--generic-head-generalizer))) 1106 (list cl--generic-head-generalizer)))
1115 1107
1116(cl--generic-prefill-dispatchers 0 (head eql)) 1108(cl--generic-prefill-dispatchers 0 (head eql))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index ac7360b935b..fb43a0bc956 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.
2060 ((null (cdr bindings)) `(cl-flet ,bindings ,@body)) 2060 ((null (cdr bindings)) `(cl-flet ,bindings ,@body))
2061 (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body))))) 2061 (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
2062 2062
2063(defun cl--self-tco (var fargs body)
2064 ;; This tries to "optimize" tail calls for the specific case
2065 ;; of recursive self-calls by replacing them with a `while' loop.
2066 ;; It is quite far from a general tail-call optimization, since it doesn't
2067 ;; even handle mutually recursive functions.
2068 (letrec
2069 ((done nil) ;; Non-nil if some TCO happened.
2070 (retvar (make-symbol "retval"))
2071 (ofargs (mapcar (lambda (s) (if (memq s cl--lambda-list-keywords) s
2072 (make-symbol (symbol-name s))))
2073 fargs))
2074 (opt-exps (lambda (exps) ;; `exps' is in tail position!
2075 (append (butlast exps)
2076 (list (funcall opt (car (last exps)))))))
2077 (opt
2078 (lambda (exp) ;; `exp' is in tail position!
2079 (pcase exp
2080 ;; FIXME: Optimize `apply'?
2081 (`(funcall ,(pred (eq var)) . ,aargs)
2082 ;; This is a self-recursive call in tail position.
2083 (let ((sets nil)
2084 (fargs ofargs))
2085 (while fargs
2086 (pcase (pop fargs)
2087 ('&rest
2088 (push (pop fargs) sets)
2089 (push `(list . ,aargs) sets)
2090 ;; (cl-assert (null fargs))
2091 )
2092 ('&optional nil)
2093 (farg
2094 (push farg sets)
2095 (push (pop aargs) sets))))
2096 (setq done t)
2097 `(progn (setq . ,(nreverse sets))
2098 :recurse)))
2099 (`(progn . ,exps) `(progn . ,(funcall opt-exps exps)))
2100 (`(if ,cond ,then . ,else)
2101 `(if ,cond ,(funcall opt then) . ,(funcall opt-exps else)))
2102 (`(cond . ,conds)
2103 (let ((cs '()))
2104 (while conds
2105 (pcase (pop conds)
2106 (`(,exp)
2107 (push (if conds
2108 ;; This returns the value of `exp' but it's
2109 ;; only in tail position if it's the
2110 ;; last condition.
2111 `((setq ,retvar ,exp) nil)
2112 `(,(funcall opt exp)))
2113 cs))
2114 (exps
2115 (push (funcall opt-exps exps) cs))))
2116 (if (eq t (caar cs))
2117 `(cond . ,(nreverse cs))
2118 `(cond ,@(nreverse cs) (t (setq ,retvar nil))))))
2119 ((and `(,(or 'let 'let*) ,bindings . ,exps)
2120 (guard
2121 ;; Note: it's OK for this `let' to shadow any
2122 ;; of the formal arguments since we will only
2123 ;; setq the fresh new `ofargs' vars instead ;-)
2124 (let ((shadowings
2125 (mapcar (lambda (b) (if (consp b) (car b) b)) bindings)))
2126 ;; If `var' is shadowed, then it clearly can't be
2127 ;; tail-called any more.
2128 (not (memq var shadowings)))))
2129 `(,(car exp) ,bindings . ,(funcall opt-exps exps)))
2130 (_
2131 `(progn (setq ,retvar ,exp) nil))))))
2132
2133 (let ((optimized-body (funcall opt-exps body)))
2134 (if (not done)
2135 (cons fargs body)
2136 ;; We use two sets of vars: `ofargs' and `fargs' because we need
2137 ;; to be careful that if a closure captures a formal argument
2138 ;; in one iteration, it needs to capture a different binding
2139 ;; then that of other iterations, e.g.
2140 (cons
2141 ofargs
2142 `((let (,retvar)
2143 (while (let ,(delq nil
2144 (cl-mapcar
2145 (lambda (a oa)
2146 (unless (memq a cl--lambda-list-keywords)
2147 (list a oa)))
2148 fargs ofargs))
2149 . ,optimized-body))
2150 ,retvar)))))))
2151
2063;;;###autoload 2152;;;###autoload
2064(defmacro cl-labels (bindings &rest body) 2153(defmacro cl-labels (bindings &rest body)
2065 "Make local (recursive) function definitions. 2154 "Make local (recursive) function definitions.
2066Each definition can take the form (FUNC ARGLIST BODY...) where 2155+BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where
2067FUNC is the function name, ARGLIST its arguments, and BODY the 2156FUNC is the function name, ARGLIST its arguments, and BODY the
2068forms of the function body. FUNC is defined in any BODY, as well 2157forms of the function body. FUNC is defined in any BODY, as well
2069as FORM, so you can write recursive and mutually recursive 2158as FORM, so you can write recursive and mutually recursive
@@ -2075,17 +2164,33 @@ details.
2075 (let ((binds ()) (newenv macroexpand-all-environment)) 2164 (let ((binds ()) (newenv macroexpand-all-environment))
2076 (dolist (binding bindings) 2165 (dolist (binding bindings)
2077 (let ((var (make-symbol (format "--cl-%s--" (car binding))))) 2166 (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
2078 (push (list var `(cl-function (lambda . ,(cdr binding)))) binds) 2167 (push (cons var (cdr binding)) binds)
2079 (push (cons (car binding) 2168 (push (cons (car binding)
2080 (lambda (&rest args) 2169 (lambda (&rest args)
2081 (if (eq (car args) cl--labels-magic) 2170 (if (eq (car args) cl--labels-magic)
2082 (list cl--labels-magic var) 2171 (list cl--labels-magic var)
2083 (cl-list* 'funcall var args)))) 2172 (cl-list* 'funcall var args))))
2084 newenv))) 2173 newenv)))
2085 (macroexpand-all `(letrec ,(nreverse binds) ,@body) 2174 ;; Don't override lexical-let's macro-expander.
2086 ;; Don't override lexical-let's macro-expander. 2175 (unless (assq 'function newenv)
2087 (if (assq 'function newenv) newenv 2176 (push (cons 'function #'cl--labels-convert) newenv))
2088 (cons (cons 'function #'cl--labels-convert) newenv))))) 2177 ;; Perform self-tail call elimination.
2178 (setq binds (mapcar
2179 (lambda (bind)
2180 (pcase-let*
2181 ((`(,var ,sargs . ,sbody) bind)
2182 (`(function (lambda ,fargs . ,ebody))
2183 (macroexpand-all `(cl-function (lambda ,sargs . ,sbody))
2184 newenv))
2185 (`(,ofargs . ,obody)
2186 (cl--self-tco var fargs ebody)))
2187 `(,var (function (lambda ,ofargs . ,obody)))))
2188 (nreverse binds)))
2189 `(letrec ,binds
2190 . ,(macroexp-unprogn
2191 (macroexpand-all
2192 (macroexp-progn body)
2193 newenv)))))
2089 2194
2090;; The following ought to have a better definition for use with newer 2195;; The following ought to have a better definition for use with newer
2091;; byte compilers. 2196;; byte compilers.
@@ -3413,8 +3518,8 @@ macro that returns its `&whole' argument."
3413 (put y 'side-effect-free t)) 3518 (put y 'side-effect-free t))
3414 3519
3415;;; Things that are inline. 3520;;; Things that are inline.
3416(cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany 3521(cl-proclaim '(inline cl-acons cl-map cl-notany cl-notevery cl-revappend
3417 cl-notevery cl-revappend cl-nreconc gethash)) 3522 cl-nreconc gethash))
3418 3523
3419;;; Things that are side-effect-free. 3524;;; Things that are side-effect-free.
3420(mapc (lambda (x) (function-put x 'side-effect-free t)) 3525(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 4ba72aea56d..ec1077d447e 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -162,6 +162,59 @@ only one object ever exists."
162 old))) 162 old)))
163 163
164 164
165;;; Named object
166
167(defclass eieio-named ()
168 ((object-name :initarg :object-name :initform nil))
169 "Object with a name."
170 :abstract t)
171
172(cl-defmethod eieio-object-name-string ((obj eieio-named))
173 "Return a string which is OBJ's name."
174 (or (slot-value obj 'object-name)
175 (cl-call-next-method)))
176
177(cl-defgeneric eieio-object-set-name-string (obj name)
178 "Set the string which is OBJ's NAME."
179 (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ \\='object-name) NAME) instead" "25.1"))
180 (cl-check-type name string)
181 (setf (gethash obj eieio--object-names) name))
182(define-obsolete-function-alias
183 'object-set-name-string 'eieio-object-set-name-string "24.4")
184
185(with-suppressed-warnings ((obsolete eieio-object-set-name-string))
186 (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
187 "Set the string which is OBJ's NAME."
188 (cl-check-type name string)
189 (eieio-oset obj 'object-name name)))
190
191(cl-defmethod clone ((obj eieio-named) &rest params)
192 "Clone OBJ, initializing `:parent' to OBJ.
193All slots are unbound, except those initialized with PARAMS."
194 (let* ((newname (and (stringp (car params)) (pop params)))
195 (nobj (apply #'cl-call-next-method obj params))
196 (nm (slot-value nobj 'object-name)))
197 (eieio-oset nobj 'object-name
198 (or newname
199 (if (equal nm (slot-value obj 'object-name))
200 (save-match-data
201 (if (and nm (string-match "-\\([0-9]+\\)" nm))
202 (let ((num (1+ (string-to-number
203 (match-string 1 nm)))))
204 (concat (substring nm 0 (match-beginning 0))
205 "-" (int-to-string num)))
206 (concat nm "-1")))
207 nm)))
208 nobj))
209
210(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
211 (if (not (stringp (car args)))
212 (cl-call-next-method)
213 (funcall (if eieio-backward-compatibility #'ignore #'message)
214 "Obsolete: name passed without :object-name to %S constructor"
215 class)
216 (apply #'cl-call-next-method class :object-name args)))
217
165;;; eieio-persistent 218;;; eieio-persistent
166;; 219;;
167;; For objects which must save themselves to disk. Provides an 220;; For objects which must save themselves to disk. Provides an
@@ -264,12 +317,17 @@ objects found there."
264 (:method 317 (:method
265 ((objclass (subclass eieio-default-superclass)) inputlist) 318 ((objclass (subclass eieio-default-superclass)) inputlist)
266 319
267 (let ((slots (if (stringp (car inputlist)) 320 (let* ((name nil)
268 ;; Earlier versions of `object-write' added a 321 (slots (if (stringp (car inputlist))
269 ;; string name for the object, now obsolete. 322 (progn
270 (cdr inputlist) 323 ;; Earlier versions of `object-write' added a
271 inputlist)) 324 ;; string name for the object, now obsolete.
272 (createslots nil)) 325 ;; Save as 'name' in case this object is subclass
326 ;; of eieio-named with no :object-name slot specified.
327 (setq name (car inputlist))
328 (cdr inputlist))
329 inputlist))
330 (createslots nil))
273 ;; If OBJCLASS is an eieio autoload object, then we need to 331 ;; If OBJCLASS is an eieio autoload object, then we need to
274 ;; load it (we don't need the return value). 332 ;; load it (we don't need the return value).
275 (eieio--full-class-object objclass) 333 (eieio--full-class-object objclass)
@@ -286,7 +344,17 @@ objects found there."
286 344
287 (setq slots (cdr (cdr slots)))) 345 (setq slots (cdr (cdr slots))))
288 346
289 (apply #'make-instance objclass (nreverse createslots))))) 347 (let ((newobj (apply #'make-instance objclass (nreverse createslots))))
348
349 ;; Check for special case of subclass of `eieio-named', and do
350 ;; name assignment.
351 (when (and eieio-backward-compatibility
352 (object-of-class-p newobj 'eieio-named)
353 (not (oref newobj object-name))
354 name)
355 (oset newobj object-name name))
356
357 newobj))))
290 358
291(defun eieio-persistent-fix-value (proposed-value) 359(defun eieio-persistent-fix-value (proposed-value)
292 "Fix PROPOSED-VALUE. 360 "Fix PROPOSED-VALUE.
@@ -408,59 +476,6 @@ instance."
408;; It should also set up some hooks to help it keep itself up to date. 476;; It should also set up some hooks to help it keep itself up to date.
409 477
410 478
411;;; Named object
412
413(defclass eieio-named ()
414 ((object-name :initarg :object-name :initform nil))
415 "Object with a name."
416 :abstract t)
417
418(cl-defmethod eieio-object-name-string ((obj eieio-named))
419 "Return a string which is OBJ's name."
420 (or (slot-value obj 'object-name)
421 (cl-call-next-method)))
422
423(cl-defgeneric eieio-object-set-name-string (obj name)
424 "Set the string which is OBJ's NAME."
425 (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ \\='object-name) NAME) instead" "25.1"))
426 (cl-check-type name string)
427 (setf (gethash obj eieio--object-names) name))
428(define-obsolete-function-alias
429 'object-set-name-string 'eieio-object-set-name-string "24.4")
430
431(with-suppressed-warnings ((obsolete eieio-object-set-name-string))
432 (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
433 "Set the string which is OBJ's NAME."
434 (cl-check-type name string)
435 (eieio-oset obj 'object-name name)))
436
437(cl-defmethod clone ((obj eieio-named) &rest params)
438 "Clone OBJ, initializing `:parent' to OBJ.
439All slots are unbound, except those initialized with PARAMS."
440 (let* ((newname (and (stringp (car params)) (pop params)))
441 (nobj (apply #'cl-call-next-method obj params))
442 (nm (slot-value nobj 'object-name)))
443 (eieio-oset nobj 'object-name
444 (or newname
445 (if (equal nm (slot-value obj 'object-name))
446 (save-match-data
447 (if (and nm (string-match "-\\([0-9]+\\)" nm))
448 (let ((num (1+ (string-to-number
449 (match-string 1 nm)))))
450 (concat (substring nm 0 (match-beginning 0))
451 "-" (int-to-string num)))
452 (concat nm "-1")))
453 nm)))
454 nobj))
455
456(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
457 (if (not (stringp (car args)))
458 (cl-call-next-method)
459 (funcall (if eieio-backward-compatibility #'ignore #'message)
460 "Obsolete: name passed without :object-name to %S constructor"
461 class)
462 (apply #'cl-call-next-method class :object-name args)))
463
464 479
465(provide 'eieio-base) 480(provide 'eieio-base)
466 481
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 1ae216c1a27..8780c5dcd30 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."
456 ("\\(\\\\\\)\\([^\"\\]\\)" 456 ("\\(\\\\\\)\\([^\"\\]\\)"
457 (1 (elisp--font-lock-backslash) prepend)) 457 (1 (elisp--font-lock-backslash) prepend))
458 ;; Words inside ‘’ and `' tend to be symbol names. 458 ;; Words inside ‘’ and `' tend to be symbol names.
459 (,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)" 459 (,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]")
460 lisp-mode-symbol-regexp "\\)['’]")
461 (1 font-lock-constant-face prepend)) 460 (1 font-lock-constant-face prepend))
462 ;; Constant values. 461 ;; Constant values.
463 (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>") 462 (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
@@ -507,8 +506,7 @@ This will generate compile-time constants from BINDINGS."
507 (,(concat "(" cl-errs-re "\\_>") 506 (,(concat "(" cl-errs-re "\\_>")
508 (1 font-lock-warning-face)) 507 (1 font-lock-warning-face))
509 ;; Words inside ‘’ and `' tend to be symbol names. 508 ;; Words inside ‘’ and `' tend to be symbol names.
510 (,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)" 509 (,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]")
511 lisp-mode-symbol-regexp "\\)['’]")
512 (1 font-lock-constant-face prepend)) 510 (1 font-lock-constant-face prepend))
513 ;; Uninterned symbols, e.g., (defpackage #:my-package ...) 511 ;; Uninterned symbols, e.g., (defpackage #:my-package ...)
514 ;; must come before keywords below to have effect 512 ;; must come before keywords below to have effect
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 82a8cd2d777..37844977f8f 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -480,6 +480,35 @@ itself or not."
480 v 480 v
481 (list 'quote v))) 481 (list 'quote v)))
482 482
483(defun macroexp--fgrep (bindings sexp)
484 "Return those of the BINDINGS which might be used in SEXP.
485It is used as a poor-man's \"free variables\" test. It differs from a true
486test of free variables in the following ways:
487- It does not distinguish variables from functions, so it can be used
488 both to detect whether a given variable is used by SEXP and to
489 detect whether a given function is used by SEXP.
490- It does not actually know ELisp syntax, so it only looks for the presence
491 of symbols in SEXP and can't distinguish if those symbols are truly
492 references to the given variable (or function). That can make the result
493 include bindings which actually aren't used.
494- For the same reason it may cause the result to fail to include bindings
495 which will be used if SEXP is not yet fully macro-expanded and the
496 use of the binding will only be revealed by macro expansion."
497 (let ((res '()))
498 (while (and (consp sexp) bindings)
499 (dolist (binding (macroexp--fgrep bindings (pop sexp)))
500 (push binding res)
501 (setq bindings (remove binding bindings))))
502 (if (or (vectorp sexp) (byte-code-function-p sexp))
503 ;; With backquote, code can appear within vectors as well.
504 ;; This wouldn't be needed if we `macroexpand-all' before
505 ;; calling macroexp--fgrep, OTOH.
506 (macroexp--fgrep bindings (mapcar #'identity sexp))
507 (let ((tmp (assq sexp bindings)))
508 (if tmp
509 (cons tmp res)
510 res)))))
511
483;;; Load-time macro-expansion. 512;;; Load-time macro-expansion.
484 513
485;; Because macro-expansion used to be more lazy, eager macro-expansion 514;; 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 8fb79d220de..72ea1ba0188 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'.
344 (seen '()) 344 (seen '())
345 (codegen 345 (codegen
346 (lambda (code vars) 346 (lambda (code vars)
347 (let ((vars (pcase--fgrep vars code)) 347 (let ((vars (macroexp--fgrep vars code))
348 (prev (assq code seen))) 348 (prev (assq code seen)))
349 (if (not prev) 349 (if (not prev)
350 (let ((res (pcase-codegen code vars))) 350 (let ((res (pcase-codegen code vars)))
@@ -401,7 +401,7 @@ of the elements of LIST is performed as if by `pcase-let'.
401 ;; occurrences of this leaf since it's small. 401 ;; occurrences of this leaf since it's small.
402 (lambda (code vars) 402 (lambda (code vars)
403 (pcase-codegen code 403 (pcase-codegen code
404 (pcase--fgrep vars code))) 404 (macroexp--fgrep vars code)))
405 codegen) 405 codegen)
406 (cdr case) 406 (cdr case)
407 vars)))) 407 vars))))
@@ -668,7 +668,7 @@ MATCH is the pattern that needs to be matched, of the form:
668 ;; run, but we don't have the environment in which `pat' will 668 ;; run, but we don't have the environment in which `pat' will
669 ;; run, so we can't do a reliable verification. But let's try 669 ;; run, so we can't do a reliable verification. But let's try
670 ;; and catch at least the easy cases such as (bug#14773). 670 ;; and catch at least the easy cases such as (bug#14773).
671 (not (pcase--fgrep (mapcar #'car vars) (cadr upat))))) 671 (not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
672 '(:pcase--succeed . :pcase--fail)) 672 '(:pcase--succeed . :pcase--fail))
673 ((and (eq 'pred (car upat)) 673 ((and (eq 'pred (car upat))
674 (let ((otherpred 674 (let ((otherpred
@@ -692,23 +692,6 @@ MATCH is the pattern that needs to be matched, of the form:
692 '(nil . :pcase--fail) 692 '(nil . :pcase--fail)
693 '(:pcase--fail . nil)))))) 693 '(:pcase--fail . nil))))))
694 694
695(defun pcase--fgrep (bindings sexp)
696 "Return those of the BINDINGS which might be used in SEXP."
697 (let ((res '()))
698 (while (and (consp sexp) bindings)
699 (dolist (binding (pcase--fgrep bindings (pop sexp)))
700 (push binding res)
701 (setq bindings (remove binding bindings))))
702 (if (vectorp sexp)
703 ;; With backquote, code can appear within vectors as well.
704 ;; This wouldn't be needed if we `macroexpand-all' before
705 ;; calling pcase--fgrep, OTOH.
706 (pcase--fgrep bindings (mapcar #'identity sexp))
707 (let ((tmp (assq sexp bindings)))
708 (if tmp
709 (cons tmp res)
710 res)))))
711
712(defun pcase--self-quoting-p (upat) 695(defun pcase--self-quoting-p (upat)
713 (or (keywordp upat) (integerp upat) (stringp upat))) 696 (or (keywordp upat) (integerp upat) (stringp upat)))
714 697
@@ -749,7 +732,7 @@ MATCH is the pattern that needs to be matched, of the form:
749 `(,fun ,arg) 732 `(,fun ,arg)
750 (let* (;; `env' is an upper bound on the bindings we need. 733 (let* (;; `env' is an upper bound on the bindings we need.
751 (env (mapcar (lambda (x) (list (car x) (cdr x))) 734 (env (mapcar (lambda (x) (list (car x) (cdr x)))
752 (pcase--fgrep vars fun))) 735 (macroexp--fgrep vars fun)))
753 (call (progn 736 (call (progn
754 (when (assq arg env) 737 (when (assq arg env)
755 ;; `arg' is shadowed by `env'. 738 ;; `arg' is shadowed by `env'.
@@ -770,7 +753,7 @@ MATCH is the pattern that needs to be matched, of the form:
770 "Build an expression that will evaluate EXP." 753 "Build an expression that will evaluate EXP."
771 (let* ((found (assq exp vars))) 754 (let* ((found (assq exp vars)))
772 (if found (cdr found) 755 (if found (cdr found)
773 (let* ((env (pcase--fgrep vars exp))) 756 (let* ((env (macroexp--fgrep vars exp)))
774 (if env 757 (if env
775 (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x))) 758 (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
776 env) 759 env)
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 698467e939e..39e69f5aab9 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."
1126 (insert (propertize "(" 1126 (insert (propertize "("
1127 'shortdoc-function t)) 1127 'shortdoc-function t))
1128 (if (plist-get data :no-manual) 1128 (if (plist-get data :no-manual)
1129 (insert (symbol-name function)) 1129 (insert-text-button
1130 (symbol-name function)
1131 'face 'button
1132 'action (lambda (_)
1133 (describe-function function))
1134 'follow-link t
1135 'help-echo (purecopy "mouse-1, RET: describe function"))
1130 (insert-text-button 1136 (insert-text-button
1131 (symbol-name function) 1137 (symbol-name function)
1132 'face 'button 1138 'face 'button
1133 'action (lambda (_) 1139 'action (lambda (_)
1134 (info-lookup-symbol function 'emacs-lisp-mode)))) 1140 (info-lookup-symbol function 'emacs-lisp-mode))
1141 'follow-link t
1142 'help-echo (purecopy "mouse-1, RET: show \
1143function's documentation in the Info manual")))
1135 (setq arglist-start (point)) 1144 (setq arglist-start (point))
1136 (insert ")\n") 1145 (insert ")\n")
1137 ;; Doc string. 1146 ;; Doc string.
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 4f9b0b199f9..9ef8b7f46ab 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."
168 :group 'erc-services 168 :group 'erc-services
169 :type 'boolean) 169 :type 'boolean)
170 170
171(defcustom erc-use-auth-source-for-nickserv-password nil
172 "Query auth-source for a password when identifiying to NickServ.
173This option has an no effect if `erc-prompt-for-nickserv-password'
174is non-nil, and passwords from `erc-nickserv-passwords' take
175precedence."
176 :version "28.1"
177 :group 'erc-services
178 :type 'boolean)
179
171(defcustom erc-nickserv-passwords nil 180(defcustom erc-nickserv-passwords nil
172 "Passwords used when identifying to NickServ automatically. 181 "Passwords used when identifying to NickServ automatically.
182`erc-prompt-for-nickserv-password' must be nil for these
183passwords to be used.
173 184
174Example of use: 185Example of use:
175 (setq erc-nickserv-passwords 186 (setq erc-nickserv-passwords
@@ -375,7 +386,8 @@ Make sure it is the real NickServ for this network.
375If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the 386If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the
376password for this nickname, otherwise try to send it automatically." 387password for this nickname, otherwise try to send it automatically."
377 (unless (and (null erc-nickserv-passwords) 388 (unless (and (null erc-nickserv-passwords)
378 (null erc-prompt-for-nickserv-password)) 389 (null erc-prompt-for-nickserv-password)
390 (null erc-use-auth-source-for-nickserv-password))
379 (let* ((network (erc-network)) 391 (let* ((network (erc-network))
380 (sender (erc-nickserv-alist-sender network)) 392 (sender (erc-nickserv-alist-sender network))
381 (identify-regex (erc-nickserv-alist-regexp network)) 393 (identify-regex (erc-nickserv-alist-regexp network))
@@ -394,30 +406,49 @@ password for this nickname, otherwise try to send it automatically."
394(defun erc-nickserv-identify-on-connect (_server nick) 406(defun erc-nickserv-identify-on-connect (_server nick)
395 "Identify to Nickserv after the connection to the server is established." 407 "Identify to Nickserv after the connection to the server is established."
396 (unless (or (and (null erc-nickserv-passwords) 408 (unless (or (and (null erc-nickserv-passwords)
397 (null erc-prompt-for-nickserv-password)) 409 (null erc-prompt-for-nickserv-password)
398 (and (eq erc-nickserv-identify-mode 'both) 410 (null erc-use-auth-source-for-nickserv-password))
399 (erc-nickserv-alist-regexp (erc-network)))) 411 (and (eq erc-nickserv-identify-mode 'both)
412 (erc-nickserv-alist-regexp (erc-network))))
400 (erc-nickserv-call-identify-function nick))) 413 (erc-nickserv-call-identify-function nick)))
401 414
402(defun erc-nickserv-identify-on-nick-change (nick _old-nick) 415(defun erc-nickserv-identify-on-nick-change (nick _old-nick)
403 "Identify to Nickserv whenever your nick changes." 416 "Identify to Nickserv whenever your nick changes."
404 (unless (or (and (null erc-nickserv-passwords) 417 (unless (or (and (null erc-nickserv-passwords)
405 (null erc-prompt-for-nickserv-password)) 418 (null erc-prompt-for-nickserv-password)
406 (and (eq erc-nickserv-identify-mode 'both) 419 (null erc-use-auth-source-for-nickserv-password))
407 (erc-nickserv-alist-regexp (erc-network)))) 420 (and (eq erc-nickserv-identify-mode 'both)
421 (erc-nickserv-alist-regexp (erc-network))))
408 (erc-nickserv-call-identify-function nick))) 422 (erc-nickserv-call-identify-function nick)))
409 423
424(defun erc-nickserv-get-password (nickname)
425 "Return the password for NICKNAME from configured sources.
426
427It uses `erc-nickserv-passwords' and additionally auth-source
428when `erc-use-auth-source-for-nickserv-password' is not nil."
429 (or
430 (when erc-nickserv-passwords
431 (cdr (assoc nickname
432 (nth 1 (assoc (erc-network)
433 erc-nickserv-passwords)))))
434 (when erc-use-auth-source-for-nickserv-password
435 (let* ((secret (nth 0 (auth-source-search
436 :max 1 :require '(:secret)
437 :host (erc-with-server-buffer erc-session-server)
438 :port (format ; ensure we have a string
439 "%s" (erc-with-server-buffer erc-session-port))
440 :user nickname))))
441 (when secret
442 (let ((passwd (plist-get secret :secret)))
443 (if (functionp passwd) (funcall passwd) passwd)))))))
444
410(defun erc-nickserv-call-identify-function (nickname) 445(defun erc-nickserv-call-identify-function (nickname)
411 "Call `erc-nickserv-identify'. 446 "Call `erc-nickserv-identify'.
412Either call it interactively or run it with NICKNAME's password, 447Either call it interactively or run it with NICKNAME's password,
413depending on the value of `erc-prompt-for-nickserv-password'." 448depending on the value of `erc-prompt-for-nickserv-password'."
414 (if erc-prompt-for-nickserv-password 449 (if erc-prompt-for-nickserv-password
415 (call-interactively 'erc-nickserv-identify) 450 (call-interactively 'erc-nickserv-identify)
416 (when erc-nickserv-passwords 451 (erc-nickserv-identify (erc-nickserv-get-password nickname))))
417 (erc-nickserv-identify
418 (cdr (assoc nickname
419 (nth 1 (assoc (erc-network)
420 erc-nickserv-passwords))))))))
421 452
422(defvar erc-auto-discard-away) 453(defvar erc-auto-discard-away)
423 454
@@ -451,6 +482,7 @@ When called interactively, read the password using `read-passwd'."
451 482
452(provide 'erc-services) 483(provide 'erc-services)
453 484
485
454;;; erc-services.el ends here 486;;; erc-services.el ends here
455;; 487;;
456;; Local Variables: 488;; Local Variables:
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 771b81e5be5..4c479d68e9a 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -487,7 +487,7 @@ What happens depends on the number of mouse clicks:-
487Signal an error if the final event isn't the same type as the first one." 487Signal an error if the final event isn't the same type as the first one."
488 (let ((initial-event-type (event-basic-type event))) 488 (let ((initial-event-type (event-basic-type event)))
489 (while (null (sit-for (/ double-click-time 1000.0) 'nodisplay)) 489 (while (null (sit-for (/ double-click-time 1000.0) 'nodisplay))
490 (setq event (read-event))) 490 (setq event (read--potential-mouse-event)))
491 (or (eq initial-event-type (event-basic-type event)) 491 (or (eq initial-event-type (event-basic-type event))
492 (error ""))) 492 (error "")))
493 event) 493 event)
diff --git a/lisp/frame.el b/lisp/frame.el
index c71276287aa..e2d7f21a498 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -2557,7 +2557,7 @@ command starts, by installing a pre-command hook."
2557 ;; blink-cursor-end is not added to pre-command-hook. 2557 ;; blink-cursor-end is not added to pre-command-hook.
2558 (setq blink-cursor-blinks-done 1) 2558 (setq blink-cursor-blinks-done 1)
2559 (blink-cursor--start-timer) 2559 (blink-cursor--start-timer)
2560 (add-hook 'pre-command-hook 'blink-cursor-end) 2560 (add-hook 'pre-command-hook #'blink-cursor-end)
2561 (internal-show-cursor nil nil))) 2561 (internal-show-cursor nil nil)))
2562 2562
2563(defun blink-cursor-timer-function () 2563(defun blink-cursor-timer-function ()
@@ -2572,14 +2572,14 @@ command starts, by installing a pre-command hook."
2572 (when (and (> blink-cursor-blinks 0) 2572 (when (and (> blink-cursor-blinks 0)
2573 (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done)) 2573 (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
2574 (blink-cursor-suspend) 2574 (blink-cursor-suspend)
2575 (add-hook 'post-command-hook 'blink-cursor-check))) 2575 (add-hook 'post-command-hook #'blink-cursor-check)))
2576 2576
2577(defun blink-cursor-end () 2577(defun blink-cursor-end ()
2578 "Stop cursor blinking. 2578 "Stop cursor blinking.
2579This is installed as a pre-command hook by `blink-cursor-start'. 2579This is installed as a pre-command hook by `blink-cursor-start'.
2580When run, it cancels the timer `blink-cursor-timer' and removes 2580When run, it cancels the timer `blink-cursor-timer' and removes
2581itself as a pre-command hook." 2581itself as a pre-command hook."
2582 (remove-hook 'pre-command-hook 'blink-cursor-end) 2582 (remove-hook 'pre-command-hook #'blink-cursor-end)
2583 (internal-show-cursor nil t) 2583 (internal-show-cursor nil t)
2584 (when blink-cursor-timer 2584 (when blink-cursor-timer
2585 (cancel-timer blink-cursor-timer) 2585 (cancel-timer blink-cursor-timer)
@@ -2648,7 +2648,7 @@ terminals, cursor blinking is controlled by the terminal."
2648 (when blink-cursor-mode 2648 (when blink-cursor-mode
2649 (add-function :after after-focus-change-function #'blink-cursor--rescan-frames) 2649 (add-function :after after-focus-change-function #'blink-cursor--rescan-frames)
2650 (add-hook 'after-delete-frame-functions #'blink-cursor--rescan-frames) 2650 (add-hook 'after-delete-frame-functions #'blink-cursor--rescan-frames)
2651 (blink-cursor--start-idle-timer))) 2651 (blink-cursor-check)))
2652 2652
2653 2653
2654;; Frame maximization/fullscreen 2654;; Frame maximization/fullscreen
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 44f43b073c8..5c6a5b9efd0 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.")
1036 '(body cc bcc from header keyword larger smaller subject text to uid x-gm-raw 1036 '(body cc bcc from header keyword larger smaller subject text to uid x-gm-raw
1037 answered before deleted draft flagged on since recent seen sentbefore 1037 answered before deleted draft flagged on since recent seen sentbefore
1038 senton sentsince unanswered undeleted undraft unflagged unkeyword 1038 senton sentsince unanswered undeleted undraft unflagged unkeyword
1039 unseen all) 1039 unseen all old new or not)
1040 "Known IMAP search keys.") 1040 "Known IMAP search keys.")
1041 1041
1042;; imap interface 1042;; imap interface
@@ -1072,10 +1072,11 @@ Responsible for handling and, or, and parenthetical expressions.")
1072 ;; A bit of backward-compatibility slash convenience: if the 1072 ;; A bit of backward-compatibility slash convenience: if the
1073 ;; query string doesn't start with any known IMAP search 1073 ;; query string doesn't start with any known IMAP search
1074 ;; keyword, assume it is a "TEXT" search. 1074 ;; keyword, assume it is a "TEXT" search.
1075 (unless (and (string-match "\\`[^[:blank:]]+" q-string) 1075 (unless (or (looking-at "(")
1076 (memql (intern-soft (downcase 1076 (and (string-match "\\`[^[:blank:]]+" q-string)
1077 (match-string 0 q-string))) 1077 (memql (intern-soft (downcase
1078 gnus-search-imap-search-keys)) 1078 (match-string 0 q-string)))
1079 gnus-search-imap-search-keys)))
1079 (setq q-string (concat "TEXT " q-string))) 1080 (setq q-string (concat "TEXT " q-string)))
1080 1081
1081 ;; If it's a thread query, make sure that all message-id 1082 ;; 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 18924a3ad0e..3fb8e469d04 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -145,7 +145,6 @@ used to display Gnus windows."
145 (,shell-command-buffer-name 1.0))) 145 (,shell-command-buffer-name 1.0)))
146 (bug 146 (bug
147 (vertical 1.0 147 (vertical 1.0
148 (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))
149 ("*Gnus Bug*" 1.0 point))) 148 ("*Gnus Bug*" 1.0 point)))
150 (score-trace 149 (score-trace
151 (vertical 1.0 150 (vertical 1.0
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 3ff3d29b45d..50e02187484 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -620,8 +620,8 @@ Done before generating the new subject of a forward."
620 620
621(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" 621(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
622 "All headers that match this regexp will be deleted when forwarding a message. 622 "All headers that match this regexp will be deleted when forwarding a message.
623This variable is only consulted when forwarding \"normally\", not 623This variable is not consulted when forwarding encrypted messages
624when forwarding as MIME or the like. 624and `message-forward-show-mml' is `best'.
625 625
626This may also be a list of regexps." 626This may also be a list of regexps."
627 :version "21.1" 627 :version "21.1"
@@ -7638,7 +7638,8 @@ Optional DIGEST will use digest to forward."
7638 message-forward-included-headers) 7638 message-forward-included-headers)
7639 t nil t))))) 7639 t nil t)))))
7640 7640
7641(defun message-forward-make-body-mime (forward-buffer &optional beg end) 7641(defun message-forward-make-body-mime (forward-buffer &optional beg end
7642 remove-headers)
7642 (let ((b (point))) 7643 (let ((b (point)))
7643 (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n") 7644 (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
7644 (save-restriction 7645 (save-restriction
@@ -7648,6 +7649,8 @@ Optional DIGEST will use digest to forward."
7648 (goto-char (point-min)) 7649 (goto-char (point-min))
7649 (when (looking-at "From ") 7650 (when (looking-at "From ")
7650 (replace-match "X-From-Line: ")) 7651 (replace-match "X-From-Line: "))
7652 (when remove-headers
7653 (message-remove-ignored-headers (point-min) (point-max)))
7651 (goto-char (point-max))) 7654 (goto-char (point-max)))
7652 (insert "<#/part>\n") 7655 (insert "<#/part>\n")
7653 ;; Consider there is no illegible text. 7656 ;; Consider there is no illegible text.
@@ -7786,7 +7789,8 @@ is for the internal use."
7786 (message-signed-or-encrypted-p) 7789 (message-signed-or-encrypted-p)
7787 (error t)))))) 7790 (error t))))))
7788 (message-forward-make-body-mml forward-buffer) 7791 (message-forward-make-body-mml forward-buffer)
7789 (message-forward-make-body-mime forward-buffer)) 7792 (message-forward-make-body-mime
7793 forward-buffer nil nil (not (eq message-forward-show-mml 'best))))
7790 (message-forward-make-body-plain forward-buffer))) 7794 (message-forward-make-body-plain forward-buffer)))
7791 (message-position-point)) 7795 (message-position-point))
7792 7796
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 2b0b61bfac6..61946aa5811 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1264,20 +1264,11 @@ in HANDLE."
1264 (when (and (mm-handle-buffer handle) 1264 (when (and (mm-handle-buffer handle)
1265 (buffer-name (mm-handle-buffer handle))) 1265 (buffer-name (mm-handle-buffer handle)))
1266 (with-temp-buffer 1266 (with-temp-buffer
1267 (if (and (eq (mm-handle-encoding handle) '8bit) 1267 (mm-disable-multibyte)
1268 (with-current-buffer (mm-handle-buffer handle) 1268 (insert-buffer-substring (mm-handle-buffer handle))
1269 enable-multibyte-characters)) 1269 (mm-decode-content-transfer-encoding
1270 ;; Due to unfortunate historical reasons, we may have a 1270 (mm-handle-encoding handle)
1271 ;; multibyte buffer here, but if it's using an 8bit 1271 (mm-handle-media-type handle))
1272 ;; Content-Transfer-Encoding, then work around that by
1273 ;; just ignoring the situation.
1274 (insert-buffer-substring (mm-handle-buffer handle))
1275 ;; Do the decoding.
1276 (mm-disable-multibyte)
1277 (insert-buffer-substring (mm-handle-buffer handle))
1278 (mm-decode-content-transfer-encoding
1279 (mm-handle-encoding handle)
1280 (mm-handle-media-type handle)))
1281 ,@forms)))) 1272 ,@forms))))
1282(put 'mm-with-part 'lisp-indent-function 1) 1273(put 'mm-with-part 'lisp-indent-function 1)
1283(put 'mm-with-part 'edebug-form-spec '(body)) 1274(put 'mm-with-part 'edebug-form-spec '(body))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index e4fd976742c..2a4c74db5e8 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1351,7 +1351,8 @@ This variable is set by `nnmaildir-request-article'.")
1351 (throw 'return nil)) 1351 (throw 'return nil))
1352 (with-current-buffer (or to-buffer nntp-server-buffer) 1352 (with-current-buffer (or to-buffer nntp-server-buffer)
1353 (erase-buffer) 1353 (erase-buffer)
1354 (nnheader-insert-file-contents nnmaildir-article-file-name)) 1354 (let ((coding-system-for-read mm-text-coding-system))
1355 (mm-insert-file-contents nnmaildir-article-file-name)))
1355 (cons gname num-msgid)))) 1356 (cons gname num-msgid))))
1356 1357
1357(defun nnmaildir-request-post (&optional _server) 1358(defun nnmaildir-request-post (&optional _server)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index b6feeebf038..8ce936ad164 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -713,7 +713,9 @@ FILE is the file where FUNCTION was probably defined."
713 (insert-text-button 713 (insert-text-button
714 (symbol-name group) 714 (symbol-name group)
715 'action (lambda (_) 715 'action (lambda (_)
716 (shortdoc-display-group group)))) 716 (shortdoc-display-group group))
717 'follow-link t
718 'help-echo (purecopy "mouse-1, RET: show documentation group")))
717 groups) 719 groups)
718 (insert (if (= (length groups) 1) 720 (insert (if (= (length groups) 1)
719 " group.\n" 721 " group.\n"
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index cd08b2b2ba4..7043f12c9a3 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -357,8 +357,7 @@ Commands:
357 "\\(symbol\\|program\\|property\\)\\|" ; Don't link 357 "\\(symbol\\|program\\|property\\)\\|" ; Don't link
358 "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)" 358 "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
359 "[ \t\n]+\\)?" 359 "[ \t\n]+\\)?"
360 ;; Note starting with word-syntax character: 360 "['`‘]\\(\\(?:\\sw\\|\\s_\\)+\\|`\\)['’]"))
361 "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\|`\\)['’]"))
362 "Regexp matching doc string references to symbols. 361 "Regexp matching doc string references to symbols.
363 362
364The words preceding the quoted symbol can be used in doc strings to 363The words preceding the quoted symbol can be used in doc strings to
diff --git a/lisp/info.el b/lisp/info.el
index 62d7b583ff2..dec93928b38 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1973,7 +1973,6 @@ If DIRECTION is `backward', search in the reverse direction."
1973 "Regexp search%s" (car Info-search-history) 1973 "Regexp search%s" (car Info-search-history)
1974 (if case-fold-search "" " case-sensitively")) 1974 (if case-fold-search "" " case-sensitively"))
1975 nil 'Info-search-history))) 1975 nil 'Info-search-history)))
1976 (deactivate-mark)
1977 (when (equal regexp "") 1976 (when (equal regexp "")
1978 (setq regexp (car Info-search-history))) 1977 (setq regexp (car Info-search-history)))
1979 (when regexp 1978 (when regexp
@@ -2066,6 +2065,7 @@ If DIRECTION is `backward', search in the reverse direction."
2066 (< found opoint-max)) 2065 (< found opoint-max))
2067 ;; Search landed in the same node 2066 ;; Search landed in the same node
2068 (goto-char found) 2067 (goto-char found)
2068 (deactivate-mark)
2069 (widen) 2069 (widen)
2070 (goto-char found) 2070 (goto-char found)
2071 (save-match-data (Info-select-node))) 2071 (save-match-data (Info-select-node)))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 67cc7bed15b..c6f7fe7bd4a 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -838,10 +838,6 @@ This is like `describe-bindings', but displays only Isearch keys."
838 :image '(isearch-tool-bar-image "left-arrow"))) 838 :image '(isearch-tool-bar-image "left-arrow")))
839 map)) 839 map))
840 840
841;; Note: Before adding more key bindings to this map, please keep in
842;; mind that any unbound key exits Isearch and runs the command bound
843;; to it in the local or global map. So in effect every key unbound
844;; in this map is implicitly bound.
845(defvar minibuffer-local-isearch-map 841(defvar minibuffer-local-isearch-map
846 (let ((map (make-sparse-keymap))) 842 (let ((map (make-sparse-keymap)))
847 (set-keymap-parent map minibuffer-local-map) 843 (set-keymap-parent map minibuffer-local-map)
@@ -2498,6 +2494,21 @@ If search string is empty, just beep."
2498 (unless isearch-mode (isearch-mode t)) 2494 (unless isearch-mode (isearch-mode t))
2499 (isearch-yank-string (current-kill 0))) 2495 (isearch-yank-string (current-kill 0)))
2500 2496
2497(defun isearch-yank-from-kill-ring ()
2498 "Read a string from the `kill-ring' and append it to the search string."
2499 (interactive)
2500 (with-isearch-suspended
2501 (let ((string (read-from-kill-ring)))
2502 (if (and isearch-case-fold-search
2503 (eq 'not-yanks search-upper-case))
2504 (setq string (downcase string)))
2505 (if isearch-regexp (setq string (regexp-quote string)))
2506 (setq isearch-yank-flag t)
2507 (setq isearch-new-string (concat isearch-string string)
2508 isearch-new-message (concat isearch-message
2509 (mapconcat 'isearch-text-char-description
2510 string ""))))))
2511
2501(defun isearch-yank-pop () 2512(defun isearch-yank-pop ()
2502 "Replace just-yanked search string with previously killed string. 2513 "Replace just-yanked search string with previously killed string.
2503Unlike `isearch-yank-pop-only', when this command is called not immediately 2514Unlike `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."
2506 (interactive) 2517 (interactive)
2507 (if (not (memq last-command '(isearch-yank-kill 2518 (if (not (memq last-command '(isearch-yank-kill
2508 isearch-yank-pop isearch-yank-pop-only))) 2519 isearch-yank-pop isearch-yank-pop-only)))
2509 ;; Yank string from kill-ring-browser. 2520 (isearch-yank-from-kill-ring)
2510 (with-isearch-suspended
2511 (let ((string (read-from-kill-ring)))
2512 (if (and isearch-case-fold-search
2513 (eq 'not-yanks search-upper-case))
2514 (setq string (downcase string)))
2515 (if isearch-regexp (setq string (regexp-quote string)))
2516 (setq isearch-yank-flag t)
2517 (setq isearch-new-string (concat isearch-string string)
2518 isearch-new-message (concat isearch-message
2519 (mapconcat 'isearch-text-char-description
2520 string "")))))
2521 (isearch-pop-state) 2521 (isearch-pop-state)
2522 (isearch-yank-string (current-kill 1)))) 2522 (isearch-yank-string (current-kill 1))))
2523 2523
2524(defun isearch-yank-pop-only () 2524(defun isearch-yank-pop-only (&optional arg)
2525 "Replace just-yanked search string with previously killed string. 2525 "Replace just-yanked search string with previously killed string.
2526Unlike `isearch-yank-pop', when this command is called not immediately 2526Unlike `isearch-yank-pop', when this command is called not immediately
2527after a `isearch-yank-kill' or a `isearch-yank-pop-only', it only pops 2527after a `isearch-yank-kill' or a `isearch-yank-pop-only', it only pops
2528the last killed string instead of activating the minibuffer to read 2528the last killed string instead of activating the minibuffer to read
2529a string from the `kill-ring' as `yank-pop' does." 2529a string from the `kill-ring' as `yank-pop' does. The prefix arg C-u
2530 (interactive) 2530always reads a string from the `kill-ring' using the minibuffer."
2531 (if (not (memq last-command '(isearch-yank-kill 2531 (interactive "P")
2532 isearch-yank-pop isearch-yank-pop-only))) 2532 (cond
2533 ;; Fall back on `isearch-yank-kill' for the benefits of people 2533 ((equal arg '(4))
2534 ;; who are used to the old behavior of `M-y' in isearch mode. 2534 (isearch-yank-from-kill-ring))
2535 ;; In future, `M-y' could be changed from `isearch-yank-pop-only' 2535 ((not (memq last-command '(isearch-yank-kill
2536 ;; to `isearch-yank-pop' that uses the kill-ring-browser. 2536 isearch-yank-pop isearch-yank-pop-only)))
2537 (isearch-yank-kill) 2537 ;; Fall back on `isearch-yank-kill' for the benefits of people
2538 ;; who are used to the old behavior of `M-y' in isearch mode.
2539 ;; In future, `M-y' could be changed from `isearch-yank-pop-only'
2540 ;; to `isearch-yank-pop' that uses the kill-ring-browser.
2541 (isearch-yank-kill))
2542 (t
2538 (isearch-pop-state) 2543 (isearch-pop-state)
2539 (isearch-yank-string (current-kill 1)))) 2544 (isearch-yank-string (current-kill 1)))))
2540 2545
2541(defun isearch-yank-x-selection () 2546(defun isearch-yank-x-selection ()
2542 "Pull current X selection into search string." 2547 "Pull current X selection into search string."
@@ -2997,7 +3002,7 @@ See more for options in `search-exit-option'."
2997 ((and (eq (car-safe main-event) 'down-mouse-1) 3002 ((and (eq (car-safe main-event) 'down-mouse-1)
2998 (window-minibuffer-p (posn-window (event-start main-event)))) 3003 (window-minibuffer-p (posn-window (event-start main-event))))
2999 ;; Swallow the up-event. 3004 ;; Swallow the up-event.
3000 (read-event) 3005 (read--potential-mouse-event)
3001 (setq this-command 'isearch-edit-string)) 3006 (setq this-command 'isearch-edit-string))
3002 ;; Don't terminate the search for motion commands. 3007 ;; Don't terminate the search for motion commands.
3003 ((and isearch-yank-on-move 3008 ((and isearch-yank-on-move
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 556f5d3a564..315f2d369af 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2125,8 +2125,10 @@ variables.")
2125 ;; A better solution would be to make deactivate-mark buffer-local 2125 ;; A better solution would be to make deactivate-mark buffer-local
2126 ;; (or to turn it into a list of buffers, ...), but in the mean time, 2126 ;; (or to turn it into a list of buffers, ...), but in the mean time,
2127 ;; this should do the trick in most cases. 2127 ;; this should do the trick in most cases.
2128 (setq deactivate-mark nil) 2128 (when (innermost-minibuffer-p)
2129 (throw 'exit nil)) 2129 (setq deactivate-mark nil)
2130 (throw 'exit nil))
2131 (error "%s" "Not in most nested minibuffer"))
2130 2132
2131(defun self-insert-and-exit () 2133(defun self-insert-and-exit ()
2132 "Terminate minibuffer input." 2134 "Terminate minibuffer input."
@@ -2394,7 +2396,7 @@ The completion method is determined by `completion-at-point-functions'."
2394;;; Key bindings. 2396;;; Key bindings.
2395 2397
2396(let ((map minibuffer-local-map)) 2398(let ((map minibuffer-local-map))
2397 (define-key map "\C-g" 'abort-recursive-edit) 2399 (define-key map "\C-g" 'abort-minibuffers)
2398 (define-key map "\M-<" 'minibuffer-beginning-of-buffer) 2400 (define-key map "\M-<" 'minibuffer-beginning-of-buffer)
2399 2401
2400 (define-key map "\r" 'exit-minibuffer) 2402 (define-key map "\r" 'exit-minibuffer)
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index f6612600bdd..907ef061594 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -225,7 +225,7 @@ To test this function, evaluate:
225 ;; Don't change the mouse pointer shape while we drag. 225 ;; Don't change the mouse pointer shape while we drag.
226 (setq track-mouse 'dragging) 226 (setq track-mouse 'dragging)
227 (while (progn 227 (while (progn
228 (setq event (read-event) 228 (setq event (read--potential-mouse-event)
229 end (event-end event) 229 end (event-end event)
230 row (cdr (posn-col-row end)) 230 row (cdr (posn-col-row end))
231 col (car (posn-col-row end))) 231 col (car (posn-col-row end)))
@@ -286,7 +286,7 @@ To test this function, evaluate:
286 window-last-col (- (window-width) 2)) 286 window-last-col (- (window-width) 2))
287 (track-mouse 287 (track-mouse
288 (while (progn 288 (while (progn
289 (setq event (read-event) 289 (setq event (read--potential-mouse-event)
290 end (event-end event) 290 end (event-end event)
291 row (cdr (posn-col-row end)) 291 row (cdr (posn-col-row end))
292 col (car (posn-col-row end))) 292 col (car (posn-col-row end)))
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 0da82882fc1..8732fb80866 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."
1792 (let (event end end-point) 1792 (let (event end end-point)
1793 (track-mouse 1793 (track-mouse
1794 (while (progn 1794 (while (progn
1795 (setq event (read-event)) 1795 (setq event (read--potential-mouse-event))
1796 (or (mouse-movement-p event) 1796 (or (mouse-movement-p event)
1797 (memq (car-safe event) '(switch-frame select-window)))) 1797 (memq (car-safe event) '(switch-frame select-window))))
1798 1798
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 3f3e7133713..0ce65a35ead 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -239,7 +239,7 @@ otherwise."
239 (mapc 239 (mapc
240 (lambda (info) 240 (lambda (info)
241 (let ((local-ip (nth 1 info)) 241 (let ((local-ip (nth 1 info))
242 (mask (nth 2 info))) 242 (mask (nth 3 info)))
243 (when 243 (when
244 (nsm-network-same-subnet (substring local-ip 0 -1) 244 (nsm-network-same-subnet (substring local-ip 0 -1)
245 (substring mask 0 -1) 245 (substring mask 0 -1)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c0c215de877..2c4ef2acaef 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -98,6 +98,7 @@ It is used for TCP/IP devices."
98 `(,tramp-adb-method 98 `(,tramp-adb-method
99 (tramp-login-program ,tramp-adb-program) 99 (tramp-login-program ,tramp-adb-program)
100 (tramp-login-args (("shell"))) 100 (tramp-login-args (("shell")))
101 (tramp-direct-async t)
101 (tramp-tmpdir "/data/local/tmp") 102 (tramp-tmpdir "/data/local/tmp")
102 (tramp-default-port 5555))) 103 (tramp-default-port 5555)))
103 104
@@ -895,8 +896,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
895;; terminated. 896;; terminated.
896(defun tramp-adb-handle-make-process (&rest args) 897(defun tramp-adb-handle-make-process (&rest args)
897 "Like `make-process' for Tramp files. 898 "Like `make-process' for Tramp files.
898If connection property \"direct-async-process\" is non-nil, an 899If method parameter `tramp-direct-async' and connection property
899alternative implementation will be used." 900\"direct-async-process\" are non-nil, an alternative
901implementation will be used."
900 (if (tramp-direct-async-process-p args) 902 (if (tramp-direct-async-process-p args)
901 (apply #'tramp-handle-make-process args) 903 (apply #'tramp-handle-make-process args)
902 (when args 904 (when args
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index b43b4485fec..e8ee372cb25 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -168,6 +168,7 @@ The string is used in `tramp-methods'.")
168 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") 168 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
169 ("-e" "none") ("%h"))) 169 ("-e" "none") ("%h")))
170 (tramp-async-args (("-q"))) 170 (tramp-async-args (("-q")))
171 (tramp-direct-async t)
171 (tramp-remote-shell ,tramp-default-remote-shell) 172 (tramp-remote-shell ,tramp-default-remote-shell)
172 (tramp-remote-shell-login ("-l")) 173 (tramp-remote-shell-login ("-l"))
173 (tramp-remote-shell-args ("-c")) 174 (tramp-remote-shell-args ("-c"))
@@ -183,6 +184,7 @@ The string is used in `tramp-methods'.")
183 ("-e" "none") ("-t" "-t") ("%h") 184 ("-e" "none") ("-t" "-t") ("%h")
184 ("%l"))) 185 ("%l")))
185 (tramp-async-args (("-q"))) 186 (tramp-async-args (("-q")))
187 (tramp-direct-async t)
186 (tramp-remote-shell ,tramp-default-remote-shell) 188 (tramp-remote-shell ,tramp-default-remote-shell)
187 (tramp-remote-shell-login ("-l")) 189 (tramp-remote-shell-login ("-l"))
188 (tramp-remote-shell-args ("-c")) 190 (tramp-remote-shell-args ("-c"))
@@ -197,6 +199,7 @@ The string is used in `tramp-methods'.")
197 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") 199 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
198 ("-e" "none") ("%h"))) 200 ("-e" "none") ("%h")))
199 (tramp-async-args (("-q"))) 201 (tramp-async-args (("-q")))
202 (tramp-direct-async t)
200 (tramp-remote-shell ,tramp-default-remote-shell) 203 (tramp-remote-shell ,tramp-default-remote-shell)
201 (tramp-remote-shell-login ("-l")) 204 (tramp-remote-shell-login ("-l"))
202 (tramp-remote-shell-args ("-c")) 205 (tramp-remote-shell-args ("-c"))
@@ -227,6 +230,7 @@ The string is used in `tramp-methods'.")
227 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") 230 (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
228 ("-e" "none") ("%h"))) 231 ("-e" "none") ("%h")))
229 (tramp-async-args (("-q"))) 232 (tramp-async-args (("-q")))
233 (tramp-direct-async t)
230 (tramp-remote-shell ,tramp-default-remote-shell) 234 (tramp-remote-shell ,tramp-default-remote-shell)
231 (tramp-remote-shell-login ("-l")) 235 (tramp-remote-shell-login ("-l"))
232 (tramp-remote-shell-args ("-c")))) 236 (tramp-remote-shell-args ("-c"))))
@@ -237,6 +241,7 @@ The string is used in `tramp-methods'.")
237 ("-e" "none") ("-t" "-t") ("%h") 241 ("-e" "none") ("-t" "-t") ("%h")
238 ("%l"))) 242 ("%l")))
239 (tramp-async-args (("-q"))) 243 (tramp-async-args (("-q")))
244 (tramp-direct-async t)
240 (tramp-remote-shell ,tramp-default-remote-shell) 245 (tramp-remote-shell ,tramp-default-remote-shell)
241 (tramp-remote-shell-login ("-l")) 246 (tramp-remote-shell-login ("-l"))
242 (tramp-remote-shell-args ("-c")))) 247 (tramp-remote-shell-args ("-c"))))
@@ -2601,7 +2606,7 @@ The method used must be an out-of-band method."
2601 (t nil))))))))) 2606 (t nil)))))))))
2602 2607
2603(defun tramp-sh-handle-insert-directory 2608(defun tramp-sh-handle-insert-directory
2604 (filename switches &optional wildcard full-directory-p) 2609 (filename switches &optional wildcard full-directory-p)
2605 "Like `insert-directory' for Tramp files." 2610 "Like `insert-directory' for Tramp files."
2606 (setq filename (expand-file-name filename)) 2611 (setq filename (expand-file-name filename))
2607 (unless switches (setq switches "")) 2612 (unless switches (setq switches ""))
@@ -2636,66 +2641,63 @@ The method used must be an out-of-band method."
2636 v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s" 2641 v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
2637 switches filename (if wildcard "yes" "no") 2642 switches filename (if wildcard "yes" "no")
2638 (if full-directory-p "yes" "no")) 2643 (if full-directory-p "yes" "no"))
2639 ;; If `full-directory-p', we just say `ls -l FILENAME'. 2644 ;; If `full-directory-p', we just say `ls -l FILENAME'. Else we
2640 ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. 2645 ;; chdir to the parent directory, then say `ls -ld BASENAME'.
2641 (if full-directory-p 2646 (if full-directory-p
2642 (tramp-send-command 2647 (tramp-send-command
2643 v 2648 v (format "%s %s %s 2>%s"
2644 (format "%s %s %s 2>%s" 2649 (tramp-get-ls-command v)
2645 (tramp-get-ls-command v) 2650 switches
2646 switches 2651 (if wildcard
2647 (if wildcard 2652 localname
2648 localname 2653 (tramp-shell-quote-argument (concat localname ".")))
2649 (tramp-shell-quote-argument (concat localname "."))) 2654 (tramp-get-remote-null-device v)))
2650 (tramp-get-remote-null-device v)))
2651 (tramp-barf-unless-okay 2655 (tramp-barf-unless-okay
2652 v 2656 v (format "cd %s" (tramp-shell-quote-argument
2653 (format "cd %s" (tramp-shell-quote-argument 2657 (tramp-run-real-handler
2654 (tramp-run-real-handler 2658 #'file-name-directory (list localname))))
2655 #'file-name-directory (list localname))))
2656 "Couldn't `cd %s'" 2659 "Couldn't `cd %s'"
2657 (tramp-shell-quote-argument 2660 (tramp-shell-quote-argument
2658 (tramp-run-real-handler #'file-name-directory (list localname)))) 2661 (tramp-run-real-handler #'file-name-directory (list localname))))
2659 (tramp-send-command 2662 (tramp-send-command
2660 v 2663 v (format "%s %s %s 2>%s"
2661 (format "%s %s %s 2>%s" 2664 (tramp-get-ls-command v)
2662 (tramp-get-ls-command v) 2665 switches
2663 switches 2666 (if (or wildcard
2664 (if (or wildcard 2667 (zerop (length
2665 (zerop (length 2668 (tramp-run-real-handler
2666 (tramp-run-real-handler 2669 #'file-name-nondirectory (list localname)))))
2667 #'file-name-nondirectory (list localname))))) 2670 ""
2668 "" 2671 (tramp-shell-quote-argument
2669 (tramp-shell-quote-argument 2672 (tramp-run-real-handler
2670 (tramp-run-real-handler 2673 #'file-name-nondirectory (list localname))))
2671 #'file-name-nondirectory (list localname)))) 2674 (tramp-get-remote-null-device v))))
2672 (tramp-get-remote-null-device v)))) 2675
2673 2676 (let ((beg-marker (copy-marker (point) nil))
2674 (save-restriction 2677 (end-marker (copy-marker (point) t))
2675 (let ((beg (point)) 2678 (emc enable-multibyte-characters))
2676 (emc enable-multibyte-characters)) 2679 ;; We cannot use `insert-buffer-substring' because the Tramp
2677 (narrow-to-region (point) (point)) 2680 ;; buffer changes its contents before insertion due to calling
2678 ;; We cannot use `insert-buffer-substring' because the Tramp 2681 ;; `expand-file-name' and alike.
2679 ;; buffer changes its contents before insertion due to calling 2682 (insert (with-current-buffer (tramp-get-buffer v) (buffer-string)))
2680 ;; `expand-file-name' and alike. 2683
2681 (insert 2684 ;; We must enable unibyte strings, because the "--dired"
2682 (with-current-buffer (tramp-get-buffer v) 2685 ;; output counts in bytes.
2683 (buffer-string))) 2686 (set-buffer-multibyte nil)
2684 2687 (save-restriction
2685 ;; Check for "--dired" output. We must enable unibyte 2688 (narrow-to-region beg-marker end-marker)
2686 ;; strings, because the "--dired" output counts in bytes. 2689 ;; Check for "--dired" output.
2687 (set-buffer-multibyte nil)
2688 (forward-line -2) 2690 (forward-line -2)
2689 (when (looking-at-p "//SUBDIRED//") 2691 (when (looking-at-p "//SUBDIRED//")
2690 (forward-line -1)) 2692 (forward-line -1))
2691 (when (looking-at "//DIRED//\\s-+") 2693 (when (looking-at "//DIRED//\\s-+")
2692 (let ((databeg (match-end 0)) 2694 (let ((beg (match-end 0))
2693 (end (point-at-eol))) 2695 (end (point-at-eol)))
2694 ;; Now read the numeric positions of file names. 2696 ;; Now read the numeric positions of file names.
2695 (goto-char databeg) 2697 (goto-char beg)
2696 (while (< (point) end) 2698 (while (< (point) end)
2697 (let ((start (+ beg (read (current-buffer)))) 2699 (let ((start (+ (point-min) (read (current-buffer))))
2698 (end (+ beg (read (current-buffer))))) 2700 (end (+ (point-min) (read (current-buffer)))))
2699 (if (memq (char-after end) '(?\n ?\ )) 2701 (if (memq (char-after end) '(?\n ?\ ))
2700 ;; End is followed by \n or by " -> ". 2702 ;; End is followed by \n or by " -> ".
2701 (put-text-property start end 'dired-filename t)))))) 2703 (put-text-property start end 'dired-filename t))))))
@@ -2703,18 +2705,18 @@ The method used must be an out-of-band method."
2703 (goto-char (point-at-bol)) 2705 (goto-char (point-at-bol))
2704 (while (looking-at "//") 2706 (while (looking-at "//")
2705 (forward-line 1) 2707 (forward-line 1)
2706 (delete-region (match-beginning 0) (point))) 2708 (delete-region (match-beginning 0) (point))))
2707 ;; Reset multibyte if needed. 2709 ;; Reset multibyte if needed.
2708 (set-buffer-multibyte emc) 2710 (set-buffer-multibyte emc)
2709 2711
2712 (save-restriction
2713 (narrow-to-region beg-marker end-marker)
2710 ;; Some busyboxes are reluctant to discard colors. 2714 ;; Some busyboxes are reluctant to discard colors.
2711 (unless 2715 (unless
2712 (string-match-p "color" (tramp-get-connection-property v "ls" "")) 2716 (string-match-p "color" (tramp-get-connection-property v "ls" ""))
2713 (save-excursion 2717 (goto-char (point-min))
2714 (goto-char beg) 2718 (while (re-search-forward tramp-display-escape-sequence-regexp nil t)
2715 (while 2719 (replace-match "")))
2716 (re-search-forward tramp-display-escape-sequence-regexp nil t)
2717 (replace-match ""))))
2718 2720
2719 ;; Now decode what read if necessary. Stolen from `insert-directory'. 2721 ;; Now decode what read if necessary. Stolen from `insert-directory'.
2720 (let ((coding (or coding-system-for-read 2722 (let ((coding (or coding-system-for-read
@@ -2729,36 +2731,32 @@ The method used must be an out-of-band method."
2729 ;; If no coding system is specified or detection is 2731 ;; If no coding system is specified or detection is
2730 ;; requested, detect the coding. 2732 ;; requested, detect the coding.
2731 (if (eq (coding-system-base coding) 'undecided) 2733 (if (eq (coding-system-base coding) 'undecided)
2732 (setq coding (detect-coding-region beg (point) t))) 2734 (setq coding (detect-coding-region (point-min) (point) t)))
2733 (if (not (eq (coding-system-base coding) 'undecided)) 2735 (unless (eq (coding-system-base coding) 'undecided)
2734 (save-restriction 2736 (setq coding-no-eol
2735 (setq coding-no-eol 2737 (coding-system-change-eol-conversion coding 'unix))
2736 (coding-system-change-eol-conversion coding 'unix)) 2738 (goto-char (point-min))
2737 (narrow-to-region beg (point)) 2739 (while (not (eobp))
2738 (goto-char (point-min)) 2740 (setq pos (point)
2739 (while (not (eobp)) 2741 val (get-text-property (point) 'dired-filename))
2740 (setq pos (point) 2742 (goto-char (next-single-property-change
2741 val (get-text-property (point) 'dired-filename)) 2743 (point) 'dired-filename nil (point-max)))
2742 (goto-char (next-single-property-change 2744 ;; Force no eol conversion on a file name, so that
2743 (point) 'dired-filename nil (point-max))) 2745 ;; CR is preserved.
2744 ;; Force no eol conversion on a file name, so 2746 (decode-coding-region
2745 ;; that CR is preserved. 2747 pos (point) (if val coding-no-eol coding))
2746 (decode-coding-region pos (point) 2748 (if val (put-text-property pos (point) 'dired-filename t))))))
2747 (if val coding-no-eol coding))
2748 (if val
2749 (put-text-property pos (point)
2750 'dired-filename t)))))))
2751 2749
2752 ;; The inserted file could be from somewhere else. 2750 ;; The inserted file could be from somewhere else.
2753 (when (and (not wildcard) (not full-directory-p)) 2751 (when (and (not wildcard) (not full-directory-p))
2754 (goto-char (point-max)) 2752 (goto-char (point-max))
2755 (when (file-symlink-p filename) 2753 (when (file-symlink-p filename)
2756 (goto-char (search-backward "->" beg 'noerror))) 2754 (goto-char (search-backward "->" (point-min) 'noerror)))
2757 (search-backward 2755 (search-backward
2758 (if (directory-name-p filename) 2756 (if (directory-name-p filename)
2759 "." 2757 "."
2760 (file-name-nondirectory filename)) 2758 (file-name-nondirectory filename))
2761 beg 'noerror) 2759 (point-min) 'noerror)
2762 (replace-match (file-relative-name filename) t)) 2760 (replace-match (file-relative-name filename) t))
2763 2761
2764 ;; Try to insert the amount of free space. 2762 ;; Try to insert the amount of free space.
@@ -2769,9 +2767,11 @@ The method used must be an out-of-band method."
2769 ;; Replace "total" with "total used", to avoid confusion. 2767 ;; Replace "total" with "total used", to avoid confusion.
2770 (replace-match "\\1 used in directory") 2768 (replace-match "\\1 used in directory")
2771 (end-of-line) 2769 (end-of-line)
2772 (insert " available " available))) 2770 (insert " available " available))))
2773 2771
2774 (goto-char (point-max))))))) 2772 (prog1 (goto-char end-marker)
2773 (set-marker beg-marker nil)
2774 (set-marker end-marker nil))))))
2775 2775
2776;; Canonicalization of file names. 2776;; Canonicalization of file names.
2777 2777
@@ -2840,9 +2840,9 @@ the result will be a local, non-Tramp, file name."
2840;; terminated. 2840;; terminated.
2841(defun tramp-sh-handle-make-process (&rest args) 2841(defun tramp-sh-handle-make-process (&rest args)
2842 "Like `make-process' for Tramp files. 2842 "Like `make-process' for Tramp files.
2843STDERR can also be a file name. If connection property 2843STDERR can also be a file name. If method parameter `tramp-direct-async'
2844\"direct-async-process\" is non-nil, an alternative 2844and connection property \"direct-async-process\" are non-nil, an
2845implementation will be used." 2845alternative implementation will be used."
2846 (if (tramp-direct-async-process-p args) 2846 (if (tramp-direct-async-process-p args)
2847 (apply #'tramp-handle-make-process args) 2847 (apply #'tramp-handle-make-process args)
2848 (when args 2848 (when args
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index cc8dda809e2..2816c58fe7f 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:
259 parameters to suppress diagnostic messages, in order not to 259 parameters to suppress diagnostic messages, in order not to
260 tamper the process output. 260 tamper the process output.
261 261
262 * `tramp-direct-async-args' 262 * `tramp-direct-async'
263 An additional argument when a direct asynchronous process is 263 Whether the method supports direct asynchronous processes.
264 started. Used so far only in the \"mock\" method of tramp-tests.el. 264 Until now, just \"ssh\"-based and \"adb\"-based methods do.
265 265
266 * `tramp-copy-program' 266 * `tramp-copy-program'
267 This specifies the name of the program to use for remotely copying 267 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."
1755Message is formatted with FMT-STRING as control string and the remaining 1755Message is formatted with FMT-STRING as control string and the remaining
1756ARGUMENTS to actually emit the message (if applicable)." 1756ARGUMENTS to actually emit the message (if applicable)."
1757 (let ((inhibit-message t) 1757 (let ((inhibit-message t)
1758 file-name-handler-alist message-log-max signal-hook-function) 1758 create-lockfiles file-name-handler-alist message-log-max
1759 signal-hook-function)
1759 (with-current-buffer (tramp-get-debug-buffer vec) 1760 (with-current-buffer (tramp-get-debug-buffer vec)
1760 (goto-char (point-max)) 1761 (goto-char (point-max))
1761 (let ((point (point))) 1762 (let ((point (point)))
@@ -1982,6 +1983,13 @@ the resulting error message."
1982 1983
1983(put #'tramp-with-demoted-errors 'tramp-suppress-trace t) 1984(put #'tramp-with-demoted-errors 'tramp-suppress-trace t)
1984 1985
1986(defun tramp-test-message (fmt-string &rest arguments)
1987 "Emit a Tramp message according `default-directory'."
1988 (if (tramp-tramp-file-p default-directory)
1989 (apply #'tramp-message
1990 (tramp-dissect-file-name default-directory) 0 fmt-string arguments)
1991 (apply #'message fmt-string arguments)))
1992
1985;; This function provides traces in case of errors not triggered by 1993;; This function provides traces in case of errors not triggered by
1986;; Tramp functions. 1994;; Tramp functions.
1987(defun tramp-signal-hook-function (error-symbol data) 1995(defun tramp-signal-hook-function (error-symbol data)
@@ -3741,7 +3749,9 @@ User is always nil."
3741 (let ((v (tramp-dissect-file-name default-directory)) 3749 (let ((v (tramp-dissect-file-name default-directory))
3742 (buffer (plist-get args :buffer)) 3750 (buffer (plist-get args :buffer))
3743 (stderr (plist-get args :stderr))) 3751 (stderr (plist-get args :stderr)))
3744 (and ;; It has been indicated. 3752 (and ;; The method supports it.
3753 (tramp-get-method-parameter v 'tramp-direct-async)
3754 ;; It has been indicated.
3745 (tramp-get-connection-property v "direct-async-process" nil) 3755 (tramp-get-connection-property v "direct-async-process" nil)
3746 ;; There's no multi-hop. 3756 ;; There's no multi-hop.
3747 (or (not (tramp-multi-hop-p v)) 3757 (or (not (tramp-multi-hop-p v))
@@ -3821,8 +3831,6 @@ It does not support `:stderr'."
3821 (tramp-get-method-parameter v 'tramp-login-args)) 3831 (tramp-get-method-parameter v 'tramp-login-args))
3822 (async-args 3832 (async-args
3823 (tramp-get-method-parameter v 'tramp-async-args)) 3833 (tramp-get-method-parameter v 'tramp-async-args))
3824 (direct-async-args
3825 (tramp-get-method-parameter v 'tramp-direct-async-args))
3826 ;; We don't create the temporary file. In fact, it 3834 ;; We don't create the temporary file. In fact, it
3827 ;; is just a prefix for the ControlPath option of 3835 ;; is just a prefix for the ControlPath option of
3828 ;; ssh; the real temporary file has another name, and 3836 ;; ssh; the real temporary file has another name, and
@@ -3850,7 +3858,7 @@ It does not support `:stderr'."
3850 ?h (or host "") ?u (or user "") ?p (or port "") 3858 ?h (or host "") ?u (or user "") ?p (or port "")
3851 ?c options ?l "") 3859 ?c options ?l "")
3852 ;; Add arguments for asynchronous processes. 3860 ;; Add arguments for asynchronous processes.
3853 login-args (append async-args direct-async-args login-args) 3861 login-args (append async-args login-args)
3854 ;; Expand format spec. 3862 ;; Expand format spec.
3855 login-args 3863 login-args
3856 (tramp-compat-flatten-tree 3864 (tramp-compat-flatten-tree
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 714b3f9bb01..ced3e93fc09 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,7 +7,7 @@
7;; Maintainer: Michael Albinus <michael.albinus@gmx.de> 7;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
8;; Keywords: comm, processes 8;; Keywords: comm, processes
9;; Package: tramp 9;; Package: tramp
10;; Version: 2.5.0 10;; Version: 2.5.1-pre
11;; Package-Requires: ((emacs "25.1")) 11;; Package-Requires: ((emacs "25.1"))
12;; Package-Type: multi 12;; Package-Type: multi
13;; URL: https://www.gnu.org/software/tramp/ 13;; URL: https://www.gnu.org/software/tramp/
@@ -40,7 +40,7 @@
40;; ./configure" to change them. 40;; ./configure" to change them.
41 41
42;;;###tramp-autoload 42;;;###tramp-autoload
43(defconst tramp-version "2.5.0" 43(defconst tramp-version "2.5.1-pre"
44 "This version of Tramp.") 44 "This version of Tramp.")
45 45
46;;;###tramp-autoload 46;;;###tramp-autoload
@@ -76,7 +76,7 @@
76;; Check for Emacs version. 76;; Check for Emacs version.
77(let ((x (if (not (string-lessp emacs-version "25.1")) 77(let ((x (if (not (string-lessp emacs-version "25.1"))
78 "ok" 78 "ok"
79 (format "Tramp 2.5.0 is not fit for %s" 79 (format "Tramp 2.5.1-pre is not fit for %s"
80 (replace-regexp-in-string "\n" "" (emacs-version)))))) 80 (replace-regexp-in-string "\n" "" (emacs-version))))))
81 (unless (string-equal "ok" x) (error "%s" x))) 81 (unless (string-equal "ok" x) (error "%s" x)))
82 82
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index cc0e159faef..68dc0fb94b3 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."
132 (pixel-line-height)))) 132 (pixel-line-height))))
133 (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close 133 (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close
134 (scroll-up 1) ; relay on robust method 134 (scroll-up 1) ; relay on robust method
135 (while (pixel-point-at-top-p amt) ; prevent too late (multi tries) 135 (catch 'no-movement
136 (vertical-motion 1)) ; move point downward 136 (while (pixel-point-at-top-p amt) ; prevent too late (multi tries)
137 (unless (>= (vertical-motion 1) 1) ; move point downward
138 (throw 'no-movement nil)))) ; exit loop when point did not move
137 (pixel-scroll-pixel-up amt)))))) ; move scope downward 139 (pixel-scroll-pixel-up amt)))))) ; move scope downward
138 140
139(defun pixel-scroll-down (&optional arg) 141(defun pixel-scroll-down (&optional arg)
@@ -149,8 +151,10 @@ This is and alternative of `scroll-down'. Scope moves upward."
149 pixel-resolution-fine-flag 151 pixel-resolution-fine-flag
150 (frame-char-height)) 152 (frame-char-height))
151 (pixel-line-height -1)))) 153 (pixel-line-height -1))))
152 (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries) 154 (catch 'no-movement
153 (vertical-motion -1)) ; move point upward 155 (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries)
156 (unless (<= (vertical-motion -1) -1) ; move point upward
157 (throw 'no-movement nil)))) ; exit loop when point did not move
154 (if (or (pixel-bob-at-top-p amt) ; when beginning-of-the-buffer is seen 158 (if (or (pixel-bob-at-top-p amt) ; when beginning-of-the-buffer is seen
155 (pixel-eob-at-top-p)) ; for file with a long line 159 (pixel-eob-at-top-p)) ; for file with a long line
156 (scroll-down 1) ; relay on robust method 160 (scroll-down 1) ; relay on robust method
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index fddc13f56b1..460af718aad 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -4,7 +4,7 @@
4 4
5;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> 5;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
6;; Maintainer: João Távora <joaotavora@gmail.com> 6;; Maintainer: João Távora <joaotavora@gmail.com>
7;; Version: 1.1.0 7;; Version: 1.1.1
8;; Keywords: c languages tools 8;; Keywords: c languages tools
9;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0")) 9;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0"))
10 10
@@ -1283,6 +1283,8 @@ correctly.")
1283 (when (flymake-running-backends) flymake-mode-line-counter-format)) 1283 (when (flymake-running-backends) flymake-mode-line-counter-format))
1284 1284
1285(defun flymake--mode-line-counter (type &optional no-space) 1285(defun flymake--mode-line-counter (type &optional no-space)
1286 "Compute number of diagnostics in buffer with TYPE's severity.
1287TYPE is usually keyword `:error', `:warning' or `:note'."
1286 (let ((count 0) 1288 (let ((count 0)
1287 (face (flymake--lookup-type-property type 1289 (face (flymake--lookup-type-property type
1288 'mode-line-face 1290 'mode-line-face
@@ -1290,7 +1292,8 @@ correctly.")
1290 (maphash (lambda 1292 (maphash (lambda
1291 (_b state) 1293 (_b state)
1292 (dolist (d (flymake--backend-state-diags state)) 1294 (dolist (d (flymake--backend-state-diags state))
1293 (when (eq type (flymake--diag-type d)) 1295 (when (= (flymake--severity type)
1296 (flymake--severity (flymake--diag-type d)))
1294 (cl-incf count)))) 1297 (cl-incf count))))
1295 flymake--backend-state) 1298 flymake--backend-state)
1296 (when (or (cl-plusp count) 1299 (when (or (cl-plusp count)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 62c3cf44cb6..06966f33b72 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -970,20 +970,11 @@ loop using the command \\[fileloop-continue]."
970(declare-function compilation-read-command "compile") 970(declare-function compilation-read-command "compile")
971 971
972;;;###autoload 972;;;###autoload
973(defun project-compile (command &optional comint) 973(defun project-compile ()
974 "Run `compile' in the project root. 974 "Run `compile' in the project root."
975Arguments the same as in `compile'." 975 (interactive)
976 (interactive 976 (let ((default-directory (project-root (project-current t))))
977 (list 977 (call-interactively #'compile)))
978 (let ((command (eval compile-command)))
979 (require 'compile)
980 (if (or compilation-read-command current-prefix-arg)
981 (compilation-read-command command)
982 command))
983 (consp current-prefix-arg)))
984 (let* ((pr (project-current t))
985 (default-directory (project-root pr)))
986 (compile command comint)))
987 978
988(defun project--read-project-buffer () 979(defun project--read-project-buffer ()
989 (let* ((pr (project-current t)) 980 (let* ((pr (project-current t))
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index c8f6c12a3f0..9f5f9ed6d3d 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1201,7 +1201,9 @@ Commands:
1201(define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]" 1201(define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]"
1202 "Major mode for editing Mercury programs. 1202 "Major mode for editing Mercury programs.
1203Actually this is just customized `prolog-mode'." 1203Actually this is just customized `prolog-mode'."
1204 (setq-local prolog-system 'mercury)) 1204 (setq-local prolog-system 'mercury)
1205 ;; Run once more to set up based on `prolog-system'
1206 (prolog-mode-variables))
1205 1207
1206 1208
1207;;------------------------------------------------------------------- 1209;;-------------------------------------------------------------------
@@ -2082,7 +2084,7 @@ Argument BOUND is a buffer position limiting searching."
2082 (delq 2084 (delq
2083 nil 2085 nil
2084 (cond 2086 (cond
2085 ((eq major-mode 'prolog-mode) 2087 ((derived-mode-p 'prolog-mode)
2086 (list 2088 (list
2087 head-predicates 2089 head-predicates
2088 head-predicates-1 2090 head-predicates-1
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 0965fecfb74..d6c0a4d1dbf 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -2027,8 +2027,12 @@ position, else returns nil."
2027 :group 'python 2027 :group 'python
2028 :safe 'stringp) 2028 :safe 'stringp)
2029 2029
2030(defcustom python-shell-interpreter "python" 2030(defcustom python-shell-interpreter
2031 (cond ((executable-find "python3") "python3")
2032 ((executable-find "python") "python")
2033 (t "python3"))
2031 "Default Python interpreter for shell." 2034 "Default Python interpreter for shell."
2035 :version "28.1"
2032 :type 'string 2036 :type 'string
2033 :group 'python) 2037 :group 'python)
2034 2038
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index b393b8d0f1a..b6778de807d 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -663,6 +663,12 @@ means to first quit the *xref* buffer."
663 (interactive) 663 (interactive)
664 (xref-goto-xref t)) 664 (xref-goto-xref t))
665 665
666(defun xref-quit-and-pop-marker-stack ()
667 "Quit *xref* buffer, then pop the xref marker stack."
668 (interactive)
669 (quit-window)
670 (xref-pop-marker-stack))
671
666(defun xref-query-replace-in-results (from to) 672(defun xref-query-replace-in-results (from to)
667 "Perform interactive replacement of FROM with TO in all displayed xrefs. 673 "Perform interactive replacement of FROM with TO in all displayed xrefs.
668 674
@@ -793,6 +799,7 @@ references displayed in the current *xref* buffer."
793 (define-key map (kbd ".") #'xref-next-line) 799 (define-key map (kbd ".") #'xref-next-line)
794 (define-key map (kbd ",") #'xref-prev-line) 800 (define-key map (kbd ",") #'xref-prev-line)
795 (define-key map (kbd "g") #'xref-revert-buffer) 801 (define-key map (kbd "g") #'xref-revert-buffer)
802 (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack)
796 map)) 803 map))
797 804
798(define-derived-mode xref--xref-buffer-mode special-mode "XREF" 805(define-derived-mode xref--xref-buffer-mode special-mode "XREF"
@@ -928,8 +935,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
928 (or 935 (or
929 (assoc-default 'fetched-xrefs alist) 936 (assoc-default 'fetched-xrefs alist)
930 (funcall fetcher))) 937 (funcall fetcher)))
931 (xref-alist (xref--analyze xrefs))) 938 (xref-alist (xref--analyze xrefs))
939 (dd default-directory))
932 (with-current-buffer (get-buffer-create xref-buffer-name) 940 (with-current-buffer (get-buffer-create xref-buffer-name)
941 (setq default-directory dd)
933 (xref--xref-buffer-mode) 942 (xref--xref-buffer-mode)
934 (xref--show-common-initialize xref-alist fetcher alist) 943 (xref--show-common-initialize xref-alist fetcher alist)
935 (pop-to-buffer (current-buffer)) 944 (pop-to-buffer (current-buffer))
@@ -992,13 +1001,15 @@ When only one definition found, jump to it right away instead."
992When there is more than one definition, split the selected window 1001When there is more than one definition, split the selected window
993and show the list in a small window at the bottom. And use a 1002and show the list in a small window at the bottom. And use a
994local keymap that binds `RET' to `xref-quit-and-goto-xref'." 1003local keymap that binds `RET' to `xref-quit-and-goto-xref'."
995 (let ((xrefs (funcall fetcher))) 1004 (let ((xrefs (funcall fetcher))
1005 (dd default-directory))
996 (cond 1006 (cond
997 ((not (cdr xrefs)) 1007 ((not (cdr xrefs))
998 (xref-pop-to-location (car xrefs) 1008 (xref-pop-to-location (car xrefs)
999 (assoc-default 'display-action alist))) 1009 (assoc-default 'display-action alist)))
1000 (t 1010 (t
1001 (with-current-buffer (get-buffer-create xref-buffer-name) 1011 (with-current-buffer (get-buffer-create xref-buffer-name)
1012 (setq default-directory dd)
1002 (xref--transient-buffer-mode) 1013 (xref--transient-buffer-mode)
1003 (xref--show-common-initialize (xref--analyze xrefs) fetcher alist) 1014 (xref--show-common-initialize (xref--analyze xrefs) fetcher alist)
1004 (pop-to-buffer (current-buffer) 1015 (pop-to-buffer (current-buffer)
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 7cda6c96aff..1e819044194 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -429,7 +429,7 @@ dragging. See also the variable `ruler-mode-dragged-symbol'."
429 ;; `ding' flushes the next messages about setting goal 429 ;; `ding' flushes the next messages about setting goal
430 ;; column. So here I force fetch the event(mouse-2) and 430 ;; column. So here I force fetch the event(mouse-2) and
431 ;; throw away. 431 ;; throw away.
432 (read-event) 432 (read--potential-mouse-event)
433 ;; Ding BEFORE `message' is OK. 433 ;; Ding BEFORE `message' is OK.
434 (when ruler-mode-set-goal-column-ding-flag 434 (when ruler-mode-set-goal-column-ding-flag
435 (ding)) 435 (ding))
@@ -460,7 +460,7 @@ the mouse has been clicked."
460 (track-mouse 460 (track-mouse
461 ;; Signal the display engine to freeze the mouse pointer shape. 461 ;; Signal the display engine to freeze the mouse pointer shape.
462 (setq track-mouse 'dragging) 462 (setq track-mouse 'dragging)
463 (while (mouse-movement-p (setq event (read-event))) 463 (while (mouse-movement-p (setq event (read--potential-mouse-event)))
464 (setq drags (1+ drags)) 464 (setq drags (1+ drags))
465 (when (eq window (posn-window (event-end event))) 465 (when (eq window (posn-window (event-end event)))
466 (ruler-mode-mouse-drag-any-column event) 466 (ruler-mode-mouse-drag-any-column event)
diff --git a/lisp/shell.el b/lisp/shell.el
index c179dd24d3f..0f866158fe3 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -603,6 +603,7 @@ buffer."
603 (or hfile 603 (or hfile
604 (cond ((string-equal shell "bash") "~/.bash_history") 604 (cond ((string-equal shell "bash") "~/.bash_history")
605 ((string-equal shell "ksh") "~/.sh_history") 605 ((string-equal shell "ksh") "~/.sh_history")
606 ((string-equal shell "zsh") "~/.zsh_history")
606 (t "~/.history"))))) 607 (t "~/.history")))))
607 (if (or (equal comint-input-ring-file-name "") 608 (if (or (equal comint-input-ring-file-name "")
608 (equal (file-truename comint-input-ring-file-name) 609 (equal (file-truename comint-input-ring-file-name)
diff --git a/lisp/simple.el b/lisp/simple.el
index 54c35c04bea..37c0885dcc5 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5606,7 +5606,9 @@ See also `zap-up-to-char'."
5606;; kill-line and its subroutines. 5606;; kill-line and its subroutines.
5607 5607
5608(defcustom kill-whole-line nil 5608(defcustom kill-whole-line nil
5609 "If non-nil, `kill-line' with no arg at start of line kills the whole line." 5609 "If non-nil, `kill-line' with no arg at start of line kills the whole line.
5610This variable also affects `kill-visual-line' in the same way as
5611it does `kill-line'."
5610 :type 'boolean 5612 :type 'boolean
5611 :group 'killing) 5613 :group 'killing)
5612 5614
@@ -7319,6 +7321,10 @@ If ARG is negative, kill visual lines backward.
7319If ARG is zero, kill the text before point on the current visual 7321If ARG is zero, kill the text before point on the current visual
7320line. 7322line.
7321 7323
7324If the variable `kill-whole-line' is non-nil, and this command is
7325invoked at start of a line that ends in a newline, kill the newline
7326as well.
7327
7322If you want to append the killed line to the last killed text, 7328If you want to append the killed line to the last killed text,
7323use \\[append-next-kill] before \\[kill-line]. 7329use \\[append-next-kill] before \\[kill-line].
7324 7330
@@ -7331,18 +7337,30 @@ even beep.)"
7331 ;; Like in `kill-line', it's better to move point to the other end 7337 ;; Like in `kill-line', it's better to move point to the other end
7332 ;; of the kill before killing. 7338 ;; of the kill before killing.
7333 (let ((opoint (point)) 7339 (let ((opoint (point))
7334 (kill-whole-line (and kill-whole-line (bolp)))) 7340 (kill-whole-line (and kill-whole-line (bolp)))
7341 (orig-y (cdr (nth 2 (posn-at-point))))
7342 ;; FIXME: This tolerance should be zero! It isn't due to a
7343 ;; bug in posn-at-point, see bug#45837.
7344 (tol (/ (line-pixel-height) 2)))
7335 (if arg 7345 (if arg
7336 (vertical-motion (prefix-numeric-value arg)) 7346 (vertical-motion (prefix-numeric-value arg))
7337 (end-of-visual-line 1) 7347 (end-of-visual-line 1)
7338 (if (= (point) opoint) 7348 (if (= (point) opoint)
7339 (vertical-motion 1) 7349 (vertical-motion 1)
7340 ;; Skip any trailing whitespace at the end of the visual line. 7350 ;; The first condition below verifies we are still on the same
7341 ;; We used to do this only if `show-trailing-whitespace' is 7351 ;; screen line, i.e. that the line isn't continued, and that
7342 ;; nil, but that's wrong; the correct thing would be to check 7352 ;; end-of-visual-line didn't overshoot due to complications
7343 ;; whether the trailing whitespace is highlighted. But, it's 7353 ;; like display or overlay strings, intangible text, etc.:
7344 ;; OK to just do this unconditionally. 7354 ;; otherwise, we don't want to kill a character that's
7345 (skip-chars-forward " \t"))) 7355 ;; unrelated to the place where the visual line wrapped.
7356 (and (< (abs (- (cdr (nth 2 (posn-at-point))) orig-y)) tol)
7357 ;; Make sure we delete the character where the line wraps
7358 ;; under visual-line-mode, be it whitespace or a
7359 ;; character whose category set allows to wrap at it.
7360 (or (looking-at-p "[ \t]")
7361 (and word-wrap-by-category
7362 (aref (char-category-set (following-char)) ?\|)))
7363 (forward-char))))
7346 (kill-region opoint (if (and kill-whole-line (= (following-char) ?\n)) 7364 (kill-region opoint (if (and kill-whole-line (= (following-char) ?\n))
7347 (1+ (point)) 7365 (1+ (point))
7348 (point))))) 7366 (point)))))
diff --git a/lisp/startup.el b/lisp/startup.el
index 8a8e8354900..9325ab5acff 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
929loaded, and ALTERNATE-FILENAME-FUNCTION is non-nil, then it is 929loaded, and ALTERNATE-FILENAME-FUNCTION is non-nil, then it is
930called with no arguments and should return the name of an 930called with no arguments and should return the name of an
931alternate init-file to load. If LOAD-DEFAULTS is non-nil, then 931alternate init-file to load. If LOAD-DEFAULTS is non-nil, then
932load default.el after the init-file. 932load default.el after the init-file, unless `inhibit-default-init'
933is non-nil.
933 934
934This function sets `user-init-file' to the name of the loaded 935This function sets `user-init-file' to the name of the loaded
935init-file, or to a default value if loading is not possible." 936init-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."
985 (sit-for 1)) 986 (sit-for 1))
986 (setq user-init-file source)))) 987 (setq user-init-file source))))
987 988
988 (when load-defaults 989 (when (and load-defaults
989 990 (not inhibit-default-init))
990 ;; Prevent default.el from changing the value of 991 ;; Prevent default.el from changing the value of
991 ;; `inhibit-startup-screen'. 992 ;; `inhibit-startup-screen'.
992 (let ((inhibit-startup-screen nil)) 993 (let ((inhibit-startup-screen nil))
@@ -1174,12 +1175,11 @@ please check its value")
1174 1175
1175 ;; Re-evaluate predefined variables whose initial value depends on 1176 ;; Re-evaluate predefined variables whose initial value depends on
1176 ;; the runtime context. 1177 ;; the runtime context.
1177 (let (current-load-list) ; c-r-s may call defvar, and hence LOADHIST_ATTACH 1178 (setq custom-delayed-init-variables
1178 (setq custom-delayed-init-variables 1179 ;; Initialize them in the same order they were loaded, in case there
1179 ;; Initialize them in the same order they were loaded, in case there 1180 ;; are dependencies between them.
1180 ;; are dependencies between them. 1181 (nreverse custom-delayed-init-variables))
1181 (nreverse custom-delayed-init-variables)) 1182 (mapc #'custom-reevaluate-setting custom-delayed-init-variables)
1182 (mapc 'custom-reevaluate-setting custom-delayed-init-variables))
1183 1183
1184 ;; Warn for invalid user name. 1184 ;; Warn for invalid user name.
1185 (when init-file-user 1185 (when init-file-user
@@ -1296,8 +1296,7 @@ please check its value")
1296 (if (or noninteractive emacs-basic-display) 1296 (if (or noninteractive emacs-basic-display)
1297 (setq menu-bar-mode nil 1297 (setq menu-bar-mode nil
1298 tab-bar-mode nil 1298 tab-bar-mode nil
1299 tool-bar-mode nil 1299 tool-bar-mode nil))
1300 no-blinking-cursor t))
1301 (frame-initialize)) 1300 (frame-initialize))
1302 1301
1303 (when (fboundp 'x-create-frame) 1302 (when (fboundp 'x-create-frame)
@@ -1306,15 +1305,6 @@ please check its value")
1306 (unless noninteractive 1305 (unless noninteractive
1307 (tool-bar-setup))) 1306 (tool-bar-setup)))
1308 1307
1309 ;; Turn off blinking cursor if so specified in X resources. This is here
1310 ;; only because all other settings of no-blinking-cursor are here.
1311 (unless (or noninteractive
1312 emacs-basic-display
1313 (and (memq window-system '(x w32 ns))
1314 (not (member (x-get-resource "cursorBlink" "CursorBlink")
1315 '("no" "off" "false" "0")))))
1316 (setq no-blinking-cursor t))
1317
1318 (unless noninteractive 1308 (unless noninteractive
1319 (startup--setup-quote-display) 1309 (startup--setup-quote-display)
1320 (setq internal--text-quoting-flag t)) 1310 (setq internal--text-quoting-flag t))
@@ -1322,9 +1312,8 @@ please check its value")
1322 ;; Re-evaluate again the predefined variables whose initial value 1312 ;; Re-evaluate again the predefined variables whose initial value
1323 ;; depends on the runtime context, in case some of them depend on 1313 ;; depends on the runtime context, in case some of them depend on
1324 ;; the window-system features. Example: blink-cursor-mode. 1314 ;; the window-system features. Example: blink-cursor-mode.
1325 (let (current-load-list) ; c-r-s may call defvar, and hence LOADHIST_ATTACH 1315 (mapc #'custom-reevaluate-setting custom-delayed-init-variables)
1326 (mapc 'custom-reevaluate-setting custom-delayed-init-variables) 1316 (setq custom-delayed-init-variables nil)
1327 (setq custom-delayed-init-variables nil))
1328 1317
1329 (normal-erase-is-backspace-setup-frame) 1318 (normal-erase-is-backspace-setup-frame)
1330 1319
@@ -1382,7 +1371,7 @@ please check its value")
1382 (expand-file-name 1371 (expand-file-name
1383 "init.el" 1372 "init.el"
1384 startup-init-directory)) 1373 startup-init-directory))
1385 (not inhibit-default-init)) 1374 t)
1386 1375
1387 (when (and deactivate-mark transient-mark-mode) 1376 (when (and deactivate-mark transient-mark-mode)
1388 (with-current-buffer (window-buffer) 1377 (with-current-buffer (window-buffer)
diff --git a/lisp/strokes.el b/lisp/strokes.el
index b0ab4f990f6..55f2ae8cc47 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -756,12 +756,12 @@ Optional EVENT is acceptable as the starting event of the stroke."
756 (strokes-fill-current-buffer-with-whitespace)) 756 (strokes-fill-current-buffer-with-whitespace))
757 (when prompt 757 (when prompt
758 (message "%s" prompt) 758 (message "%s" prompt)
759 (setq event (read-event)) 759 (setq event (read--potential-mouse-event))
760 (or (strokes-button-press-event-p event) 760 (or (strokes-button-press-event-p event)
761 (error "You must draw with the mouse"))) 761 (error "You must draw with the mouse")))
762 (unwind-protect 762 (unwind-protect
763 (track-mouse 763 (track-mouse
764 (or event (setq event (read-event) 764 (or event (setq event (read--potential-mouse-event)
765 safe-to-draw-p t)) 765 safe-to-draw-p t))
766 (while (not (strokes-button-release-event-p event)) 766 (while (not (strokes-button-release-event-p event))
767 (if (strokes-mouse-event-p event) 767 (if (strokes-mouse-event-p event)
@@ -776,7 +776,7 @@ Optional EVENT is acceptable as the starting event of the stroke."
776 (setq safe-to-draw-p t)) 776 (setq safe-to-draw-p t))
777 (push (cdr (mouse-pixel-position)) 777 (push (cdr (mouse-pixel-position))
778 pix-locs))) 778 pix-locs)))
779 (setq event (read-event))))) 779 (setq event (read--potential-mouse-event)))))
780 ;; protected 780 ;; protected
781 ;; clean up strokes buffer and then bury it. 781 ;; clean up strokes buffer and then bury it.
782 (when (equal (buffer-name) strokes-buffer-name) 782 (when (equal (buffer-name) strokes-buffer-name)
@@ -787,16 +787,16 @@ Optional EVENT is acceptable as the starting event of the stroke."
787 ;; Otherwise, don't use strokes buffer and read stroke silently 787 ;; Otherwise, don't use strokes buffer and read stroke silently
788 (when prompt 788 (when prompt
789 (message "%s" prompt) 789 (message "%s" prompt)
790 (setq event (read-event)) 790 (setq event (read--potential-mouse-event))
791 (or (strokes-button-press-event-p event) 791 (or (strokes-button-press-event-p event)
792 (error "You must draw with the mouse"))) 792 (error "You must draw with the mouse")))
793 (track-mouse 793 (track-mouse
794 (or event (setq event (read-event))) 794 (or event (setq event (read--potential-mouse-event)))
795 (while (not (strokes-button-release-event-p event)) 795 (while (not (strokes-button-release-event-p event))
796 (if (strokes-mouse-event-p event) 796 (if (strokes-mouse-event-p event)
797 (push (cdr (mouse-pixel-position)) 797 (push (cdr (mouse-pixel-position))
798 pix-locs)) 798 pix-locs))
799 (setq event (read-event)))) 799 (setq event (read--potential-mouse-event))))
800 (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs))) 800 (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs)))
801 (strokes-fill-stroke 801 (strokes-fill-stroke
802 (strokes-eliminate-consecutive-redundancies grid-locs))))) 802 (strokes-eliminate-consecutive-redundancies grid-locs)))))
@@ -817,10 +817,10 @@ Optional EVENT is acceptable as the starting event of the stroke."
817 (if prompt 817 (if prompt
818 (while (not (strokes-button-press-event-p event)) 818 (while (not (strokes-button-press-event-p event))
819 (message "%s" prompt) 819 (message "%s" prompt)
820 (setq event (read-event)))) 820 (setq event (read--potential-mouse-event))))
821 (unwind-protect 821 (unwind-protect
822 (track-mouse 822 (track-mouse
823 (or event (setq event (read-event))) 823 (or event (setq event (read--potential-mouse-event)))
824 (while (not (and (strokes-button-press-event-p event) 824 (while (not (and (strokes-button-press-event-p event)
825 (eq 'mouse-3 825 (eq 'mouse-3
826 (car (get (car event) 826 (car (get (car event)
@@ -834,14 +834,15 @@ Optional EVENT is acceptable as the starting event of the stroke."
834 ?\s strokes-character)) 834 ?\s strokes-character))
835 (push (cdr (mouse-pixel-position)) 835 (push (cdr (mouse-pixel-position))
836 pix-locs))) 836 pix-locs)))
837 (setq event (read-event))) 837 (setq event (read--potential-mouse-event)))
838 (push strokes-lift pix-locs) 838 (push strokes-lift pix-locs)
839 (while (not (strokes-button-press-event-p event)) 839 (while (not (strokes-button-press-event-p event))
840 (setq event (read-event)))) 840 (setq event (read--potential-mouse-event))))
841 ;; ### KLUDGE! ### sit and wait 841 ;; ### KLUDGE! ### sit and wait
842 ;; for some useless event to 842 ;; for some useless event to
843 ;; happen to fix the minibuffer bug. 843 ;; happen to fix the minibuffer bug.
844 (while (not (strokes-button-release-event-p (read-event)))) 844 (while (not (strokes-button-release-event-p
845 (read--potential-mouse-event))))
845 (setq pix-locs (nreverse (cdr pix-locs)) 846 (setq pix-locs (nreverse (cdr pix-locs))
846 grid-locs (strokes-renormalize-to-grid pix-locs)) 847 grid-locs (strokes-renormalize-to-grid pix-locs))
847 (strokes-fill-stroke 848 (strokes-fill-stroke
diff --git a/lisp/subr.el b/lisp/subr.el
index 6513950e4ef..b1295a0f0d6 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1183,6 +1183,30 @@ KEY is a string or vector representing a sequence of keystrokes."
1183 (if (current-local-map) 1183 (if (current-local-map)
1184 (local-set-key key nil)) 1184 (local-set-key key nil))
1185 nil) 1185 nil)
1186
1187(defun local-key-binding (keys &optional accept-default)
1188 "Return the binding for command KEYS in current local keymap only.
1189KEYS is a string or vector, a sequence of keystrokes.
1190The binding is probably a symbol with a function definition.
1191
1192If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1193bindings; see the description of `lookup-key' for more details
1194about this."
1195 (let ((map (current-local-map)))
1196 (when map (lookup-key map keys accept-default))))
1197
1198(defun global-key-binding (keys &optional accept-default)
1199 "Return the binding for command KEYS in current global keymap only.
1200KEYS is a string or vector, a sequence of keystrokes.
1201The binding is probably a symbol with a function definition.
1202This function's return values are the same as those of `lookup-key'
1203\(which see).
1204
1205If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1206bindings; see the description of `lookup-key' for more details
1207about this."
1208 (lookup-key (current-global-map) keys accept-default))
1209
1186 1210
1187;;;; substitute-key-definition and its subroutines. 1211;;;; substitute-key-definition and its subroutines.
1188 1212
@@ -1335,7 +1359,9 @@ The normal global definition of the character C-x indirects to this keymap.")
1335 map) 1359 map)
1336 "Default global keymap mapping Emacs keyboard input into commands. 1360 "Default global keymap mapping Emacs keyboard input into commands.
1337The value is a keymap that is usually (but not necessarily) Emacs's 1361The value is a keymap that is usually (but not necessarily) Emacs's
1338global map.") 1362global map.
1363
1364See also `current-global-map'.")
1339(use-global-map global-map) 1365(use-global-map global-map)
1340 1366
1341 1367
@@ -1879,9 +1905,33 @@ all symbols are bound before any of the VALUEFORMs are evalled."
1879 ;; As a special-form, we could implement it more efficiently (and cleanly, 1905 ;; As a special-form, we could implement it more efficiently (and cleanly,
1880 ;; making the vars actually unbound during evaluation of the binders). 1906 ;; making the vars actually unbound during evaluation of the binders).
1881 (declare (debug let) (indent 1)) 1907 (declare (debug let) (indent 1))
1882 `(let ,(mapcar #'car binders) 1908 ;; Use plain `let*' for the non-recursive definitions.
1883 ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) 1909 ;; This only handles the case where the first few definitions are not
1884 ,@body)) 1910 ;; recursive. Nothing as fancy as an SCC analysis.
1911 (let ((seqbinds nil))
1912 ;; Our args haven't yet been macro-expanded, so `macroexp--fgrep'
1913 ;; may fail to see references that will be introduced later by
1914 ;; macroexpansion. We could call `macroexpand-all' to avoid that,
1915 ;; but in order to avoid that, we instead check to see if the binders
1916 ;; appear in the macroexp environment, since that's how references can be
1917 ;; introduced later on.
1918 (unless (macroexp--fgrep binders macroexpand-all-environment)
1919 (while (and binders
1920 (null (macroexp--fgrep binders (nth 1 (car binders)))))
1921 (push (pop binders) seqbinds)))
1922 (let ((nbody (if (null binders)
1923 (macroexp-progn body)
1924 `(let ,(mapcar #'car binders)
1925 ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
1926 ,@body))))
1927 (cond
1928 ;; All bindings are recursive.
1929 ((null seqbinds) nbody)
1930 ;; Special case for trivial uses.
1931 ((and (symbolp nbody) (null (cdr seqbinds)) (eq nbody (caar seqbinds)))
1932 (nth 1 (car seqbinds)))
1933 ;; General case.
1934 (t `(let* ,(nreverse seqbinds) ,nbody))))))
1885 1935
1886(defmacro dlet (binders &rest body) 1936(defmacro dlet (binders &rest body)
1887 "Like `let*' but using dynamic scoping." 1937 "Like `let*' but using dynamic scoping."
@@ -2524,23 +2574,52 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'."
2524 2574
2525;;;; Input and display facilities. 2575;;;; Input and display facilities.
2526 2576
2527(defconst read-key-empty-map (make-sparse-keymap)) 2577;; The following maps are used by `read-key' to remove all key
2578;; bindings while calling `read-key-sequence'. This way the keys
2579;; returned are independent of the key binding state.
2580
2581(defconst read-key-empty-map (make-sparse-keymap)
2582 "Used internally by `read-key'.")
2583
2584(defconst read-key-full-map
2585 (let ((map (make-sparse-keymap)))
2586 (define-key map [t] 'dummy)
2587
2588 ;; ESC needs to be unbound so that escape sequences in
2589 ;; `input-decode-map' are still processed by `read-key-sequence'.
2590 (define-key map [?\e] nil)
2591 map)
2592 "Used internally by `read-key'.")
2528 2593
2529(defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. 2594(defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully.
2530 2595
2531(defun read-key (&optional prompt) 2596(defun read-key (&optional prompt disable-fallbacks)
2532 "Read a key from the keyboard. 2597 "Read a key from the keyboard.
2533Contrary to `read-event' this will not return a raw event but instead will 2598Contrary to `read-event' this will not return a raw event but instead will
2534obey the input decoding and translations usually done by `read-key-sequence'. 2599obey the input decoding and translations usually done by `read-key-sequence'.
2535So escape sequences and keyboard encoding are taken into account. 2600So escape sequences and keyboard encoding are taken into account.
2536When there's an ambiguity because the key looks like the prefix of 2601When there's an ambiguity because the key looks like the prefix of
2537some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." 2602some sort of escape sequence, the ambiguity is resolved via `read-key-delay'.
2603
2604If the optional argument PROMPT is non-nil, display that as a
2605prompt.
2606
2607If the optional argument DISABLE-FALLBACKS is non-nil, all
2608unbound fallbacks usually done by `read-key-sequence' are
2609disabled such as discarding mouse down events. This is generally
2610what you want as `read-key' temporarily removes all bindings
2611while calling `read-key-sequence'. If nil or unspecified, the
2612only unbound fallback disabled is downcasing of the last event."
2538 ;; This overriding-terminal-local-map binding also happens to 2613 ;; This overriding-terminal-local-map binding also happens to
2539 ;; disable quail's input methods, so although read-key-sequence 2614 ;; disable quail's input methods, so although read-key-sequence
2540 ;; always inherits the input method, in practice read-key does not 2615 ;; always inherits the input method, in practice read-key does not
2541 ;; inherit the input method (at least not if it's based on quail). 2616 ;; inherit the input method (at least not if it's based on quail).
2542 (let ((overriding-terminal-local-map nil) 2617 (let ((overriding-terminal-local-map nil)
2543 (overriding-local-map read-key-empty-map) 2618 (overriding-local-map
2619 ;; FIXME: Audit existing uses of `read-key' to see if they
2620 ;; should always specify disable-fallbacks to be more in line
2621 ;; with `read-event'.
2622 (if disable-fallbacks read-key-full-map read-key-empty-map))
2544 (echo-keystrokes 0) 2623 (echo-keystrokes 0)
2545 (old-global-map (current-global-map)) 2624 (old-global-map (current-global-map))
2546 (timer (run-with-idle-timer 2625 (timer (run-with-idle-timer
@@ -2594,6 +2673,23 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
2594 (message nil) 2673 (message nil)
2595 (use-global-map old-global-map)))) 2674 (use-global-map old-global-map))))
2596 2675
2676;; FIXME: Once there's a safe way to transition away from read-event,
2677;; callers to this function should be updated to that way and this
2678;; function should be deleted.
2679(defun read--potential-mouse-event ()
2680 "Read an event that might be a mouse event.
2681
2682This function exists for backward compatibility in code packaged
2683with Emacs. Do not call it directly in your own packages."
2684 ;; `xterm-mouse-mode' events must go through `read-key' as they
2685 ;; are decoded via `input-decode-map'.
2686 (if xterm-mouse-mode
2687 (read-key nil
2688 ;; Normally `read-key' discards all mouse button
2689 ;; down events. However, we want them here.
2690 t)
2691 (read-event)))
2692
2597(defvar read-passwd-map 2693(defvar read-passwd-map
2598 ;; BEWARE: `defconst' would purecopy it, breaking the sharing with 2694 ;; BEWARE: `defconst' would purecopy it, breaking the sharing with
2599 ;; minibuffer-local-map along the way! 2695 ;; minibuffer-local-map along the way!
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index ce620821d65..50c00c95320 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -5004,7 +5004,7 @@ The event, EV, is the mouse event."
5004 (setq timer (run-at-time interval interval draw-fn x1 y1)))) 5004 (setq timer (run-at-time interval interval draw-fn x1 y1))))
5005 5005
5006 ;; Read next event 5006 ;; Read next event
5007 (setq ev (read-event)))) 5007 (setq ev (read--potential-mouse-event))))
5008 ;; Cleanup: get rid of any active timer. 5008 ;; Cleanup: get rid of any active timer.
5009 (if timer 5009 (if timer
5010 (cancel-timer timer))) 5010 (cancel-timer timer)))
@@ -5212,7 +5212,7 @@ The event, EV, is the mouse event."
5212 5212
5213 ;; Read next event (only if we should not stop) 5213 ;; Read next event (only if we should not stop)
5214 (if (not done) 5214 (if (not done)
5215 (setq ev (read-event))))) 5215 (setq ev (read--potential-mouse-event)))))
5216 5216
5217 ;; Reverse point-list (last points are cond'ed first) 5217 ;; Reverse point-list (last points are cond'ed first)
5218 (setq point-list (reverse point-list)) 5218 (setq point-list (reverse point-list))
@@ -5339,7 +5339,7 @@ The event, EV, is the mouse event."
5339 5339
5340 5340
5341 ;; Read next event 5341 ;; Read next event
5342 (setq ev (read-event)))) 5342 (setq ev (read--potential-mouse-event))))
5343 5343
5344 ;; If we are not rubber-banding (that is, we were moving around the `2') 5344 ;; If we are not rubber-banding (that is, we were moving around the `2')
5345 ;; draw the shape 5345 ;; draw the shape
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 3346c551d93..6681b03913c 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."
743 743
744 ;; This is the actual filling loop. 744 ;; This is the actual filling loop.
745 (goto-char from) 745 (goto-char from)
746 (let (linebeg) 746 (let ((first t)
747 linebeg)
747 (while (< (point) to) 748 (while (< (point) to)
748 (setq linebeg (point)) 749 ;; On the first line, there may be text in the fill prefix
750 ;; zone. In that case, don't consider that area when
751 ;; trying to find a place to put a line break (bug#45720).
752 (if (not first)
753 (setq linebeg (point))
754 (setq first nil
755 linebeg (+ (point) (length fill-prefix))))
749 (move-to-column (current-fill-column)) 756 (move-to-column (current-fill-column))
750 (if (when (< (point) to) 757 (if (when (< (point) to)
751 ;; Find the position where we'll break the line. 758 ;; Find the position where we'll break the line.
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 073059d52e8..1b29eafabf7 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -900,13 +900,14 @@ DOWNCASE t: Downcase words before using them."
900 ,(concat 900 ,(concat
901 ;; Make sure we search only for optional arguments of 901 ;; Make sure we search only for optional arguments of
902 ;; environments/macros and don't match any other [. ctable 902 ;; environments/macros and don't match any other [. ctable
903 ;; provides a macro called \ctable, listings/breqn have 903 ;; provides a macro called \ctable, beamer/breqn/listings have
904 ;; environments. Start with a backslash and a group for names 904 ;; environments. Start with a backslash and a group for names
905 "\\\\\\(?:" 905 "\\\\\\(?:"
906 ;; begin, optional spaces and opening brace 906 ;; begin, optional spaces and opening brace
907 "begin[[:space:]]*{" 907 "begin[[:space:]]*{"
908 ;; Build a regexp for env names 908 ;; Build a regexp for env names
909 (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup" "darray")) 909 (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup"
910 "darray" "frame"))
910 ;; closing brace, optional spaces 911 ;; closing brace, optional spaces
911 "}[[:space:]]*" 912 "}[[:space:]]*"
912 ;; Now for macros 913 ;; Now for macros
@@ -919,9 +920,9 @@ DOWNCASE t: Downcase words before using them."
919 "\\[[^][]*" 920 "\\[[^][]*"
920 ;; Allow nested levels of chars enclosed in braces 921 ;; Allow nested levels of chars enclosed in braces
921 "\\(?:{[^}{]*" 922 "\\(?:{[^}{]*"
922 "\\(?:{[^}{]*" 923 "\\(?:{[^}{]*"
923 "\\(?:{[^}{]*}[^}{]*\\)*" 924 "\\(?:{[^}{]*}[^}{]*\\)*"
924 "}[^}{]*\\)*" 925 "}[^}{]*\\)*"
925 "}[^][]*\\)*" 926 "}[^][]*\\)*"
926 ;; Match the label key 927 ;; Match the label key
927 "\\<label[[:space:]]*=[[:space:]]*" 928 "\\<label[[:space:]]*=[[:space:]]*"
@@ -935,8 +936,9 @@ The default value matches usual \\label{...} definitions and
935keyval style [..., label = {...}, ...] label definitions. The 936keyval style [..., label = {...}, ...] label definitions. The
936regexp for keyval style explicitly looks for environments 937regexp for keyval style explicitly looks for environments
937provided by the packages \"listings\" (\"lstlisting\"), 938provided by the packages \"listings\" (\"lstlisting\"),
938\"breqn\" (\"dmath\", \"dseries\", \"dgroup\", \"darray\") and 939\"beamer\" (\"frame\"), \"breqn\" (\"dmath\", \"dseries\",
939the macro \"\\ctable\" provided by the package of the same name. 940\"dgroup\", \"darray\") and the macro \"\\ctable\" provided by
941the package of the same name.
940 942
941It is assumed that the regexp group 1 matches the label text, so 943It is assumed that the regexp group 1 matches the label text, so
942you have to define it using \\(?1:...\\) when adding new regexps. 944you 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.
944When changed from Lisp, make sure to call 946When changed from Lisp, make sure to call
945`reftex-compile-variables' afterwards to make the change 947`reftex-compile-variables' afterwards to make the change
946effective." 948effective."
947 :version "27.1" 949 :version "28.1"
948 :set (lambda (symbol value) 950 :set (lambda (symbol value)
949 (set symbol value) 951 (set symbol value)
950 (when (fboundp 'reftex-compile-variables) 952 (when (fboundp 'reftex-compile-variables)
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 72b345874f9..47ef37a19ee 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -262,11 +262,12 @@ keyboard input to go into icons."
262 (let (event) 262 (let (event)
263 (message 263 (message
264 "Select windows by clicking. Please click on Window %d " wind-number) 264 "Select windows by clicking. Please click on Window %d " wind-number)
265 (while (not (ediff-mouse-event-p (setq event (read-event)))) 265 (while (not (ediff-mouse-event-p (setq event
266 (read--potential-mouse-event))))
266 (if (sit-for 1) ; if sequence of events, wait till the final word 267 (if (sit-for 1) ; if sequence of events, wait till the final word
267 (beep 1)) 268 (beep 1))
268 (message "Please click on Window %d " wind-number)) 269 (message "Please click on Window %d " wind-number))
269 (read-event) ; discard event 270 (read--potential-mouse-event) ; discard event
270 (posn-window (event-start event)))) 271 (posn-window (event-start event))))
271 272
272 273
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index e3612dd8e34..ed375738b47 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -939,7 +939,7 @@ arguments after setting up the Ediff buffers."
939;; If WIND-A is nil, use selected window. 939;; If WIND-A is nil, use selected window.
940;; If WIND-B is nil, use window next to WIND-A. 940;; If WIND-B is nil, use window next to WIND-A.
941(defun ediff-windows (dumb-mode wind-A wind-B startup-hooks job-name word-mode) 941(defun ediff-windows (dumb-mode wind-A wind-B startup-hooks job-name word-mode)
942 (if (or dumb-mode (not (ediff-window-display-p))) 942 (if (or dumb-mode (not (display-mouse-p)))
943 (setq wind-A (ediff-get-next-window wind-A nil) 943 (setq wind-A (ediff-get-next-window wind-A nil)
944 wind-B (ediff-get-next-window wind-B wind-A)) 944 wind-B (ediff-get-next-window wind-B wind-A))
945 (setq wind-A (ediff-get-window-by-clicking wind-A nil 1) 945 (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 8b10d71dcb3..7dda04eda21 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1104,7 +1104,7 @@ If nothing was called, return non-nil."
1104 (unless (widget-apply button :mouse-down-action event) 1104 (unless (widget-apply button :mouse-down-action event)
1105 (let ((track-mouse t)) 1105 (let ((track-mouse t))
1106 (while (not (widget-button-release-event-p event)) 1106 (while (not (widget-button-release-event-p event))
1107 (setq event (read-event)) 1107 (setq event (read--potential-mouse-event))
1108 (when (and mouse-1 (mouse-movement-p event)) 1108 (when (and mouse-1 (mouse-movement-p event))
1109 (push event unread-command-events) 1109 (push event unread-command-events)
1110 (setq event oevent) 1110 (setq event oevent)
@@ -1169,7 +1169,7 @@ If nothing was called, return non-nil."
1169 (when up 1169 (when up
1170 ;; Don't execute up events twice. 1170 ;; Don't execute up events twice.
1171 (while (not (widget-button-release-event-p event)) 1171 (while (not (widget-button-release-event-p event))
1172 (setq event (read-event)))) 1172 (setq event (read--potential-mouse-event))))
1173 (when command 1173 (when command
1174 (call-interactively command))))) 1174 (call-interactively command)))))
1175 (message "You clicked somewhere weird."))) 1175 (message "You clicked somewhere weird.")))
@@ -3486,14 +3486,16 @@ It reads a directory name from an editable text field."
3486 :help-echo "C-q: insert KEY, EVENT, or CODE; RET: enter value" 3486 :help-echo "C-q: insert KEY, EVENT, or CODE; RET: enter value"
3487 :tag "Key sequence") 3487 :tag "Key sequence")
3488 3488
3489;; FIXME: Consider combining this with help--read-key-sequence which
3490;; can also read double and triple mouse events.
3489(defun widget-key-sequence-read-event (ev) 3491(defun widget-key-sequence-read-event (ev)
3490 (interactive (list 3492 (interactive (list
3491 (let ((inhibit-quit t) quit-flag) 3493 (let ((inhibit-quit t) quit-flag)
3492 (read-event "Insert KEY, EVENT, or CODE: ")))) 3494 (read-key "Insert KEY, EVENT, or CODE: " t))))
3493 (let ((ev2 (and (memq 'down (event-modifiers ev)) 3495 (let ((ev2 (and (memq 'down (event-modifiers ev))
3494 (read-event))) 3496 (read-key nil t)))
3495 (tr (and (keymapp function-key-map) 3497 (tr (and (keymapp local-function-key-map)
3496 (lookup-key function-key-map (vector ev))))) 3498 (lookup-key local-function-key-map (vector ev)))))
3497 (when (and (integerp ev) 3499 (when (and (integerp ev)
3498 (or (and (<= ?0 ev) (< ev (+ ?0 (min 10 read-quoted-char-radix)))) 3500 (or (and (<= ?0 ev) (< ev (+ ?0 (min 10 read-quoted-char-radix))))
3499 (and (<= ?a (downcase ev)) 3501 (and (<= ?a (downcase ev))
diff --git a/lisp/window.el b/lisp/window.el
index 38be7789062..0a37d16273f 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -1736,9 +1736,11 @@ interpret DELTA as pixels."
1736 (setq window (window-normalize-window window)) 1736 (setq window (window-normalize-window window))
1737 (cond 1737 (cond
1738 ((< delta 0) 1738 ((< delta 0)
1739 (max (- (window-min-size window horizontal ignore pixelwise) 1739 (let ((min-size (window-min-size window horizontal ignore pixelwise))
1740 (window-size window horizontal pixelwise)) 1740 (size (window-size window horizontal pixelwise)))
1741 delta)) 1741 (if (<= size min-size)
1742 0
1743 (max (- min-size size) delta))))
1742 ((> delta 0) 1744 ((> delta 0)
1743 (if (window-size-fixed-p window horizontal ignore) 1745 (if (window-size-fixed-p window horizontal ignore)
1744 0 1746 0
@@ -4116,7 +4118,10 @@ frame can be safely deleted."
4116 frame)) 4118 frame))
4117 (throw 'other t)))) 4119 (throw 'other t))))
4118 (let ((minibuf (active-minibuffer-window))) 4120 (let ((minibuf (active-minibuffer-window)))
4119 (and minibuf (eq frame (window-frame minibuf))))) 4121 (and minibuf (eq frame (window-frame minibuf))
4122 (not (eq (default-toplevel-value
4123 minibuffer-follows-selected-frame)
4124 t)))))
4120 'frame)) 4125 'frame))
4121 ((window-minibuffer-p window) 4126 ((window-minibuffer-p window)
4122 ;; If WINDOW is the minibuffer window of a non-minibuffer-only 4127 ;; If WINDOW is the minibuffer window of a non-minibuffer-only
diff --git a/src/buffer.c b/src/buffer.c
index 71ad5edd527..80c799e719b 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -4785,7 +4785,7 @@ mmap_init (void)
4785 if (mmap_fd <= 0) 4785 if (mmap_fd <= 0)
4786 { 4786 {
4787 /* No anonymous mmap -- we need the file descriptor. */ 4787 /* No anonymous mmap -- we need the file descriptor. */
4788 mmap_fd = emacs_open ("/dev/zero", O_RDONLY, 0); 4788 mmap_fd = emacs_open_noquit ("/dev/zero", O_RDONLY, 0);
4789 if (mmap_fd == -1) 4789 if (mmap_fd == -1)
4790 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno)); 4790 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
4791 } 4791 }
diff --git a/src/callproc.c b/src/callproc.c
index 8d2a5619eb8..cb72b070b7b 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -314,6 +314,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
314#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ 314#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
315 char *tempfile = NULL; 315 char *tempfile = NULL;
316#else 316#else
317 sigset_t oldset;
317 pid_t pid = -1; 318 pid_t pid = -1;
318#endif 319#endif
319 int child_errno; 320 int child_errno;
@@ -601,9 +602,12 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
601 602
602#ifndef MSDOS 603#ifndef MSDOS
603 604
605 block_input ();
606 block_child_signal (&oldset);
607
604 child_errno 608 child_errno
605 = emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env, 609 = emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env,
606 SSDATA (current_dir), NULL); 610 SSDATA (current_dir), NULL, &oldset);
607 eassert ((child_errno == 0) == (0 < pid)); 611 eassert ((child_errno == 0) == (0 < pid));
608 612
609 if (pid > 0) 613 if (pid > 0)
@@ -624,6 +628,9 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
624 } 628 }
625 } 629 }
626 630
631 unblock_child_signal (&oldset);
632 unblock_input ();
633
627 if (pid < 0) 634 if (pid < 0)
628 report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, child_errno); 635 report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, child_errno);
629 636
@@ -1227,17 +1234,21 @@ child_setup (int in, int out, int err, char **new_argv, char **env,
1227 process image file ARGV[0]. Use ENVP for the environment block for 1234 process image file ARGV[0]. Use ENVP for the environment block for
1228 the new process. Use CWD as working directory for the new process. 1235 the new process. Use CWD as working directory for the new process.
1229 If PTY is not NULL, it must be a pseudoterminal device. If PTY is 1236 If PTY is not NULL, it must be a pseudoterminal device. If PTY is
1230 NULL, don't perform any terminal setup. */ 1237 NULL, don't perform any terminal setup. OLDSET must be a pointer
1238 to a signal set initialized by `block_child_signal'. Before
1239 calling this function, call `block_input' and `block_child_signal';
1240 afterwards, call `unblock_input' and `unblock_child_signal'. Be
1241 sure to call `unblock_child_signal' only after registering NEWPID
1242 in a list where `handle_child_signal' can find it! */
1231 1243
1232int 1244int
1233emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, 1245emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
1234 char **argv, char **envp, const char *cwd, const char *pty) 1246 char **argv, char **envp, const char *cwd,
1247 const char *pty, const sigset_t *oldset)
1235{ 1248{
1236 sigset_t oldset;
1237 int pid; 1249 int pid;
1238 1250
1239 block_input (); 1251 eassert (input_blocked_p ());
1240 block_child_signal (&oldset);
1241 1252
1242#ifndef WINDOWSNT 1253#ifndef WINDOWSNT
1243 /* vfork, and prevent local vars from being clobbered by the vfork. */ 1254 /* 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,
1249 int volatile stdout_volatile = std_out; 1260 int volatile stdout_volatile = std_out;
1250 int volatile stderr_volatile = std_err; 1261 int volatile stderr_volatile = std_err;
1251 char **volatile envp_volatile = envp; 1262 char **volatile envp_volatile = envp;
1263 const sigset_t *volatile oldset_volatile = oldset;
1252 1264
1253#ifdef DARWIN_OS 1265#ifdef DARWIN_OS
1254 /* Darwin doesn't let us run setsid after a vfork, so use fork when 1266 /* 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,
1270 std_out = stdout_volatile; 1282 std_out = stdout_volatile;
1271 std_err = stderr_volatile; 1283 std_err = stderr_volatile;
1272 envp = envp_volatile; 1284 envp = envp_volatile;
1285 oldset = oldset_volatile;
1273 1286
1274 if (pid == 0) 1287 if (pid == 0)
1275#endif /* not WINDOWSNT */ 1288#endif /* not WINDOWSNT */
@@ -1323,7 +1336,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
1323 would work? */ 1336 would work? */
1324 if (std_in >= 0) 1337 if (std_in >= 0)
1325 emacs_close (std_in); 1338 emacs_close (std_in);
1326 std_out = std_in = emacs_open (pty, O_RDWR, 0); 1339 std_out = std_in = emacs_open_noquit (pty, O_RDWR, 0);
1327 1340
1328 if (std_in < 0) 1341 if (std_in < 0)
1329 { 1342 {
@@ -1364,7 +1377,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
1364#endif 1377#endif
1365 1378
1366 /* Stop blocking SIGCHLD in the child. */ 1379 /* Stop blocking SIGCHLD in the child. */
1367 unblock_child_signal (&oldset); 1380 unblock_child_signal (oldset);
1368 1381
1369 if (pty_flag) 1382 if (pty_flag)
1370 child_setup_tty (std_out); 1383 child_setup_tty (std_out);
@@ -1382,10 +1395,6 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
1382 1395
1383 int vfork_error = pid < 0 ? errno : 0; 1396 int vfork_error = pid < 0 ? errno : 0;
1384 1397
1385 /* Stop blocking in the parent. */
1386 unblock_child_signal (&oldset);
1387 unblock_input ();
1388
1389 if (pid < 0) 1398 if (pid < 0)
1390 { 1399 {
1391 eassert (0 < vfork_error); 1400 eassert (0 < vfork_error);
diff --git a/src/data.c b/src/data.c
index 3cf5bbbdd56..0dc21c8c2a1 100644
--- a/src/data.c
+++ b/src/data.c
@@ -3834,6 +3834,7 @@ syms_of_data (void)
3834 DEFSYM (Qbuffer_read_only, "buffer-read-only"); 3834 DEFSYM (Qbuffer_read_only, "buffer-read-only");
3835 DEFSYM (Qtext_read_only, "text-read-only"); 3835 DEFSYM (Qtext_read_only, "text-read-only");
3836 DEFSYM (Qmark_inactive, "mark-inactive"); 3836 DEFSYM (Qmark_inactive, "mark-inactive");
3837 DEFSYM (Qinhibited_interaction, "inhibited-interaction");
3837 3838
3838 DEFSYM (Qlistp, "listp"); 3839 DEFSYM (Qlistp, "listp");
3839 DEFSYM (Qconsp, "consp"); 3840 DEFSYM (Qconsp, "consp");
@@ -3918,6 +3919,8 @@ syms_of_data (void)
3918 PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only"); 3919 PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only");
3919 PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail), 3920 PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail),
3920 "Text is read-only"); 3921 "Text is read-only");
3922 PUT_ERROR (Qinhibited_interaction, error_tail,
3923 "User interaction while inhibited");
3921 3924
3922 DEFSYM (Qrange_error, "range-error"); 3925 DEFSYM (Qrange_error, "range-error");
3923 DEFSYM (Qdomain_error, "domain-error"); 3926 DEFSYM (Qdomain_error, "domain-error");
diff --git a/src/dispnew.c b/src/dispnew.c
index 36a6dd8a091..e603c671363 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -6049,7 +6049,14 @@ additional wait period, in milliseconds; this is for backwards compatibility.
6049 READING is true if reading input. 6049 READING is true if reading input.
6050 If DISPLAY_OPTION is >0 display process output while waiting. 6050 If DISPLAY_OPTION is >0 display process output while waiting.
6051 If DISPLAY_OPTION is >1 perform an initial redisplay before waiting. 6051 If DISPLAY_OPTION is >1 perform an initial redisplay before waiting.
6052*/ 6052
6053 Returns a boolean Qt if we waited the full time and returns Qnil if the
6054 wait was interrupted by incoming process output or keyboard events.
6055
6056 FIXME: When `wait_reading_process_output` returns early because of
6057 process output, instead of returning nil we should loop and wait some
6058 more (i.e. until either there's pending input events or the timeout
6059 expired). */
6053 6060
6054Lisp_Object 6061Lisp_Object
6055sit_for (Lisp_Object timeout, bool reading, int display_option) 6062sit_for (Lisp_Object timeout, bool reading, int display_option)
@@ -6110,8 +6117,9 @@ sit_for (Lisp_Object timeout, bool reading, int display_option)
6110 gobble_input (); 6117 gobble_input ();
6111#endif 6118#endif
6112 6119
6113 wait_reading_process_output (sec, nsec, reading ? -1 : 1, do_display, 6120 int nbytes
6114 Qnil, NULL, 0); 6121 = wait_reading_process_output (sec, nsec, reading ? -1 : 1, do_display,
6122 Qnil, NULL, 0);
6115 6123
6116 if (reading && curbuf_eq_winbuf) 6124 if (reading && curbuf_eq_winbuf)
6117 /* Timers and process filters/sentinels may have changed the selected 6125 /* Timers and process filters/sentinels may have changed the selected
@@ -6120,7 +6128,7 @@ sit_for (Lisp_Object timeout, bool reading, int display_option)
6120 buffer to start with). */ 6128 buffer to start with). */
6121 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents)); 6129 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents));
6122 6130
6123 return detect_input_pending () ? Qnil : Qt; 6131 return (nbytes > 0 || detect_input_pending ()) ? Qnil : Qt;
6124} 6132}
6125 6133
6126 6134
diff --git a/src/emacs.c b/src/emacs.c
index 738ef12c98c..c6581bba37e 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1300,7 +1300,7 @@ main (int argc, char **argv)
1300 { 1300 {
1301 emacs_close (STDIN_FILENO); 1301 emacs_close (STDIN_FILENO);
1302 emacs_close (STDOUT_FILENO); 1302 emacs_close (STDOUT_FILENO);
1303 int result = emacs_open (term, O_RDWR, 0); 1303 int result = emacs_open_noquit (term, O_RDWR, 0);
1304 if (result != STDIN_FILENO 1304 if (result != STDIN_FILENO
1305 || (fcntl (STDIN_FILENO, F_DUPFD_CLOEXEC, STDOUT_FILENO) 1305 || (fcntl (STDIN_FILENO, F_DUPFD_CLOEXEC, STDOUT_FILENO)
1306 != STDOUT_FILENO)) 1306 != STDOUT_FILENO))
@@ -2884,7 +2884,7 @@ from the parent process and its tty file descriptors. */)
2884 int nfd; 2884 int nfd;
2885 2885
2886 /* Get rid of stdin, stdout and stderr. */ 2886 /* Get rid of stdin, stdout and stderr. */
2887 nfd = emacs_open ("/dev/null", O_RDWR, 0); 2887 nfd = emacs_open_noquit ("/dev/null", O_RDWR, 0);
2888 err |= nfd < 0; 2888 err |= nfd < 0;
2889 err |= dup2 (nfd, STDIN_FILENO) < 0; 2889 err |= dup2 (nfd, STDIN_FILENO) < 0;
2890 err |= dup2 (nfd, STDOUT_FILENO) < 0; 2890 err |= dup2 (nfd, STDOUT_FILENO) < 0;
diff --git a/src/eval.c b/src/eval.c
index f77f07e1711..cef9407dbfa 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1176,9 +1176,18 @@ Lisp_Object
1176internal_catch (Lisp_Object tag, 1176internal_catch (Lisp_Object tag,
1177 Lisp_Object (*func) (Lisp_Object), Lisp_Object arg) 1177 Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
1178{ 1178{
1179 /* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by
1180 throwing t to tag `exit'.
1181 Value -1 means there is no (throw 'exit t) in progress;
1182 0 means the `throw' wasn't done from an active minibuffer;
1183 N > 0 means the `throw' was done from the minibuffer at level N. */
1184 static EMACS_INT minibuffer_quit_level = -1;
1179 /* This structure is made part of the chain `catchlist'. */ 1185 /* This structure is made part of the chain `catchlist'. */
1180 struct handler *c = push_handler (tag, CATCHER); 1186 struct handler *c = push_handler (tag, CATCHER);
1181 1187
1188 if (EQ (tag, Qexit))
1189 minibuffer_quit_level = -1;
1190
1182 /* Call FUNC. */ 1191 /* Call FUNC. */
1183 if (! sys_setjmp (c->jmp)) 1192 if (! sys_setjmp (c->jmp))
1184 { 1193 {
@@ -1192,6 +1201,23 @@ internal_catch (Lisp_Object tag,
1192 Lisp_Object val = handlerlist->val; 1201 Lisp_Object val = handlerlist->val;
1193 clobbered_eassert (handlerlist == c); 1202 clobbered_eassert (handlerlist == c);
1194 handlerlist = handlerlist->next; 1203 handlerlist = handlerlist->next;
1204 if (EQ (tag, Qexit) && EQ (val, Qt))
1205 /* If we've thrown t to tag `exit' from within a minibuffer, we
1206 exit all minibuffers more deeply nested than the current
1207 one. */
1208 {
1209 EMACS_INT mini_depth = this_minibuffer_depth (Qnil);
1210 if (mini_depth && mini_depth != minibuffer_quit_level)
1211 {
1212 if (minibuffer_quit_level == -1)
1213 minibuffer_quit_level = mini_depth;
1214 if (minibuffer_quit_level
1215 && (minibuf_level > minibuffer_quit_level))
1216 Fthrow (Qexit, Qt);
1217 }
1218 else
1219 minibuffer_quit_level = -1;
1220 }
1195 return val; 1221 return val;
1196 } 1222 }
1197} 1223}
diff --git a/src/fns.c b/src/fns.c
index 5fcc54f0d1f..7ab2e8f1a03 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5548,6 +5548,90 @@ It should not be used for anything security-related. See
5548 return make_digest_string (digest, SHA1_DIGEST_SIZE); 5548 return make_digest_string (digest, SHA1_DIGEST_SIZE);
5549} 5549}
5550 5550
5551DEFUN ("buffer-line-statistics", Fbuffer_line_statistics,
5552 Sbuffer_line_statistics, 0, 1, 0,
5553 doc: /* Return data about lines in BUFFER.
5554The data is returned as a list, and the first element is the number of
5555lines in the buffer, the second is the length of the longest line, and
5556the third is the mean line length. The lengths returned are in bytes, not
5557characters. */ )
5558 (Lisp_Object buffer_or_name)
5559{
5560 Lisp_Object buffer;
5561 ptrdiff_t lines = 0, longest = 0;
5562 double mean = 0;
5563 struct buffer *b;
5564
5565 if (NILP (buffer_or_name))
5566 buffer = Fcurrent_buffer ();
5567 else
5568 buffer = Fget_buffer (buffer_or_name);
5569 if (NILP (buffer))
5570 nsberror (buffer_or_name);
5571
5572 b = XBUFFER (buffer);
5573
5574 unsigned char *start = BUF_BEG_ADDR (b);
5575 ptrdiff_t area = BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b), pre_gap = 0;
5576
5577 /* Process the first part of the buffer. */
5578 while (area > 0)
5579 {
5580 unsigned char *n = memchr (start, '\n', area);
5581
5582 if (n)
5583 {
5584 ptrdiff_t this_line = n - start;
5585 if (this_line > longest)
5586 longest = this_line;
5587 lines++;
5588 /* Blame Knuth. */
5589 mean = mean + (this_line - mean) / lines;
5590 area = area - this_line - 1;
5591 start += this_line + 1;
5592 }
5593 else
5594 {
5595 /* Didn't have a newline here, so save the rest for the
5596 post-gap calculation. */
5597 pre_gap = area;
5598 area = 0;
5599 }
5600 }
5601
5602 /* If the gap is before the end of the buffer, process the last half
5603 of the buffer. */
5604 if (BUF_GPT_BYTE (b) < BUF_Z_BYTE (b))
5605 {
5606 start = BUF_GAP_END_ADDR (b);
5607 area = BUF_Z_ADDR (b) - BUF_GAP_END_ADDR (b);
5608
5609 while (area > 0)
5610 {
5611 unsigned char *n = memchr (start, '\n', area);
5612 ptrdiff_t this_line = n? n - start + pre_gap: area + pre_gap;
5613
5614 if (this_line > longest)
5615 longest = this_line;
5616 lines++;
5617 /* Blame Knuth again. */
5618 mean = mean + (this_line - mean) / lines;
5619 area = area - this_line - 1;
5620 start += this_line + 1;
5621 pre_gap = 0;
5622 }
5623 }
5624 else if (pre_gap > 0)
5625 {
5626 if (pre_gap > longest)
5627 longest = pre_gap;
5628 lines++;
5629 mean = mean + (pre_gap - mean) / lines;
5630 }
5631
5632 return list3 (make_int (lines), make_int (longest), make_float (mean));
5633}
5634
5551static bool 5635static bool
5552string_ascii_p (Lisp_Object string) 5636string_ascii_p (Lisp_Object string)
5553{ 5637{
@@ -5871,4 +5955,5 @@ this variable. */);
5871 defsubr (&Ssecure_hash); 5955 defsubr (&Ssecure_hash);
5872 defsubr (&Sbuffer_hash); 5956 defsubr (&Sbuffer_hash);
5873 defsubr (&Slocale_info); 5957 defsubr (&Slocale_info);
5958 defsubr (&Sbuffer_line_statistics);
5874} 5959}
diff --git a/src/keymap.c b/src/keymap.c
index 1197f6fd4a5..de9b2b58c5e 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1646,39 +1646,6 @@ specified buffer position instead of point are used.
1646 1646
1647/* GC is possible in this function if it autoloads a keymap. */ 1647/* GC is possible in this function if it autoloads a keymap. */
1648 1648
1649DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1650 doc: /* Return the binding for command KEYS in current local keymap only.
1651KEYS is a string or vector, a sequence of keystrokes.
1652The binding is probably a symbol with a function definition.
1653
1654If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1655bindings; see the description of `lookup-key' for more details about this. */)
1656 (Lisp_Object keys, Lisp_Object accept_default)
1657{
1658 register Lisp_Object map = BVAR (current_buffer, keymap);
1659 if (NILP (map))
1660 return Qnil;
1661 return Flookup_key (map, keys, accept_default);
1662}
1663
1664/* GC is possible in this function if it autoloads a keymap. */
1665
1666DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1667 doc: /* Return the binding for command KEYS in current global keymap only.
1668KEYS is a string or vector, a sequence of keystrokes.
1669The binding is probably a symbol with a function definition.
1670This function's return values are the same as those of `lookup-key'
1671\(which see).
1672
1673If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1674bindings; see the description of `lookup-key' for more details about this. */)
1675 (Lisp_Object keys, Lisp_Object accept_default)
1676{
1677 return Flookup_key (current_global_map, keys, accept_default);
1678}
1679
1680/* GC is possible in this function if it autoloads a keymap. */
1681
1682DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0, 1649DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1683 doc: /* Find the visible minor mode bindings of KEY. 1650 doc: /* Find the visible minor mode bindings of KEY.
1684Return an alist of pairs (MODENAME . BINDING), where MODENAME is 1651Return an alist of pairs (MODENAME . BINDING), where MODENAME is
@@ -3253,8 +3220,6 @@ be preferred. */);
3253 defsubr (&Scopy_keymap); 3220 defsubr (&Scopy_keymap);
3254 defsubr (&Scommand_remapping); 3221 defsubr (&Scommand_remapping);
3255 defsubr (&Skey_binding); 3222 defsubr (&Skey_binding);
3256 defsubr (&Slocal_key_binding);
3257 defsubr (&Sglobal_key_binding);
3258 defsubr (&Sminor_mode_key_binding); 3223 defsubr (&Sminor_mode_key_binding);
3259 defsubr (&Sdefine_key); 3224 defsubr (&Sdefine_key);
3260 defsubr (&Slookup_key); 3225 defsubr (&Slookup_key);
diff --git a/src/lisp.h b/src/lisp.h
index b6182c37eed..296f9af7337 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4368,9 +4368,12 @@ extern Lisp_Object Vminibuffer_list;
4368extern Lisp_Object last_minibuf_string; 4368extern Lisp_Object last_minibuf_string;
4369extern void move_minibuffer_onto_frame (void); 4369extern void move_minibuffer_onto_frame (void);
4370extern bool is_minibuffer (EMACS_INT, Lisp_Object); 4370extern bool is_minibuffer (EMACS_INT, Lisp_Object);
4371extern EMACS_INT this_minibuffer_depth (Lisp_Object);
4372extern EMACS_INT minibuf_level;
4371extern Lisp_Object get_minibuffer (EMACS_INT); 4373extern Lisp_Object get_minibuffer (EMACS_INT);
4372extern void init_minibuf_once (void); 4374extern void init_minibuf_once (void);
4373extern void syms_of_minibuf (void); 4375extern void syms_of_minibuf (void);
4376extern void barf_if_interaction_inhibited (void);
4374 4377
4375/* Defined in callint.c. */ 4378/* Defined in callint.c. */
4376 4379
@@ -4518,8 +4521,8 @@ extern void setup_process_coding_systems (Lisp_Object);
4518# define CHILD_SETUP_ERROR_DESC "Doing vfork" 4521# define CHILD_SETUP_ERROR_DESC "Doing vfork"
4519#endif 4522#endif
4520 4523
4521extern int emacs_spawn (pid_t *, int, int, int, char **, char **, const char *, 4524extern int emacs_spawn (pid_t *, int, int, int, char **, char **,
4522 const char *); 4525 const char *, const char *, const sigset_t *);
4523extern char **make_environment_block (Lisp_Object); 4526extern char **make_environment_block (Lisp_Object);
4524extern void init_callproc_1 (void); 4527extern void init_callproc_1 (void);
4525extern void init_callproc (void); 4528extern void init_callproc (void);
@@ -4598,6 +4601,7 @@ extern AVOID emacs_abort (void) NO_INLINE;
4598extern int emacs_fstatat (int, char const *, void *, int); 4601extern int emacs_fstatat (int, char const *, void *, int);
4599extern int emacs_openat (int, char const *, int, int); 4602extern int emacs_openat (int, char const *, int, int);
4600extern int emacs_open (const char *, int, int); 4603extern int emacs_open (const char *, int, int);
4604extern int emacs_open_noquit (const char *, int, int);
4601extern int emacs_pipe (int[2]); 4605extern int emacs_pipe (int[2]);
4602extern int emacs_close (int); 4606extern int emacs_close (int);
4603extern ptrdiff_t emacs_read (int, void *, ptrdiff_t); 4607extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);
diff --git a/src/lread.c b/src/lread.c
index e308fa88699..4cf4f8cde9b 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -767,11 +767,16 @@ is used for reading a character.
767If the optional argument SECONDS is non-nil, it should be a number 767If the optional argument SECONDS is non-nil, it should be a number
768specifying the maximum number of seconds to wait for input. If no 768specifying the maximum number of seconds to wait for input. If no
769input arrives in that time, return nil. SECONDS may be a 769input arrives in that time, return nil. SECONDS may be a
770floating-point value. */) 770floating-point value.
771
772If `inhibit-interaction' is non-nil, this function will signal an
773`inhibited-interaction' error. */)
771 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds) 774 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
772{ 775{
773 Lisp_Object val; 776 Lisp_Object val;
774 777
778 barf_if_interaction_inhibited ();
779
775 if (! NILP (prompt)) 780 if (! NILP (prompt))
776 message_with_string ("%s", prompt, 0); 781 message_with_string ("%s", prompt, 0);
777 val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds); 782 val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
@@ -782,6 +787,12 @@ floating-point value. */)
782 787
783DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0, 788DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
784 doc: /* Read an event object from the input stream. 789 doc: /* Read an event object from the input stream.
790
791If you want to read non-character events, consider calling `read-key'
792instead. `read-key' will decode events via `input-decode-map' that
793`read-event' will not. On a terminal this includes function keys such
794as <F7> and <RIGHT>, or mouse events generated by `xterm-mouse-mode'.
795
785If the optional argument PROMPT is non-nil, display that as a prompt. 796If the optional argument PROMPT is non-nil, display that as a prompt.
786If PROMPT is nil or the string \"\", the key sequence/events that led 797If PROMPT is nil or the string \"\", the key sequence/events that led
787to the current command is used as the prompt. 798to the current command is used as the prompt.
@@ -793,9 +804,14 @@ is used for reading a character.
793If the optional argument SECONDS is non-nil, it should be a number 804If the optional argument SECONDS is non-nil, it should be a number
794specifying the maximum number of seconds to wait for input. If no 805specifying the maximum number of seconds to wait for input. If no
795input arrives in that time, return nil. SECONDS may be a 806input arrives in that time, return nil. SECONDS may be a
796floating-point value. */) 807floating-point value.
808
809If `inhibit-interaction' is non-nil, this function will signal an
810`inhibited-interaction' error. */)
797 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds) 811 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
798{ 812{
813 barf_if_interaction_inhibited ();
814
799 if (! NILP (prompt)) 815 if (! NILP (prompt))
800 message_with_string ("%s", prompt, 0); 816 message_with_string ("%s", prompt, 0);
801 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds); 817 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
@@ -822,11 +838,16 @@ is used for reading a character.
822If the optional argument SECONDS is non-nil, it should be a number 838If the optional argument SECONDS is non-nil, it should be a number
823specifying the maximum number of seconds to wait for input. If no 839specifying the maximum number of seconds to wait for input. If no
824input arrives in that time, return nil. SECONDS may be a 840input arrives in that time, return nil. SECONDS may be a
825floating-point value. */) 841floating-point value.
826 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds) 842
843If `inhibit-interaction' is non-nil, this function will signal an
844`inhibited-interaction' error. */)
845(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
827{ 846{
828 Lisp_Object val; 847 Lisp_Object val;
829 848
849 barf_if_interaction_inhibited ();
850
830 if (! NILP (prompt)) 851 if (! NILP (prompt))
831 message_with_string ("%s", prompt, 0); 852 message_with_string ("%s", prompt, 0);
832 853
diff --git a/src/minibuf.c b/src/minibuf.c
index 5ee440f6622..5df10453739 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -63,10 +63,31 @@ static Lisp_Object minibuf_prompt;
63 63
64static ptrdiff_t minibuf_prompt_width; 64static ptrdiff_t minibuf_prompt_width;
65 65
66static Lisp_Object nth_minibuffer (EMACS_INT depth);
67
66 68
69/* Return TRUE when a frame switch causes a minibuffer on the old
70 frame to move onto the new one. */
67static bool 71static bool
68minibuf_follows_frame (void) 72minibuf_follows_frame (void)
69{ 73{
74 return EQ (Fdefault_toplevel_value (Qminibuffer_follows_selected_frame),
75 Qt);
76}
77
78/* Return TRUE when a minibuffer always remains on the frame where it
79 was first invoked. */
80static bool
81minibuf_stays_put (void)
82{
83 return NILP (Fdefault_toplevel_value (Qminibuffer_follows_selected_frame));
84}
85
86/* Return TRUE when opening a (recursive) minibuffer causes
87 minibuffers on other frames to move to the selected frame. */
88static bool
89minibuf_moves_frame_when_opened (void)
90{
70 return !NILP (Fdefault_toplevel_value (Qminibuffer_follows_selected_frame)); 91 return !NILP (Fdefault_toplevel_value (Qminibuffer_follows_selected_frame));
71} 92}
72 93
@@ -90,7 +111,7 @@ choose_minibuf_frame (void)
90 minibuf_window = sf->minibuffer_window; 111 minibuf_window = sf->minibuffer_window;
91 /* If we've still got another minibuffer open, use its mini-window 112 /* If we've still got another minibuffer open, use its mini-window
92 instead. */ 113 instead. */
93 if (minibuf_level && !minibuf_follows_frame ()) 114 if (minibuf_level > 1 && minibuf_stays_put ())
94 { 115 {
95 Lisp_Object buffer = get_minibuffer (minibuf_level); 116 Lisp_Object buffer = get_minibuffer (minibuf_level);
96 Lisp_Object tail, frame; 117 Lisp_Object tail, frame;
@@ -105,26 +126,40 @@ choose_minibuf_frame (void)
105 } 126 }
106 } 127 }
107 128
108 if (minibuf_follows_frame ()) 129 if (minibuf_moves_frame_when_opened ()
130 && FRAMEP (selected_frame)
131 && FRAME_LIVE_P (XFRAME (selected_frame)))
109 /* Make sure no other frame has a minibuffer as its selected window, 132 /* Make sure no other frame has a minibuffer as its selected window,
110 because the text would not be displayed in it, and that would be 133 because the text would not be displayed in it, and that would be
111 confusing. Only allow the selected frame to do this, 134 confusing. Only allow the selected frame to do this,
112 and that only if the minibuffer is active. */ 135 and that only if the minibuffer is active. */
113 { 136 {
114 Lisp_Object tail, frame; 137 Lisp_Object tail, frame;
115 138 struct frame *of;
116 FOR_EACH_FRAME (tail, frame) 139
117 if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (XFRAME (frame)))) 140 FOR_EACH_FRAME (tail, frame)
118 && !(EQ (frame, selected_frame) 141 if (!EQ (frame, selected_frame)
119 && minibuf_level > 0)) 142 && minibuf_level > 1
120 Fset_frame_selected_window (frame, Fframe_first_window (frame), 143 /* The frame's minibuffer can be on a different frame. */
121 Qnil); 144 && ! EQ (XWINDOW ((of = XFRAME (frame))->minibuffer_window)->frame,
122 } 145 selected_frame))
146 {
147 if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (of))))
148 Fset_frame_selected_window (frame, Fframe_first_window (frame),
149 Qnil);
150
151 if (!EQ (XWINDOW (of->minibuffer_window)->contents,
152 nth_minibuffer (0)))
153 set_window_buffer (of->minibuffer_window,
154 nth_minibuffer (0), 0, 0);
155 }
156 }
123} 157}
124 158
125/* If `minibuffer_follows_selected_frame' and we have a minibuffer, move it 159/* If `minibuffer_follows_selected_frame' is t and we have a
126 from its current frame to the selected frame. This function is 160 minibuffer, move it from its current frame to the selected frame.
127 intended to be called from `do_switch_frame' in frame.c. */ 161 This function is intended to be called from `do_switch_frame' in
162 frame.c. */
128void move_minibuffer_onto_frame (void) 163void move_minibuffer_onto_frame (void)
129{ 164{
130 if (!minibuf_level) 165 if (!minibuf_level)
@@ -135,14 +170,18 @@ void move_minibuffer_onto_frame (void)
135 && FRAME_LIVE_P (XFRAME (selected_frame)) 170 && FRAME_LIVE_P (XFRAME (selected_frame))
136 && !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window)) 171 && !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window))
137 { 172 {
173 EMACS_INT i;
138 struct frame *sf = XFRAME (selected_frame); 174 struct frame *sf = XFRAME (selected_frame);
139 Lisp_Object old_frame = XWINDOW (minibuf_window)->frame; 175 Lisp_Object old_frame = XWINDOW (minibuf_window)->frame;
140 struct frame *of = XFRAME (old_frame); 176 struct frame *of = XFRAME (old_frame);
141 Lisp_Object buffer = XWINDOW (minibuf_window)->contents;
142 177
143 set_window_buffer (sf->minibuffer_window, buffer, 0, 0); 178 /* Stack up all the (recursively) open minibuffers on the selected
179 mini_window. */
180 for (i = 1; i <= minibuf_level; i++)
181 set_window_buffer (sf->minibuffer_window, nth_minibuffer (i), 0, 0);
144 minibuf_window = sf->minibuffer_window; 182 minibuf_window = sf->minibuffer_window;
145 set_window_buffer (of->minibuffer_window, get_minibuffer (0), 0, 0); 183 if (of != sf)
184 set_window_buffer (of->minibuffer_window, get_minibuffer (0), 0, 0);
146 } 185 }
147} 186}
148 187
@@ -336,6 +375,63 @@ return t only if BUFFER is an active minibuffer. */)
336 ? Qt : Qnil; 375 ? Qt : Qnil;
337} 376}
338 377
378DEFUN ("innermost-minibuffer-p", Finnermost_minibuffer_p,
379 Sinnermost_minibuffer_p, 0, 1, 0,
380 doc: /* Return t if BUFFER is the most nested active minibuffer.
381No argument or nil as argument means use the current buffer as BUFFER. */)
382 (Lisp_Object buffer)
383{
384 if (NILP (buffer))
385 buffer = Fcurrent_buffer ();
386 return EQ (buffer, (Fcar (Fnthcdr (make_fixnum (minibuf_level),
387 Vminibuffer_list))))
388 ? Qt
389 : Qnil;
390}
391
392/* Return the nesting depth of the active minibuffer BUFFER, or 0 if
393 BUFFER isn't such a thing. If BUFFER is nil, this means use the current
394 buffer. */
395EMACS_INT
396this_minibuffer_depth (Lisp_Object buffer)
397{
398 EMACS_INT i;
399 Lisp_Object bufs;
400
401 if (NILP (buffer))
402 buffer = Fcurrent_buffer ();
403 for (i = 1, bufs = Fcdr (Vminibuffer_list);
404 i <= minibuf_level;
405 i++, bufs = Fcdr (bufs))
406 if (EQ (Fcar (bufs), buffer))
407 return i;
408 return 0;
409}
410
411DEFUN ("abort-minibuffers", Fabort_minibuffers, Sabort_minibuffers, 0, 0, "",
412 doc: /* Abort the current minibuffer.
413If we are not currently in the innermost minibuffer, prompt the user to
414confirm the aborting of the current minibuffer and all contained ones. */)
415 (void)
416{
417 EMACS_INT minibuf_depth = this_minibuffer_depth (Qnil);
418 Lisp_Object array[2];
419 AUTO_STRING (fmt, "Abort %s minibuffer levels? ");
420
421 if (!minibuf_depth)
422 error ("Not in a minibuffer");
423 if (minibuf_depth < minibuf_level)
424 {
425 array[0] = fmt;
426 array[1] = make_fixnum (minibuf_level - minibuf_depth + 1);
427 if (!NILP (Fyes_or_no_p (Fformat (2, array))))
428 Fthrow (Qexit, Qt);
429 }
430 else
431 Fthrow (Qexit, Qt);
432 return Qnil;
433}
434
339DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end, 435DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end,
340 Sminibuffer_prompt_end, 0, 0, 0, 436 Sminibuffer_prompt_end, 0, 0, 0,
341 doc: /* Return the buffer position of the end of the minibuffer prompt. 437 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,
411 Lisp_Object val; 507 Lisp_Object val;
412 ptrdiff_t count = SPECPDL_INDEX (); 508 ptrdiff_t count = SPECPDL_INDEX ();
413 Lisp_Object mini_frame, ambient_dir, minibuffer, input_method; 509 Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
510 Lisp_Object calling_frame = selected_frame;
414 Lisp_Object enable_multibyte; 511 Lisp_Object enable_multibyte;
415 EMACS_INT pos = 0; 512 EMACS_INT pos = 0;
416 /* String to add to the history. */ 513 /* String to add to the history. */
@@ -648,6 +745,17 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
648 } 745 }
649 } 746 }
650 747
748 if (minibuf_moves_frame_when_opened ())
749 {
750 EMACS_INT i;
751
752 /* Stack up all the (recursively) open minibuffers on the selected
753 mini_window. */
754 for (i = 1; i < minibuf_level; i++)
755 set_window_buffer (XFRAME (mini_frame)->minibuffer_window,
756 nth_minibuffer (i), 0, 0);
757 }
758
651 /* Display this minibuffer in the proper window. */ 759 /* Display this minibuffer in the proper window. */
652 /* Use set_window_buffer instead of Fset_window_buffer (see 760 /* Use set_window_buffer instead of Fset_window_buffer (see
653 discussion of bug#11984, bug#12025, bug#12026). */ 761 discussion of bug#11984, bug#12025, bug#12026). */
@@ -729,6 +837,20 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
729 837
730 recursive_edit_1 (); 838 recursive_edit_1 ();
731 839
840 /* We've exited the recursive edit without an error, so switch the
841 current window away from the expired minibuffer window. */
842 {
843 Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil);
844 /* PREV can be on a different frame when we have a minibuffer only
845 frame, the other frame's minibuffer window is MINIBUF_WINDOW,
846 and its "focus window" is also MINIBUF_WINDOW. */
847 while (!EQ (prev, minibuf_window)
848 && !EQ (selected_frame, WINDOW_FRAME (XWINDOW (prev))))
849 prev = Fprevious_window (prev, Qnil, Qnil);
850 if (!EQ (prev, minibuf_window))
851 Fset_frame_selected_window (selected_frame, prev, Qnil);
852 }
853
732 /* If cursor is on the minibuffer line, 854 /* If cursor is on the minibuffer line,
733 show the user we have exited by putting it in column 0. */ 855 show the user we have exited by putting it in column 0. */
734 if (XWINDOW (minibuf_window)->cursor.vpos >= 0 856 if (XWINDOW (minibuf_window)->cursor.vpos >= 0
@@ -767,6 +889,12 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
767 in set-window-configuration. */ 889 in set-window-configuration. */
768 unbind_to (count, Qnil); 890 unbind_to (count, Qnil);
769 891
892 /* Switch the frame back to the calling frame. */
893 if (!EQ (selected_frame, calling_frame)
894 && FRAMEP (calling_frame)
895 && FRAME_LIVE_P (XFRAME (calling_frame)))
896 call2 (intern ("select-frame-set-input-focus"), calling_frame, Qnil);
897
770 /* Add the value to the appropriate history list, if any. This is 898 /* Add the value to the appropriate history list, if any. This is
771 done after the previous buffer has been made current again, in 899 done after the previous buffer has been made current again, in
772 case the history variable is buffer-local. */ 900 case the history variable is buffer-local. */
@@ -790,6 +918,14 @@ is_minibuffer (EMACS_INT depth, Lisp_Object buf)
790 && EQ (Fcar (tail), buf); 918 && EQ (Fcar (tail), buf);
791} 919}
792 920
921/* Return the DEPTHth minibuffer, or nil if such does not yet exist. */
922static Lisp_Object
923nth_minibuffer (EMACS_INT depth)
924{
925 Lisp_Object tail = Fnthcdr (make_fixnum (depth), Vminibuffer_list);
926 return XCAR (tail);
927}
928
793/* Return a buffer to be used as the minibuffer at depth `depth'. 929/* Return a buffer to be used as the minibuffer at depth `depth'.
794 depth = 0 is the lowest allowed argument, and that is the value 930 depth = 0 is the lowest allowed argument, and that is the value
795 used for nonrecursive minibuffer invocations. */ 931 used for nonrecursive minibuffer invocations. */
@@ -939,6 +1075,13 @@ read_minibuf_unwind (void)
939} 1075}
940 1076
941 1077
1078void
1079barf_if_interaction_inhibited (void)
1080{
1081 if (inhibit_interaction)
1082 xsignal0 (Qinhibited_interaction);
1083}
1084
942DEFUN ("read-from-minibuffer", Fread_from_minibuffer, 1085DEFUN ("read-from-minibuffer", Fread_from_minibuffer,
943 Sread_from_minibuffer, 1, 7, 0, 1086 Sread_from_minibuffer, 1, 7, 0,
944 doc: /* Read a string from the minibuffer, prompting with string PROMPT. 1087 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,
983 then the string which is returned includes whatever text properties 1126 then the string which is returned includes whatever text properties
984 were present in the minibuffer. Otherwise the value has no text properties. 1127 were present in the minibuffer. Otherwise the value has no text properties.
985 1128
1129If `inhibit-interaction' is non-nil, this function will signal an
1130 `inhibited-interaction' error.
1131
986The remainder of this documentation string describes the 1132The remainder of this documentation string describes the
987INITIAL-CONTENTS argument in more detail. It is only relevant when 1133INITIAL-CONTENTS argument in more detail. It is only relevant when
988studying existing code, or when HIST is a cons. If non-nil, 1134studying 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. */)
998{ 1144{
999 Lisp_Object histvar, histpos, val; 1145 Lisp_Object histvar, histpos, val;
1000 1146
1147 barf_if_interaction_inhibited ();
1148
1001 CHECK_STRING (prompt); 1149 CHECK_STRING (prompt);
1002 if (NILP (keymap)) 1150 if (NILP (keymap))
1003 keymap = Vminibuffer_local_map; 1151 keymap = Vminibuffer_local_map;
@@ -1071,11 +1219,17 @@ point positioned at the end, so that SPACE will accept the input.
1071\(Actually, INITIAL can also be a cons of a string and an integer. 1219\(Actually, INITIAL can also be a cons of a string and an integer.
1072Such values are treated as in `read-from-minibuffer', but are normally 1220Such values are treated as in `read-from-minibuffer', but are normally
1073not useful in this function.) 1221not useful in this function.)
1222
1074Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits 1223Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1075the current input method and the setting of`enable-multibyte-characters'. */) 1224the current input method and the setting of`enable-multibyte-characters'.
1225
1226If `inhibit-interaction' is non-nil, this function will signal an
1227`inhibited-interaction' error. */)
1076 (Lisp_Object prompt, Lisp_Object initial, Lisp_Object inherit_input_method) 1228 (Lisp_Object prompt, Lisp_Object initial, Lisp_Object inherit_input_method)
1077{ 1229{
1078 CHECK_STRING (prompt); 1230 CHECK_STRING (prompt);
1231 barf_if_interaction_inhibited ();
1232
1079 return read_minibuf (Vminibuffer_local_ns_map, initial, prompt, 1233 return read_minibuf (Vminibuffer_local_ns_map, initial, prompt,
1080 0, Qminibuffer_history, make_fixnum (0), Qnil, 0, 1234 0, Qminibuffer_history, make_fixnum (0), Qnil, 0,
1081 !NILP (inherit_input_method)); 1235 !NILP (inherit_input_method));
@@ -2032,13 +2186,15 @@ For example, `eval-expression' uses this. */);
2032The function is called with the arguments passed to `read-buffer'. */); 2186The function is called with the arguments passed to `read-buffer'. */);
2033 Vread_buffer_function = Qnil; 2187 Vread_buffer_function = Qnil;
2034 2188
2035 DEFVAR_BOOL ("minibuffer-follows-selected-frame", minibuffer_follows_selected_frame, 2189 DEFVAR_LISP ("minibuffer-follows-selected-frame", minibuffer_follows_selected_frame,
2036 doc: /* Non-nil means the active minibuffer always displays on the selected frame. 2190 doc: /* t means the active minibuffer always displays on the selected frame.
2037Nil means that a minibuffer will appear only in the frame which created it. 2191Nil means that a minibuffer will appear only in the frame which created it.
2192Any other value means the minibuffer will move onto another frame, but
2193only when the user starts using a minibuffer there.
2038 2194
2039Any buffer local or dynamic binding of this variable is ignored. Only the 2195Any buffer local or dynamic binding of this variable is ignored. Only the
2040default top level value is used. */); 2196default top level value is used. */);
2041 minibuffer_follows_selected_frame = 1; 2197 minibuffer_follows_selected_frame = Qt;
2042 2198
2043 DEFVAR_BOOL ("read-buffer-completion-ignore-case", 2199 DEFVAR_BOOL ("read-buffer-completion-ignore-case",
2044 read_buffer_completion_ignore_case, 2200 read_buffer_completion_ignore_case,
@@ -2183,6 +2339,15 @@ This variable also overrides the default character that `read-passwd'
2183uses to hide passwords. */); 2339uses to hide passwords. */);
2184 Vread_hide_char = Qnil; 2340 Vread_hide_char = Qnil;
2185 2341
2342 DEFVAR_BOOL ("inhibit-interaction",
2343 inhibit_interaction,
2344 doc: /* Non-nil means any user interaction will signal an error.
2345This variable can be bound when user interaction can't be performed,
2346for instance when running a headless Emacs server. Functions like
2347`read-from-minibuffer' (and the like) will signal `inhibited-interaction'
2348instead. */);
2349 inhibit_interaction = 0;
2350
2186 defsubr (&Sactive_minibuffer_window); 2351 defsubr (&Sactive_minibuffer_window);
2187 defsubr (&Sset_minibuffer_window); 2352 defsubr (&Sset_minibuffer_window);
2188 defsubr (&Sread_from_minibuffer); 2353 defsubr (&Sread_from_minibuffer);
@@ -2196,6 +2361,8 @@ uses to hide passwords. */);
2196 defsubr (&Sminibuffer_prompt); 2361 defsubr (&Sminibuffer_prompt);
2197 2362
2198 defsubr (&Sminibufferp); 2363 defsubr (&Sminibufferp);
2364 defsubr (&Sinnermost_minibuffer_p);
2365 defsubr (&Sabort_minibuffers);
2199 defsubr (&Sminibuffer_prompt_end); 2366 defsubr (&Sminibuffer_prompt_end);
2200 defsubr (&Sminibuffer_contents); 2367 defsubr (&Sminibuffer_contents);
2201 defsubr (&Sminibuffer_contents_no_properties); 2368 defsubr (&Sminibuffer_contents_no_properties);
diff --git a/src/pdumper.c b/src/pdumper.c
index 7eefcc83fda..f0711078a5a 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)
5460 eassert (!dump_loaded_p ()); 5460 eassert (!dump_loaded_p ());
5461 5461
5462 int err; 5462 int err;
5463 int dump_fd = emacs_open (dump_filename, O_RDONLY, 0); 5463 int dump_fd = emacs_open_noquit (dump_filename, O_RDONLY, 0);
5464 if (dump_fd < 0) 5464 if (dump_fd < 0)
5465 { 5465 {
5466 err = (errno == ENOENT || errno == ENOTDIR 5466 err = (errno == ENOENT || errno == ENOTDIR
diff --git a/src/process.c b/src/process.c
index 06d750d3368..dac7d0440fa 100644
--- a/src/process.c
+++ b/src/process.c
@@ -692,8 +692,7 @@ status_convert (int w)
692 if (WIFSTOPPED (w)) 692 if (WIFSTOPPED (w))
693 return Fcons (Qstop, Fcons (make_fixnum (WSTOPSIG (w)), Qnil)); 693 return Fcons (Qstop, Fcons (make_fixnum (WSTOPSIG (w)), Qnil));
694 else if (WIFEXITED (w)) 694 else if (WIFEXITED (w))
695 return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)), 695 return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)), Qnil));
696 WCOREDUMP (w) ? Qt : Qnil));
697 else if (WIFSIGNALED (w)) 696 else if (WIFSIGNALED (w))
698 return Fcons (Qsignal, Fcons (make_fixnum (WTERMSIG (w)), 697 return Fcons (Qsignal, Fcons (make_fixnum (WTERMSIG (w)),
699 WCOREDUMP (w) ? Qt : Qnil)); 698 WCOREDUMP (w) ? Qt : Qnil));
@@ -2059,6 +2058,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
2059 bool pty_flag = 0; 2058 bool pty_flag = 0;
2060 char pty_name[PTY_NAME_SIZE]; 2059 char pty_name[PTY_NAME_SIZE];
2061 Lisp_Object lisp_pty_name = Qnil; 2060 Lisp_Object lisp_pty_name = Qnil;
2061 sigset_t oldset;
2062 2062
2063 inchannel = outchannel = -1; 2063 inchannel = outchannel = -1;
2064 2064
@@ -2139,13 +2139,16 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
2139 setup_process_coding_systems (process); 2139 setup_process_coding_systems (process);
2140 char **env = make_environment_block (current_dir); 2140 char **env = make_environment_block (current_dir);
2141 2141
2142 block_input ();
2143 block_child_signal (&oldset);
2144
2142 pty_flag = p->pty_flag; 2145 pty_flag = p->pty_flag;
2143 eassert (pty_flag == ! NILP (lisp_pty_name)); 2146 eassert (pty_flag == ! NILP (lisp_pty_name));
2144 2147
2145 vfork_errno 2148 vfork_errno
2146 = emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env, 2149 = emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env,
2147 SSDATA (current_dir), 2150 SSDATA (current_dir),
2148 pty_flag ? SSDATA (lisp_pty_name) : NULL); 2151 pty_flag ? SSDATA (lisp_pty_name) : NULL, &oldset);
2149 2152
2150 eassert ((vfork_errno == 0) == (0 < pid)); 2153 eassert ((vfork_errno == 0) == (0 < pid));
2151 2154
@@ -2153,6 +2156,10 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
2153 if (pid >= 0) 2156 if (pid >= 0)
2154 p->alive = 1; 2157 p->alive = 1;
2155 2158
2159 /* Stop blocking in the parent. */
2160 unblock_child_signal (&oldset);
2161 unblock_input ();
2162
2156 /* Environment block no longer needed. */ 2163 /* Environment block no longer needed. */
2157 unbind_to (count, Qnil); 2164 unbind_to (count, Qnil);
2158 2165
diff --git a/src/sysdep.c b/src/sysdep.c
index 6ede06b1aa3..941b4e2fa24 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/>. */
53# include <sys/sysctl.h> 53# include <sys/sysctl.h>
54#endif 54#endif
55 55
56#if defined __OpenBSD__
57# include <sys/proc.h>
58#endif
59
56#ifdef DARWIN_OS 60#ifdef DARWIN_OS
57# include <libproc.h> 61# include <libproc.h>
58#endif 62#endif
@@ -2316,6 +2320,28 @@ emacs_open (char const *file, int oflags, int mode)
2316 return emacs_openat (AT_FDCWD, file, oflags, mode); 2320 return emacs_openat (AT_FDCWD, file, oflags, mode);
2317} 2321}
2318 2322
2323/* Same as above, but doesn't allow the user to quit. */
2324
2325static int
2326emacs_openat_noquit (int dirfd, const char *file, int oflags,
2327 int mode)
2328{
2329 int fd;
2330 if (! (oflags & O_TEXT))
2331 oflags |= O_BINARY;
2332 oflags |= O_CLOEXEC;
2333 do
2334 fd = openat (dirfd, file, oflags, mode);
2335 while (fd < 0 && errno == EINTR);
2336 return fd;
2337}
2338
2339int
2340emacs_open_noquit (char const *file, int oflags, int mode)
2341{
2342 return emacs_openat_noquit (AT_FDCWD, file, oflags, mode);
2343}
2344
2319/* Open FILE as a stream for Emacs use, with mode MODE. 2345/* Open FILE as a stream for Emacs use, with mode MODE.
2320 Act like emacs_open with respect to threads, signals, and quits. */ 2346 Act like emacs_open with respect to threads, signals, and quits. */
2321 2347
@@ -2972,6 +2998,14 @@ make_lisp_timeval (struct timeval t)
2972 return make_lisp_time (timeval_to_timespec (t)); 2998 return make_lisp_time (timeval_to_timespec (t));
2973} 2999}
2974 3000
3001#elif defined __OpenBSD__
3002
3003static Lisp_Object
3004make_lisp_timeval (long sec, long usec)
3005{
3006 return make_lisp_time(make_timespec(sec, usec * 1000));
3007}
3008
2975#endif 3009#endif
2976 3010
2977#ifdef GNU_LINUX 3011#ifdef GNU_LINUX
@@ -3661,6 +3695,189 @@ system_process_attributes (Lisp_Object pid)
3661 return attrs; 3695 return attrs;
3662} 3696}
3663 3697
3698#elif defined __OpenBSD__
3699
3700Lisp_Object
3701system_process_attributes (Lisp_Object pid)
3702{
3703 int proc_id, nentries, fscale, i;
3704 int pagesize = getpagesize ();
3705 int mib[6];
3706 size_t len;
3707 double pct;
3708 char *ttyname, args[ARG_MAX];
3709 struct kinfo_proc proc;
3710 struct passwd *pw;
3711 struct group *gr;
3712 struct timespec t;
3713 struct uvmexp uvmexp;
3714
3715 Lisp_Object attrs = Qnil;
3716 Lisp_Object decoded_comm;
3717
3718 CHECK_NUMBER (pid);
3719 CONS_TO_INTEGER (pid, int, proc_id);
3720
3721 len = sizeof proc;
3722 mib[0] = CTL_KERN;
3723 mib[1] = KERN_PROC;
3724 mib[2] = KERN_PROC_PID;
3725 mib[3] = proc_id;
3726 mib[4] = len;
3727 mib[5] = 1;
3728 if (sysctl (mib, 6, &proc, &len, NULL, 0) != 0)
3729 return attrs;
3730
3731 attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (proc.p_uid)), attrs);
3732
3733 block_input ();
3734 pw = getpwuid (proc.p_uid);
3735 unblock_input ();
3736 if (pw)
3737 attrs = Fcons (Fcons (Quser, build_string(pw->pw_name)), attrs);
3738
3739 attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER(proc.p_svgid)), attrs);
3740
3741 block_input ();
3742 gr = getgrgid (proc.p_svgid);
3743 unblock_input ();
3744 if (gr)
3745 attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
3746
3747 AUTO_STRING (comm, proc.p_comm);
3748 decoded_comm = code_convert_string_norecord (comm, Vlocale_coding_system, 0);
3749 attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
3750
3751 {
3752 char state[2] = {'\0', '\0'};
3753 switch (proc.p_stat) {
3754 case SIDL:
3755 state[0] = 'I';
3756 break;
3757 case SRUN:
3758 state[0] = 'R';
3759 break;
3760 case SSLEEP:
3761 state[0] = 'S';
3762 break;
3763 case SSTOP:
3764 state[0] = 'T';
3765 break;
3766 case SZOMB:
3767 state[0] = 'Z';
3768 break;
3769 case SDEAD:
3770 state[0] = 'D';
3771 break;
3772 }
3773 attrs = Fcons (Fcons (Qstate, build_string (state)), attrs);
3774 }
3775
3776 attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (proc.p_ppid)), attrs);
3777 attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (proc.p_gid)), attrs);
3778 attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (proc.p_sid)), attrs);
3779
3780 block_input ();
3781 ttyname = proc.p_tdev == NODEV ? NULL : devname (proc.p_tdev, S_IFCHR);
3782 unblock_input ();
3783 if (ttyname)
3784 attrs = Fcons (Fcons (Qttname, build_string (ttyname)), attrs);
3785
3786 attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.p_tpgid)), attrs);
3787 attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (proc.p_uru_minflt)),
3788 attrs);
3789 attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (proc.p_uru_majflt)),
3790 attrs);
3791
3792 /* FIXME: missing cminflt, cmajflt. */
3793
3794 attrs = Fcons (Fcons (Qutime, make_lisp_timeval (proc.p_uutime_sec,
3795 proc.p_uutime_usec)),
3796 attrs);
3797 attrs = Fcons (Fcons (Qstime, make_lisp_timeval (proc.p_ustime_sec,
3798 proc.p_ustime_usec)),
3799 attrs);
3800 t = timespec_add (make_timespec (proc.p_uutime_sec,
3801 proc.p_uutime_usec * 1000),
3802 make_timespec (proc.p_ustime_sec,
3803 proc.p_ustime_usec * 1000));
3804 attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs);
3805
3806 attrs = Fcons (Fcons (Qcutime, make_lisp_timeval (proc.p_uctime_sec,
3807 proc.p_uctime_usec)),
3808 attrs);
3809
3810 /* FIXME: missing cstime and thus ctime. */
3811
3812 attrs = Fcons (Fcons (Qpri, make_fixnum (proc.p_priority)), attrs);
3813 attrs = Fcons (Fcons (Qnice, make_fixnum (proc.p_nice)), attrs);
3814
3815 /* FIXME: missing thcount (thread count) */
3816
3817 attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.p_ustart_sec,
3818 proc.p_ustart_usec)),
3819 attrs);
3820
3821 len = (proc.p_vm_tsize + proc.p_vm_dsize + proc.p_vm_ssize) * pagesize >> 10;
3822 attrs = Fcons (Fcons (Qvsize, make_fixnum (len)), attrs);
3823
3824 attrs = Fcons (Fcons (Qrss, make_fixnum (proc.p_vm_rssize * pagesize >> 10)),
3825 attrs);
3826
3827 t = make_timespec (proc.p_ustart_sec,
3828 proc.p_ustart_usec * 1000);
3829 t = timespec_sub (current_timespec (), t);
3830 attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs);
3831
3832 len = sizeof (fscale);
3833 mib[0] = CTL_KERN;
3834 mib[1] = KERN_FSCALE;
3835 if (sysctl (mib, 2, &fscale, &len, NULL, 0) != -1)
3836 {
3837 pct = (double)proc.p_pctcpu / fscale * 100.0;
3838 attrs = Fcons (Fcons (Qpcpu, make_float (pct)), attrs);
3839 }
3840
3841 len = sizeof (uvmexp);
3842 mib[0] = CTL_VM;
3843 mib[1] = VM_UVMEXP;
3844 if (sysctl (mib, 2, &uvmexp, &len, NULL, 0) != -1)
3845 {
3846 pct = (100.0 * (double)proc.p_vm_rssize / uvmexp.npages);
3847 attrs = Fcons (Fcons (Qpmem, make_float (pct)), attrs);
3848 }
3849
3850 len = sizeof args;
3851 mib[0] = CTL_KERN;
3852 mib[1] = KERN_PROC_ARGS;
3853 mib[2] = proc_id;
3854 mib[3] = KERN_PROC_ARGV;
3855 if (sysctl (mib, 4, &args, &len, NULL, 0) == 0 && len != 0)
3856 {
3857 char **argv = (char**)args;
3858
3859 /* concatenate argv reusing the existing storage storage.
3860 sysctl(8) guarantees that "the buffer pointed to by oldp is
3861 filled with an array of char pointers followed by the strings
3862 themselves." */
3863 for (i = 0; argv[i] != NULL; ++i)
3864 {
3865 if (argv[i+1] != NULL)
3866 {
3867 len = strlen (argv[i]);
3868 argv[i][len] = ' ';
3869 }
3870 }
3871
3872 AUTO_STRING (comm, *argv);
3873 decoded_comm = code_convert_string_norecord (comm,
3874 Vlocale_coding_system, 0);
3875 attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
3876 }
3877
3878 return attrs;
3879}
3880
3664#elif defined DARWIN_OS 3881#elif defined DARWIN_OS
3665 3882
3666Lisp_Object 3883Lisp_Object
diff --git a/src/w32term.c b/src/w32term.c
index e5a8a823b48..109aa58d732 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -7507,7 +7507,8 @@ w32_initialize (void)
7507 } 7507 }
7508 7508
7509#ifdef CYGWIN 7509#ifdef CYGWIN
7510 if ((w32_message_fd = emacs_open ("/dev/windows", O_RDWR, 0)) == -1) 7510 if ((w32_message_fd = emacs_open_noquit ("/dev/windows", O_RDWR, 0))
7511 == -1)
7511 fatal ("opening /dev/windows: %s", strerror (errno)); 7512 fatal ("opening /dev/windows: %s", strerror (errno));
7512#endif /* CYGWIN */ 7513#endif /* CYGWIN */
7513 7514
diff --git a/src/window.c b/src/window.c
index 5e78aa400b5..e025e0b0821 100644
--- a/src/window.c
+++ b/src/window.c
@@ -2663,12 +2663,15 @@ static void
2663decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object *all_frames) 2663decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object *all_frames)
2664{ 2664{
2665 struct window *w = decode_live_window (*window); 2665 struct window *w = decode_live_window (*window);
2666 Lisp_Object miniwin = XFRAME (w->frame)->minibuffer_window;
2666 2667
2667 XSETWINDOW (*window, w); 2668 XSETWINDOW (*window, w);
2668 /* MINIBUF nil may or may not include minibuffers. Decide if it 2669 /* MINIBUF nil may or may not include minibuffers. Decide if it
2669 does. */ 2670 does. */
2670 if (NILP (*minibuf)) 2671 if (NILP (*minibuf))
2671 *minibuf = minibuf_level ? minibuf_window : Qlambda; 2672 *minibuf = this_minibuffer_depth (XWINDOW (miniwin)->contents)
2673 ? miniwin
2674 : Qlambda;
2672 else if (!EQ (*minibuf, Qt)) 2675 else if (!EQ (*minibuf, Qt))
2673 *minibuf = Qlambda; 2676 *minibuf = Qlambda;
2674 2677
diff --git a/src/window.h b/src/window.h
index 332cb3091fd..79eb44e7a38 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1124,10 +1124,6 @@ extern Lisp_Object echo_area_window;
1124 1124
1125extern EMACS_INT command_loop_level; 1125extern EMACS_INT command_loop_level;
1126 1126
1127/* Depth in minibuffer invocations. */
1128
1129extern EMACS_INT minibuf_level;
1130
1131/* Non-zero if we should redraw the mode lines on the next redisplay. 1127/* Non-zero if we should redraw the mode lines on the next redisplay.
1132 Usually set to a unique small integer so we can track the main causes of 1128 Usually set to a unique small integer so we can track the main causes of
1133 full redisplays in `redisplay--mode-lines-cause'. */ 1129 full redisplays in `redisplay--mode-lines-cause'. */
diff --git a/src/xdisp.c b/src/xdisp.c
index 6a4304d194b..ea67329cff1 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -9285,8 +9285,8 @@ move_it_in_display_line_to (struct it *it,
9285 if (may_wrap && char_can_wrap_before (it)) 9285 if (may_wrap && char_can_wrap_before (it))
9286 { 9286 {
9287 /* We have reached a glyph that follows one or more 9287 /* We have reached a glyph that follows one or more
9288 whitespace characters or a character that allows 9288 whitespace characters or characters that allow
9289 wrapping after it. If this character allows 9289 wrapping after them. If this character allows
9290 wrapping before it, save this position as a 9290 wrapping before it, save this position as a
9291 wrapping point. */ 9291 wrapping point. */
9292 if (atpos_it.sp >= 0) 9292 if (atpos_it.sp >= 0)
@@ -9303,7 +9303,6 @@ move_it_in_display_line_to (struct it *it,
9303 } 9303 }
9304 /* Otherwise, we can wrap here. */ 9304 /* Otherwise, we can wrap here. */
9305 SAVE_IT (wrap_it, *it, wrap_data); 9305 SAVE_IT (wrap_it, *it, wrap_data);
9306 next_may_wrap = false;
9307 } 9306 }
9308 /* Update may_wrap for the next iteration. */ 9307 /* Update may_wrap for the next iteration. */
9309 may_wrap = next_may_wrap; 9308 may_wrap = next_may_wrap;
@@ -10650,9 +10649,10 @@ include the height of both, if present, in the return value. */)
10650 bpos = BEGV_BYTE; 10649 bpos = BEGV_BYTE;
10651 while (bpos < ZV_BYTE) 10650 while (bpos < ZV_BYTE)
10652 { 10651 {
10653 c = fetch_char_advance (&start, &bpos); 10652 c = FETCH_BYTE (bpos);
10654 if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r')) 10653 if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
10655 break; 10654 break;
10655 inc_both (&start, &bpos);
10656 } 10656 }
10657 while (bpos > BEGV_BYTE) 10657 while (bpos > BEGV_BYTE)
10658 { 10658 {
@@ -10681,7 +10681,10 @@ include the height of both, if present, in the return value. */)
10681 dec_both (&end, &bpos); 10681 dec_both (&end, &bpos);
10682 c = FETCH_BYTE (bpos); 10682 c = FETCH_BYTE (bpos);
10683 if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r')) 10683 if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
10684 break; 10684 {
10685 inc_both (&end, &bpos);
10686 break;
10687 }
10685 } 10688 }
10686 while (bpos < ZV_BYTE) 10689 while (bpos < ZV_BYTE)
10687 { 10690 {
diff --git a/src/xfaces.c b/src/xfaces.c
index b3b19a9cb2e..258b365eda3 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
3293 } 3293 }
3294 else if (EQ (k, QCstyle)) 3294 else if (EQ (k, QCstyle))
3295 { 3295 {
3296 if (!EQ (v, Qpressed_button) && !EQ (v, Qreleased_button)) 3296 if (!EQ (v, Qpressed_button) && !EQ (v, Qreleased_button)
3297 && !EQ(v, Qflat_button))
3297 break; 3298 break;
3298 } 3299 }
3299 else 3300 else
@@ -6031,6 +6032,10 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]
6031 face->box = FACE_RAISED_BOX; 6032 face->box = FACE_RAISED_BOX;
6032 else if (EQ (value, Qpressed_button)) 6033 else if (EQ (value, Qpressed_button))
6033 face->box = FACE_SUNKEN_BOX; 6034 face->box = FACE_SUNKEN_BOX;
6035 else if (EQ (value, Qflat_button)) {
6036 face->box = FACE_SIMPLE_BOX;
6037 face->box_color = face->background;
6038 }
6034 } 6039 }
6035 } 6040 }
6036 } 6041 }
@@ -6919,6 +6924,7 @@ syms_of_xfaces (void)
6919 DEFSYM (Qwave, "wave"); 6924 DEFSYM (Qwave, "wave");
6920 DEFSYM (Qreleased_button, "released-button"); 6925 DEFSYM (Qreleased_button, "released-button");
6921 DEFSYM (Qpressed_button, "pressed-button"); 6926 DEFSYM (Qpressed_button, "pressed-button");
6927 DEFSYM (Qflat_button, "flat-button");
6922 DEFSYM (Qnormal, "normal"); 6928 DEFSYM (Qnormal, "normal");
6923 DEFSYM (Qextra_light, "extra-light"); 6929 DEFSYM (Qextra_light, "extra-light");
6924 DEFSYM (Qlight, "light"); 6930 DEFSYM (Qlight, "light");
diff --git a/test/Makefile.in b/test/Makefile.in
index 68ad1a35796..849fbbf474e 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -253,6 +253,12 @@ endef
253 253
254$(foreach test,${TESTS},$(eval $(call test_template,${test}))) 254$(foreach test,${TESTS},$(eval $(call test_template,${test})))
255 255
256# Get the tests for only a specific directory
257NET_TESTS := $(patsubst %.el,%,$(wildcard lisp/net/*.el))
258LISP_TESTS := $(patsubst %.el,%,$(wildcard lisp/*.el))
259check-net: ${NET_TESTS}
260check-lisp: ${LISP_TESTS}
261
256ifeq (@HAVE_MODULES@, yes) 262ifeq (@HAVE_MODULES@, yes)
257# -fPIC is a no-op on Windows, but causes a compiler warning 263# -fPIC is a no-op on Windows, but causes a compiler warning
258ifeq ($(SO),.dll) 264ifeq ($(SO),.dll)
diff --git a/test/README b/test/README
index ec566cb58dc..38f4a109701 100644
--- a/test/README
+++ b/test/README
@@ -39,6 +39,12 @@ The Makefile in this directory supports the following targets:
39* make check-all 39* make check-all
40 Like "make check", but run all tests. 40 Like "make check", but run all tests.
41 41
42* make check-lisp
43 Like "make check", but run only the tests in test/lisp/*.el
44
45* make check-net
46 Like "make check", but run only the tests in test/lisp/net/*.el
47
42* make <filename> -or- make <filename>.log 48* make <filename> -or- make <filename>.log
43 Run all tests declared in <filename>.el. This includes expensive 49 Run all tests declared in <filename>.el. This includes expensive
44 tests. In the former case the output is shown on the terminal, in 50 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 64c0755b3bc..efc354529c5 100644
--- a/test/file-organization.org
+++ b/test/file-organization.org
@@ -57,3 +57,8 @@ directory called ~test/lisp/progmodes/flymake-resources~.
57No guidance is given for the organization of resource files inside the 57No guidance is given for the organization of resource files inside the
58~-resources~ directory; files can be organized at the author's 58~-resources~ directory; files can be organized at the author's
59discretion. 59discretion.
60
61** Testing Infrastructure Files
62
63Files used to support testing infrastructure such as EMBA should be
64placed in ~infra~.
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba
new file mode 100644
index 00000000000..dd41982ad59
--- /dev/null
+++ b/test/infra/Dockerfile.emba
@@ -0,0 +1,71 @@
1# Copyright (C) 2021 Free Software Foundation, Inc.
2#
3# This file is part of GNU Emacs.
4#
5# GNU Emacs is free software: you can redistribute it and/or modify
6# it under the terms of the GNU General Public License as published by
7# the Free Software Foundation, either version 3 of the License, or
8# (at your option) any later version.
9#
10# GNU Emacs is distributed in the hope that it will be useful,
11# but WITHOUT ANY WARRANTY; without even the implied warranty of
12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13# GNU General Public License for more details.
14#
15# You should have received a copy of the GNU General Public License
16# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
17
18# GNU Emacs support for the GitLab-specific build of Docker images.
19
20# The presence of this file does not imply any FSF/GNU endorsement of
21# Docker or any other particular tool. Also, it is intended for
22# evaluation purposes, thus possibly temporary.
23
24# Maintainer: Ted Zlatanov <tzz@lifelogs.com>
25# URL: https://emba.gnu.org/emacs/emacs
26
27FROM debian:stretch as emacs-base
28
29RUN apt-get update && \
30 apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
31 libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev git \
32 && rm -rf /var/lib/apt/lists/*
33
34FROM emacs-base as emacs-inotify
35
36RUN apt-get update && \
37 apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 inotify-tools \
38 && rm -rf /var/lib/apt/lists/*
39
40COPY . /checkout
41WORKDIR /checkout
42RUN ./autogen.sh autoconf
43RUN ./configure --without-makeinfo
44RUN make bootstrap
45RUN make -j4
46
47FROM emacs-base as emacs-filenotify-gio
48
49RUN apt-get update && \
50 apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 libglib2.0-dev libglib2.0-bin libglib2.0-0 \
51 && rm -rf /var/lib/apt/lists/*
52
53COPY . /checkout
54WORKDIR /checkout
55RUN ./autogen.sh autoconf
56RUN ./configure --without-makeinfo --with-file-notification=gfile
57RUN make bootstrap
58RUN make -j4
59
60FROM emacs-base as emacs-gnustep
61
62RUN apt-get update && \
63 apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 gnustep-devel \
64 && rm -rf /var/lib/apt/lists/*
65
66COPY . /checkout
67WORKDIR /checkout
68RUN ./autogen.sh autoconf
69RUN ./configure --without-makeinfo --with-ns
70RUN make bootstrap
71RUN make -j4
diff --git a/test/lisp/calendar/lunar-tests.el b/test/lisp/calendar/lunar-tests.el
index 5f1f6782f1a..268dcfdb550 100644
--- a/test/lisp/calendar/lunar-tests.el
+++ b/test/lisp/calendar/lunar-tests.el
@@ -27,39 +27,37 @@
27(defmacro with-lunar-test (&rest body) 27(defmacro with-lunar-test (&rest body)
28 `(let ((calendar-latitude 40.1) 28 `(let ((calendar-latitude 40.1)
29 (calendar-longitude -88.2) 29 (calendar-longitude -88.2)
30 (calendar-location-name "Urbana, IL") 30 (calendar-location-name "Paris")
31 (calendar-time-zone -360) 31 (calendar-time-zone 0)
32 (calendar-standard-time-zone-name "CST") 32 (calendar-standard-time-zone-name "UTC")
33 (calendar-time-display-form '(12-hours ":" minutes am-pm))) 33 ;; Make sure daylight saving is disabled to avoid interference
34 ;; from the system settings (see bug#45818).
35 (calendar-daylight-savings-starts nil)
36 (calendar-time-display-form '(24-hours ":" minutes)))
34 ,@body)) 37 ,@body))
35 38
36(ert-deftest lunar-test-phase () 39(ert-deftest lunar-test-phase ()
37 (with-lunar-test 40 (with-lunar-test
38 (should (equal (lunar-phase 1) 41 (should (equal (lunar-phase 1)
39 '((1 7 1900) "11:40pm" 1 ""))))) 42 '((1 8 1900) "05:40" 1 "")))))
40 43
41(ert-deftest lunar-test-eclipse-check () 44(ert-deftest lunar-test-eclipse-check ()
42 (with-lunar-test 45 (with-lunar-test
43 (should (equal (eclipse-check 1 1) "** Eclipse **")))) 46 (should (equal (eclipse-check 1 1) "** Eclipse **"))))
44 47
45;; This fails in certain time zones.
46;; Eg TZ=America/Phoenix make lisp/calendar/lunar-tests
47;; Similarly with TZ=UTC.
48;; Daylight saving related?
49(ert-deftest lunar-test-phase-list () 48(ert-deftest lunar-test-phase-list ()
50 :tags '(:unstable)
51 (with-lunar-test 49 (with-lunar-test
52 (should (equal (lunar-phase-list 3 1871) 50 (should (equal (lunar-phase-list 3 1871)
53 '(((3 20 1871) "11:03pm" 0 "") 51 '(((3 21 1871) "04:03" 0 "")
54 ((3 29 1871) "1:46am" 1 "** Eclipse **") 52 ((3 29 1871) "06:46" 1 "** Eclipse **")
55 ((4 5 1871) "9:20am" 2 "") 53 ((4 5 1871) "14:20" 2 "")
56 ((4 12 1871) "12:57am" 3 "** Eclipse possible **") 54 ((4 12 1871) "05:57" 3 "** Eclipse possible **")
57 ((4 19 1871) "2:06pm" 0 "") 55 ((4 19 1871) "19:06" 0 "")
58 ((4 27 1871) "6:49pm" 1 "") 56 ((4 27 1871) "23:49" 1 "")
59 ((5 4 1871) "5:57pm" 2 "") 57 ((5 4 1871) "22:57" 2 "")
60 ((5 11 1871) "9:29am" 3 "") 58 ((5 11 1871) "14:29" 3 "")
61 ((5 19 1871) "5:46am" 0 "") 59 ((5 19 1871) "10:46" 0 "")
62 ((5 27 1871) "8:02am" 1 "")))))) 60 ((5 27 1871) "13:02" 1 ""))))))
63 61
64(ert-deftest lunar-test-new-moon-time () 62(ert-deftest lunar-test-new-moon-time ()
65 (with-lunar-test 63 (with-lunar-test
diff --git a/test/lisp/calendar/solar-tests.el b/test/lisp/calendar/solar-tests.el
index 7a37f8db558..337deb8ce9a 100644
--- a/test/lisp/calendar/solar-tests.el
+++ b/test/lisp/calendar/solar-tests.el
@@ -26,7 +26,9 @@
26 (calendar-longitude 75.8) 26 (calendar-longitude 75.8)
27 (calendar-time-zone +330) 27 (calendar-time-zone +330)
28 (calendar-standard-time-zone-name "IST") 28 (calendar-standard-time-zone-name "IST")
29 (calendar-daylight-time-zone-name "IST") 29 ;; Make sure our clockwork isn't confused by daylight saving rules
30 ;; in effect for any other time zone (bug#45818).
31 (calendar-daylight-savings-starts nil)
30 (epsilon (/ 60.0))) ; Minute accuracy is good enough. 32 (epsilon (/ 60.0))) ; Minute accuracy is good enough.
31 (let* ((sunrise-sunset (solar-sunrise-sunset '(12 30 2020))) 33 (let* ((sunrise-sunset (solar-sunrise-sunset '(12 30 2020)))
32 (sunrise (car (nth 0 sunrise-sunset))) 34 (sunrise (car (nth 0 sunrise-sunset)))
diff --git a/test/lisp/cedet/semantic-utest.el b/test/lisp/cedet/semantic-utest.el
index c0099386f1c..67de4a5b02d 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."
577 577
578 578
579(ert-deftest semantic-utest-Javascript() 579(ert-deftest semantic-utest-Javascript()
580 (if (fboundp 'javascript-mode) 580 (skip-unless (fboundp 'javascript-mode))
581 (semantic-utest-generic (semantic-utest-fname "javascripttest.js") semantic-utest-Javascript-buffer-contents semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line") 581 (semantic-utest-generic (semantic-utest-fname "javascripttest.js") semantic-utest-Javascript-buffer-contents semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line"))
582 (message "Skipping JavaScript test: NO major mode."))
583 )
584 582
585(ert-deftest semantic-utest-Java() 583(ert-deftest semantic-utest-Java()
586 ;; If JDE is installed, it might mess things up depending on the version 584 ;; 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 0497dea505d..1c6578038c0 100644
--- a/test/lisp/cedet/srecode-utest-getset.el
+++ b/test/lisp/cedet/srecode-utest-getset.el
@@ -128,7 +128,6 @@ private:
128 (srecode-utest-getset-jumptotag "miscFunction")) 128 (srecode-utest-getset-jumptotag "miscFunction"))
129 129
130 (let ((pos (point))) 130 (let ((pos (point)))
131 (skip-chars-backward " \t\n") ; xemacs forward-comment is different.
132 (forward-comment -1) 131 (forward-comment -1)
133 (re-search-forward "miscFunction" pos)) 132 (re-search-forward "miscFunction" pos))
134 133
diff --git a/test/lisp/cedet/srecode-utest-template.el b/test/lisp/cedet/srecode-utest-template.el
index 57d8a648050..f97ff18320e 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")
307 (should (srecode-table major-mode)) 307 (should (srecode-table major-mode))
308 308
309 ;; Loop over the output testpoints. 309 ;; Loop over the output testpoints.
310
311 (dolist (p srecode-utest-output-entries) 310 (dolist (p srecode-utest-output-entries)
312 (set-buffer testbuff) ;; XEmacs causes a buffer switch. I don't know why 311 (should-not (srecode-utest-test p)))))
313 (should-not (srecode-utest-test p))
314 )
315 312
316 ))
317 (when (file-exists-p srecode-utest-testfile) 313 (when (file-exists-p srecode-utest-testfile)
318 (delete-file srecode-utest-testfile))) 314 (delete-file srecode-utest-testfile)))
319 315
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 446983c2e3e..bcd63f73a3c 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."
610 ;; Just make sure the function can be instrumented. 610 ;; Just make sure the function can be instrumented.
611 (edebug-defun))) 611 (edebug-defun)))
612 612
613;;; cl-labels
614
615(ert-deftest cl-macs--labels ()
616 ;; Simple recursive function.
617 (cl-labels ((len (xs) (if xs (1+ (len (cdr xs))) 0)))
618 (should (equal (len (make-list 42 t)) 42)))
619
620 ;; Simple tail-recursive function.
621 (cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)))
622 (should (equal (len (make-list 42 t) 0) 42))
623 ;; Should not bump into stack depth limits.
624 (should (equal (len (make-list 42000 t) 0) 42000)))
625
626 ;; Check that non-recursive functions are handled more efficiently.
627 (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5)))
628 (`(let* ,_ (funcall ,_ 5)) t)))
629
630 ;; Case of "tail-recursive lambdas".
631 (should (pcase (macroexpand
632 '(cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)))
633 #'len))
634 (`(function (lambda (,_ ,_) . ,_)) t))))
635
613;;; cl-macs-tests.el ends here 636;;; 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 74da33eff69..7856c217f9e 100644
--- a/test/lisp/emacs-lisp/timer-tests.el
+++ b/test/lisp/emacs-lisp/timer-tests.el
@@ -36,8 +36,8 @@
36 36
37(ert-deftest timer-tests-debug-timer-check () 37(ert-deftest timer-tests-debug-timer-check ()
38 ;; This function exists only if --enable-checking. 38 ;; This function exists only if --enable-checking.
39 (if (fboundp 'debug-timer-check) 39 (skip-unless (fboundp 'debug-timer-check))
40 (should (debug-timer-check)) t)) 40 (should (debug-timer-check)))
41 41
42(ert-deftest timer-test-multiple-of-time () 42(ert-deftest timer-test-multiple-of-time ()
43 (should (time-equal-p 43 (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 00000000000..d3c5026dcce
--- /dev/null
+++ b/test/lisp/gnus/mm-decode-resources/win1252-multipart.bin
@@ -0,0 +1,44 @@
1To: example <example@example.org>
2From: example <example@example.org>
3Date: Tue, 5 Jan 2021 10:30:34 +0100
4MIME-Version: 1.0
5Content-Type: multipart/mixed; boundary="------------FB569A4368539497CC91D1DC"
6Content-Language: fr
7Subject: test
8
9--------------FB569A4368539497CC91D1DC
10Content-Type: multipart/alternative;
11 boundary="------------61C81A7DC7592E4C6F856A85"
12
13
14--------------61C81A7DC7592E4C6F856A85
15Content-Type: text/plain; charset=windows-1252; format=flowed
16Content-Transfer-Encoding: 8bit
17
18déjà raté
19
20--------------61C81A7DC7592E4C6F856A85
21Content-Type: text/html; charset=windows-1252
22Content-Transfer-Encoding: 8bit
23
24<html>
25 <head>
26 <meta http-equiv="content-type" content="text/html; charset=windows-1252">
27 </head>
28 <body>
29 déjà raté
30 </body>
31</html>
32
33--------------61C81A7DC7592E4C6F856A85--
34
35--------------FB569A4368539497CC91D1DC
36Content-Type: text/plain; charset="us-ascii"
37MIME-Version: 1.0
38Content-Transfer-Encoding: 7bit
39Content-Disposition: inline
40
41mailing list signature
42
43--------------FB569A4368539497CC91D1DC--
44
diff --git a/test/lisp/gnus/mm-decode-tests.el b/test/lisp/gnus/mm-decode-tests.el
index 74591f919da..7d059cb3f87 100644
--- a/test/lisp/gnus/mm-decode-tests.el
+++ b/test/lisp/gnus/mm-decode-tests.el
@@ -70,20 +70,33 @@
70 'charset))) 70 'charset)))
71 "ääää\n")))))) 71 "ääää\n"))))))
72 72
73(ert-deftest test-mm-with-part-multibyte () 73(ert-deftest test-mm-dissect-buffer-win1252 ()
74 (with-temp-buffer 74 (with-temp-buffer
75 (set-buffer-multibyte t) 75 (set-buffer-multibyte nil)
76 (nnheader-insert-file-contents (ert-resource-file "8bit-multipart.bin")) 76 (insert-file-contents-literally (ert-resource-file "win1252-multipart.bin"))
77 (while (search-forward "\r\n" nil t)
78 (replace-match "\n"))
79 (let ((handle (mm-dissect-buffer))) 77 (let ((handle (mm-dissect-buffer)))
78 (should (equal (mm-handle-media-type handle) "multipart/mixed"))
79 ;; Skip multipart type.
80 (pop handle)
81 (setq handle (car handle))
80 (pop handle) 82 (pop handle)
81 (let ((part (pop handle))) 83 (let ((part (pop handle)))
82 (should (equal (decode-coding-string 84 (should (equal (mm-handle-media-type part) "text/plain"))
83 (mm-with-part part 85 (should (eq (mm-handle-encoding part) '8bit))
84 (buffer-string)) 86 (with-current-buffer (mm-handle-buffer part)
85 (intern (mail-content-type-get (mm-handle-type part) 87 (should (equal (decode-coding-string
86 'charset))) 88 (buffer-string)
87 "ääää\n")))))) 89 (intern (mail-content-type-get (mm-handle-type part)
90 'charset)))
91 "déjà raté\n"))))
92 (let ((part (pop handle)))
93 (should (equal (mm-handle-media-type part) "text/html"))
94 (should (eq (mm-handle-encoding part) '8bit))
95 (with-current-buffer (mm-handle-buffer part)
96 (should (equal (decode-coding-string
97 (buffer-string)
98 (intern (mail-content-type-get (mm-handle-type part)
99 'charset)))
100 "<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")))))))
88 101
89;;; mm-decode-tests.el ends here 102;;; mm-decode-tests.el ends here
diff --git a/test/lisp/help-mode-tests.el b/test/lisp/help-mode-tests.el
index e0e82c9cc1a..43db59d4b1b 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.")
72 #'info))))) 72 #'info)))))
73 73
74(ert-deftest help-mode-tests-xref-button () 74(ert-deftest help-mode-tests-xref-button ()
75 (with-temp-buffer 75 (let* ((fmt "See also the function ‘%s’.")
76 (insert "See also the function ‘interactive’.") 76 ;; 1+ translates string index to buffer position.
77 (string-match help-xref-symbol-regexp (buffer-string)) 77 (beg (1+ (string-search "%" fmt))))
78 (help-xref-button 8 'help-function) 78 (with-temp-buffer
79 (should-not (button-at 22)) 79 (dolist (fn '(interactive \` = + - * / %))
80 (should-not (button-at 35)) 80 (erase-buffer)
81 (let ((button (button-at 30))) 81 (insert (format fmt fn))
82 (should (eq (button-type button) 'help-function))))) 82 (goto-char (point-min))
83 (re-search-forward help-xref-symbol-regexp)
84 (help-xref-button 8 'help-function)
85 (should-not (button-at (1- beg)))
86 (should-not (button-at (+ beg (length (symbol-name fn)))))
87 (should (eq (button-type (button-at beg)) 'help-function))))))
83 88
84(ert-deftest help-mode-tests-insert-xref-button () 89(ert-deftest help-mode-tests-insert-xref-button ()
85 (with-temp-buffer 90 (with-temp-buffer
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 835d9fe7949..8034764741c 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -95,7 +95,7 @@
95key binding 95key binding
96--- ------- 96--- -------
97 97
98C-g abort-recursive-edit 98C-g abort-minibuffers
99TAB minibuffer-complete 99TAB minibuffer-complete
100C-j minibuffer-complete-and-exit 100C-j minibuffer-complete-and-exit
101RET minibuffer-complete-and-exit 101RET minibuffer-complete-and-exit
@@ -122,7 +122,7 @@ M-s next-matching-history-element
122 122
123(ert-deftest help-tests-substitute-command-keys/keymap-change () 123(ert-deftest help-tests-substitute-command-keys/keymap-change ()
124 (with-substitute-command-keys-test 124 (with-substitute-command-keys-test
125 (test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-g") 125 (test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-]")
126 (test "\\<emacs-lisp-mode-map>\\[eval-defun]" "C-M-x"))) 126 (test "\\<emacs-lisp-mode-map>\\[eval-defun]" "C-M-x")))
127 127
128(defvar help-tests-remap-map 128(defvar help-tests-remap-map
diff --git a/test/lisp/net/nsm-tests.el b/test/lisp/net/nsm-tests.el
index 88c30c20395..ff453319b37 100644
--- a/test/lisp/net/nsm-tests.el
+++ b/test/lisp/net/nsm-tests.el
@@ -49,15 +49,17 @@
49 (should (eq nil (nsm-should-check "127.0.0.1"))) 49 (should (eq nil (nsm-should-check "127.0.0.1")))
50 (should (eq nil (nsm-should-check "localhost")))))) 50 (should (eq nil (nsm-should-check "localhost"))))))
51 51
52(defun nsm-ipv6-is-available () 52;; This will need updating when IANA assign more IPv6 global ranges.
53(defun ipv6-is-available ()
53 (and (featurep 'make-network-process '(:family ipv6)) 54 (and (featurep 'make-network-process '(:family ipv6))
54 (cl-rassoc-if 55 (cl-rassoc-if
55 (lambda (elt) 56 (lambda (elt)
56 (eq 9 (length elt))) 57 (and (eq 9 (length elt))
58 (= (logand (aref elt 0) #xe000) #x2000)))
57 (network-interface-list)))) 59 (network-interface-list))))
58 60
59(ert-deftest nsm-check-local-subnet-ipv6 () 61(ert-deftest nsm-check-local-subnet-ipv6 ()
60 (skip-unless (nsm-ipv6-is-available)) 62 (skip-unless (ipv6-is-available))
61 (let ((local-ip '[123 456 789 11 172 26 128 160 0]) 63 (let ((local-ip '[123 456 789 11 172 26 128 160 0])
62 (mask '[255 255 255 255 255 255 255 0 0]) 64 (mask '[255 255 255 255 255 255 255 0 0])
63 65
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
new file mode 100644
index 00000000000..b378ed2964e
--- /dev/null
+++ b/test/lisp/net/socks-tests.el
@@ -0,0 +1,103 @@
1;;; socks-tests.el --- tests for SOCKS -*- coding: utf-8; lexical-binding: t; -*-
2
3;; Copyright (C) 2021 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;;; Code:
23
24(require 'socks)
25(require 'url-http)
26
27(defvar socks-tests-canned-server-port nil)
28
29(defun socks-tests-canned-server-create (verbatim patterns)
30 "Create a fake SOCKS server and return the process.
31
32`VERBATIM' and `PATTERNS' are dotted alists containing responses.
33Requests are tried in order. On failure, an error is raised."
34 (let* ((buf (generate-new-buffer "*canned-socks-server*"))
35 (filt (lambda (proc line)
36 (let ((resp (or (assoc-default line verbatim
37 (lambda (k s) ; s is line
38 (string= (concat k) s)))
39 (assoc-default line patterns
40 (lambda (p s)
41 (string-match-p p s))))))
42 (unless resp
43 (error "Unknown request: %s" line))
44 (let ((print-escape-control-characters t))
45 (princ (format "<- %s\n" (prin1-to-string line)) buf)
46 (princ (format "-> %s\n" (prin1-to-string resp)) buf))
47 (process-send-string proc (concat resp)))))
48 (srv (make-network-process :server 1
49 :buffer buf
50 :filter filt
51 :name "server"
52 :family 'ipv4
53 :host 'local
54 :service socks-tests-canned-server-port)))
55 (set-process-query-on-exit-flag srv nil)
56 (princ (format "[%s] Listening on localhost:10080\n" srv) buf)
57 srv))
58
59;; Add ([5 3 0 1 2] . [5 2]) to the `verbatim' list below to validate
60;; against curl 7.71 with the following options:
61;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com
62;;
63;; If later implementing version 4a, try these:
64;; [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]
65;; $ curl --verbose --proxy socks4a://127.0.0.1:10080 example.com
66
67(ert-deftest socks-tests-auth-filter-url-http ()
68 "Verify correct handling of SOCKS5 user/pass authentication."
69 (let* ((socks-server '("server" "127.0.0.1" 10080 5))
70 (socks-username "foo")
71 (socks-password "bar")
72 (url-gateway-method 'socks)
73 (url (url-generic-parse-url "http://example.com"))
74 (verbatim '(([5 2 0 2] . [5 2])
75 ([1 3 ?f ?o ?o 3 ?b ?a ?r] . [1 0])
76 ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
77 . [5 0 0 1 0 0 0 0 0 0])))
78 (patterns
79 `(("^GET /" . ,(concat "HTTP/1.1 200 OK\r\n"
80 "Content-Type: text/plain; charset=UTF-8\r\n"
81 "Content-Length: 13\r\n\r\n"
82 "Hello World!\n"))))
83 (socks-tests-canned-server-port 10080)
84 (server (socks-tests-canned-server-create verbatim patterns))
85 (tries 10)
86 ;;
87 done
88 ;;
89 (cb (lambda (&rest _r)
90 (goto-char (point-min))
91 (should (search-forward "Hello World" nil t))
92 (setq done t)))
93 (buf (url-http url cb '(nil))))
94 (ert-info ("Connect to HTTP endpoint over SOCKS5 with USER/PASS method")
95 (while (and (not done) (< 0 (cl-decf tries))) ; cl-lib via url-http
96 (sleep-for 0.1)))
97 (should done)
98 (delete-process server)
99 (kill-buffer (process-buffer server))
100 (kill-buffer buf)
101 (ignore url-gateway-method)))
102
103;;; socks-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index e1cb9939f29..ef0968a3385 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -78,6 +78,8 @@
78;; Needed for Emacs 27. 78;; Needed for Emacs 27.
79(defvar process-file-return-signal-string) 79(defvar process-file-return-signal-string)
80(defvar shell-command-dont-erase-buffer) 80(defvar shell-command-dont-erase-buffer)
81;; Needed for Emacs 28.
82(defvar dired-copy-dereference)
81 83
82;; Beautify batch mode. 84;; Beautify batch mode.
83(when noninteractive 85(when noninteractive
@@ -98,7 +100,6 @@
98 '("mock" 100 '("mock"
99 (tramp-login-program "sh") 101 (tramp-login-program "sh")
100 (tramp-login-args (("-i"))) 102 (tramp-login-args (("-i")))
101 (tramp-direct-async-args (("-c")))
102 (tramp-remote-shell "/bin/sh") 103 (tramp-remote-shell "/bin/sh")
103 (tramp-remote-shell-args ("-c")) 104 (tramp-remote-shell-args ("-c"))
104 (tramp-connection-timeout 10))) 105 (tramp-connection-timeout 10)))
@@ -2438,7 +2439,7 @@ This checks also `file-name-as-directory', `file-name-directory',
2438 ;; We must check the last line. There could be 2439 ;; We must check the last line. There could be
2439 ;; other messages from the progress reporter. 2440 ;; other messages from the progress reporter.
2440 (should 2441 (should
2441 (string-match 2442 (string-match-p
2442 (if (and (null noninteractive) 2443 (if (and (null noninteractive)
2443 (or (eq visit t) (null visit) (stringp visit))) 2444 (or (eq visit t) (null visit) (stringp visit)))
2444 (format "^Wrote %s\n\\'" (regexp-quote tmp-name)) 2445 (format "^Wrote %s\n\\'" (regexp-quote tmp-name))
@@ -2833,6 +2834,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
2833(ert-deftest tramp-test15-copy-directory () 2834(ert-deftest tramp-test15-copy-directory ()
2834 "Check `copy-directory'." 2835 "Check `copy-directory'."
2835 (skip-unless (tramp--test-enabled)) 2836 (skip-unless (tramp--test-enabled))
2837 (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
2836 2838
2837 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) 2839 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
2838 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 2840 (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'."
3067 (regexp-opt (directory-files tmp-name1)) 3069 (regexp-opt (directory-files tmp-name1))
3068 (length (directory-files tmp-name1))))))) 3070 (length (directory-files tmp-name1)))))))
3069 3071
3070 ;; Check error case. We do not check for the error type, 3072 ;; Check error case.
3071 ;; because ls-lisp returns `file-error', and native Tramp
3072 ;; returns `file-missing'.
3073 (delete-directory tmp-name1 'recursive) 3073 (delete-directory tmp-name1 'recursive)
3074 (with-temp-buffer 3074 (with-temp-buffer
3075 (should-error 3075 (should-error
@@ -3188,6 +3188,59 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
3188 (ignore-errors (delete-directory tmp-name1 'recursive)) 3188 (ignore-errors (delete-directory tmp-name1 'recursive))
3189 (ignore-errors (delete-directory tmp-name2 'recursive)))))) 3189 (ignore-errors (delete-directory tmp-name2 'recursive))))))
3190 3190
3191;; The following test is inspired by Bug#45691.
3192(ert-deftest tramp-test17-insert-directory-one-file ()
3193 "Check `insert-directory' inside directory listing."
3194 (skip-unless (tramp--test-enabled))
3195
3196 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
3197 (let* ((tmp-name1
3198 (expand-file-name (tramp--test-make-temp-name nil quoted)))
3199 (tmp-name2 (expand-file-name "foo" tmp-name1))
3200 (tmp-name3 (expand-file-name "bar" tmp-name1))
3201 (dired-copy-preserve-time t)
3202 (dired-recursive-copies 'top)
3203 dired-copy-dereference
3204 buffer)
3205 (unwind-protect
3206 (progn
3207 (make-directory tmp-name1)
3208 (write-region "foo" nil tmp-name2)
3209 (should (file-directory-p tmp-name1))
3210 (should (file-exists-p tmp-name2))
3211
3212 ;; Check, that `insert-directory' works properly.
3213 (with-current-buffer
3214 (setq buffer (dired-noselect tmp-name1 "--dired -al"))
3215 (read-only-mode -1)
3216 (goto-char (point-min))
3217 (while (not (or (eobp)
3218 (string-equal
3219 (dired-get-filename 'localp 'no-error)
3220 (file-name-nondirectory tmp-name2))))
3221 (forward-line 1))
3222 (should-not (eobp))
3223 (copy-file tmp-name2 tmp-name3)
3224 (insert-directory
3225 (file-name-nondirectory tmp-name3) "--dired -al -d")
3226 ;; Point shall still be the recent file.
3227 (should
3228 (string-equal
3229 (dired-get-filename 'localp 'no-error)
3230 (file-name-nondirectory tmp-name2)))
3231 (should-not (re-search-forward "dired" nil t))
3232 ;; The copied file has been inserted the line before.
3233 (forward-line -1)
3234 (should
3235 (string-equal
3236 (dired-get-filename 'localp 'no-error)
3237 (file-name-nondirectory tmp-name3))))
3238 (kill-buffer buffer))
3239
3240 ;; Cleanup.
3241 (ignore-errors (kill-buffer buffer))
3242 (ignore-errors (delete-directory tmp-name1 'recursive))))))
3243
3191;; Method "smb" supports `make-symbolic-link' only if the remote host 3244;; Method "smb" supports `make-symbolic-link' only if the remote host
3192;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el and 3245;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el and
3193;; tramp-rclone.el do not support symbolic links at all. 3246;; 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'."
3561 `(condition-case err 3614 `(condition-case err
3562 (progn ,@body) 3615 (progn ,@body)
3563 (file-error 3616 (file-error
3564 (unless (string-match "^error with add-name-to-file" 3617 (unless (string-match-p "^error with add-name-to-file"
3565 (error-message-string err)) 3618 (error-message-string err))
3566 (signal (car err) (cdr err)))))) 3619 (signal (car err) (cdr err))))))
3567 3620
3568(ert-deftest tramp-test21-file-links () 3621(ert-deftest tramp-test21-file-links ()
@@ -4337,7 +4390,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4337 ;; there's an indication for a signal describing string. 4390 ;; there's an indication for a signal describing string.
4338 (let ((process-file-return-signal-string t)) 4391 (let ((process-file-return-signal-string t))
4339 (should 4392 (should
4340 (string-match 4393 (string-match-p
4341 "Interrupt\\|Signal 2" 4394 "Interrupt\\|Signal 2"
4342 (process-file 4395 (process-file
4343 (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh") 4396 (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'."
4405 (with-timeout (10 (tramp--test-timeout-handler)) 4458 (with-timeout (10 (tramp--test-timeout-handler))
4406 (while (< (- (point-max) (point-min)) (length "foo")) 4459 (while (< (- (point-max) (point-min)) (length "foo"))
4407 (while (accept-process-output proc 0 nil t)))) 4460 (while (accept-process-output proc 0 nil t))))
4408 (should (string-match "foo" (buffer-string)))) 4461 (should (string-match-p "foo" (buffer-string))))
4409 4462
4410 ;; Cleanup. 4463 ;; Cleanup.
4411 (ignore-errors (delete-process proc))) 4464 (ignore-errors (delete-process proc)))
@@ -4424,7 +4477,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4424 (with-timeout (10 (tramp--test-timeout-handler)) 4477 (with-timeout (10 (tramp--test-timeout-handler))
4425 (while (< (- (point-max) (point-min)) (length "foo")) 4478 (while (< (- (point-max) (point-min)) (length "foo"))
4426 (while (accept-process-output proc 0 nil t)))) 4479 (while (accept-process-output proc 0 nil t))))
4427 (should (string-match "foo" (buffer-string)))) 4480 (should (string-match-p "foo" (buffer-string))))
4428 4481
4429 ;; Cleanup. 4482 ;; Cleanup.
4430 (ignore-errors 4483 (ignore-errors
@@ -4446,7 +4499,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4446 (with-timeout (10 (tramp--test-timeout-handler)) 4499 (with-timeout (10 (tramp--test-timeout-handler))
4447 (while (< (- (point-max) (point-min)) (length "foo")) 4500 (while (< (- (point-max) (point-min)) (length "foo"))
4448 (while (accept-process-output proc 0 nil t)))) 4501 (while (accept-process-output proc 0 nil t))))
4449 (should (string-match "foo" (buffer-string)))) 4502 (should (string-match-p "foo" (buffer-string))))
4450 4503
4451 ;; Cleanup. 4504 ;; Cleanup.
4452 (ignore-errors (delete-process proc))) 4505 (ignore-errors (delete-process proc)))
@@ -4488,8 +4541,6 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
4488 (cons '(nil "direct-async-process" t) 4541 (cons '(nil "direct-async-process" t)
4489 tramp-connection-properties))) 4542 tramp-connection-properties)))
4490 (skip-unless (tramp-direct-async-process-p)) 4543 (skip-unless (tramp-direct-async-process-p))
4491 ;; For whatever reason, it doesn't cooperate with the "mock" method.
4492 (skip-unless (not (tramp--test-mock-p)))
4493 ;; We do expect an established connection already, 4544 ;; We do expect an established connection already,
4494 ;; `file-truename' does it by side-effect. Suppress 4545 ;; `file-truename' does it by side-effect. Suppress
4495 ;; `tramp--test-enabled', in order to keep the connection. 4546 ;; `tramp--test-enabled', in order to keep the connection.
@@ -4535,7 +4586,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
4535 (with-timeout (10 (tramp--test-timeout-handler)) 4586 (with-timeout (10 (tramp--test-timeout-handler))
4536 (while (< (- (point-max) (point-min)) (length "foo")) 4587 (while (< (- (point-max) (point-min)) (length "foo"))
4537 (while (accept-process-output proc 0 nil t)))) 4588 (while (accept-process-output proc 0 nil t))))
4538 (should (string-match "foo" (buffer-string)))) 4589 (should (string-match-p "foo" (buffer-string))))
4539 4590
4540 ;; Cleanup. 4591 ;; Cleanup.
4541 (ignore-errors (delete-process proc))) 4592 (ignore-errors (delete-process proc)))
@@ -4556,7 +4607,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
4556 (with-timeout (10 (tramp--test-timeout-handler)) 4607 (with-timeout (10 (tramp--test-timeout-handler))
4557 (while (< (- (point-max) (point-min)) (length "foo")) 4608 (while (< (- (point-max) (point-min)) (length "foo"))
4558 (while (accept-process-output proc 0 nil t)))) 4609 (while (accept-process-output proc 0 nil t))))
4559 (should (string-match "foo" (buffer-string)))) 4610 (should (string-match-p "foo" (buffer-string))))
4560 4611
4561 ;; Cleanup. 4612 ;; Cleanup.
4562 (ignore-errors 4613 (ignore-errors
@@ -4580,9 +4631,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
4580 (process-send-eof proc) 4631 (process-send-eof proc)
4581 ;; Read output. 4632 ;; Read output.
4582 (with-timeout (10 (tramp--test-timeout-handler)) 4633 (with-timeout (10 (tramp--test-timeout-handler))
4583 (while (not (string-match "foo" (buffer-string))) 4634 (while (not (string-match-p "foo" (buffer-string)))
4584 (while (accept-process-output proc 0 nil t)))) 4635 (while (accept-process-output proc 0 nil t))))
4585 (should (string-match "foo" (buffer-string)))) 4636 (should (string-match-p "foo" (buffer-string))))
4586 4637
4587 ;; Cleanup. 4638 ;; Cleanup.
4588 (ignore-errors (delete-process proc))) 4639 (ignore-errors (delete-process proc)))
@@ -4607,7 +4658,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
4607 (with-timeout (10 (tramp--test-timeout-handler)) 4658 (with-timeout (10 (tramp--test-timeout-handler))
4608 (while (accept-process-output proc 0 nil t))) 4659 (while (accept-process-output proc 0 nil t)))
4609 ;; On some MS Windows systems, it returns "unknown signal". 4660 ;; On some MS Windows systems, it returns "unknown signal".
4610 (should (string-match "unknown signal\\|killed" (buffer-string)))) 4661 (should (string-match-p "unknown signal\\|killed" (buffer-string))))
4611 4662
4612 ;; Cleanup. 4663 ;; Cleanup.
4613 (ignore-errors (delete-process proc))) 4664 (ignore-errors (delete-process proc)))
@@ -4631,7 +4682,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
4631 (delete-process proc) 4682 (delete-process proc)
4632 (with-current-buffer stderr 4683 (with-current-buffer stderr
4633 (should 4684 (should
4634 (string-match 4685 (string-match-p
4635 "cat:.* No such file or directory" (buffer-string))))) 4686 "cat:.* No such file or directory" (buffer-string)))))
4636 4687
4637 ;; Cleanup. 4688 ;; Cleanup.
@@ -4658,7 +4709,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
4658 (with-temp-buffer 4709 (with-temp-buffer
4659 (insert-file-contents tmpfile) 4710 (insert-file-contents tmpfile)
4660 (should 4711 (should
4661 (string-match 4712 (string-match-p
4662 "cat:.* No such file or directory" (buffer-string))))) 4713 "cat:.* No such file or directory" (buffer-string)))))
4663 4714
4664 ;; Cleanup. 4715 ;; Cleanup.
@@ -4801,7 +4852,7 @@ INPUT, if non-nil, is a string sent to the process."
4801 (should 4852 (should
4802 (string-equal 4853 (string-equal
4803 ;; tramp-adb.el echoes, so we must add the string. 4854 ;; tramp-adb.el echoes, so we must add the string.
4804 (if (tramp--test-adb-p) 4855 (if (and (tramp--test-adb-p) (not (tramp-direct-async-process-p)))
4805 (format 4856 (format
4806 "%s\n%s\n" 4857 "%s\n%s\n"
4807 (file-name-nondirectory tmp-name) 4858 (file-name-nondirectory tmp-name)
@@ -4992,7 +5043,7 @@ INPUT, if non-nil, is a string sent to the process."
4992 (cons (concat envvar "=foo") process-environment))) 5043 (cons (concat envvar "=foo") process-environment)))
4993 ;; Default value. 5044 ;; Default value.
4994 (should 5045 (should
4995 (string-match 5046 (string-match-p
4996 "foo" 5047 "foo"
4997 (funcall 5048 (funcall
4998 this-shell-command-to-string 5049 this-shell-command-to-string
@@ -5003,13 +5054,13 @@ INPUT, if non-nil, is a string sent to the process."
5003 (cons (concat envvar "=") process-environment))) 5054 (cons (concat envvar "=") process-environment)))
5004 ;; Value is null. 5055 ;; Value is null.
5005 (should 5056 (should
5006 (string-match 5057 (string-match-p
5007 "bla" 5058 "bla"
5008 (funcall 5059 (funcall
5009 this-shell-command-to-string (format "echo \"${%s:-bla}\"" envvar)))) 5060 this-shell-command-to-string (format "echo \"${%s:-bla}\"" envvar))))
5010 ;; Variable is set. 5061 ;; Variable is set.
5011 (should 5062 (should
5012 (string-match 5063 (string-match-p
5013 (regexp-quote envvar) 5064 (regexp-quote envvar)
5014 (funcall this-shell-command-to-string "set")))) 5065 (funcall this-shell-command-to-string "set"))))
5015 5066
@@ -5021,7 +5072,7 @@ INPUT, if non-nil, is a string sent to the process."
5021 (cons (concat envvar "=foo") tramp-remote-process-environment))) 5072 (cons (concat envvar "=foo") tramp-remote-process-environment)))
5022 ;; Set the initial value, we want to unset below. 5073 ;; Set the initial value, we want to unset below.
5023 (should 5074 (should
5024 (string-match 5075 (string-match-p
5025 "foo" 5076 "foo"
5026 (funcall 5077 (funcall
5027 this-shell-command-to-string 5078 this-shell-command-to-string
@@ -5029,14 +5080,14 @@ INPUT, if non-nil, is a string sent to the process."
5029 (let ((process-environment (cons envvar process-environment))) 5080 (let ((process-environment (cons envvar process-environment)))
5030 ;; Variable is unset. 5081 ;; Variable is unset.
5031 (should 5082 (should
5032 (string-match 5083 (string-match-p
5033 "bla" 5084 "bla"
5034 (funcall 5085 (funcall
5035 this-shell-command-to-string 5086 this-shell-command-to-string
5036 (format "echo \"${%s:-bla}\"" envvar)))) 5087 (format "echo \"${%s:-bla}\"" envvar))))
5037 ;; Variable is unset. 5088 ;; Variable is unset.
5038 (should-not 5089 (should-not
5039 (string-match 5090 (string-match-p
5040 (regexp-quote envvar) 5091 (regexp-quote envvar)
5041 ;; We must remove PS1, the output is truncated otherwise. 5092 ;; We must remove PS1, the output is truncated otherwise.
5042 (funcall 5093 (funcall
@@ -5074,7 +5125,7 @@ Use direct async.")
5074 (format "%s=%d" envvar port) 5125 (format "%s=%d" envvar port)
5075 tramp-remote-process-environment))) 5126 tramp-remote-process-environment)))
5076 (should 5127 (should
5077 (string-match 5128 (string-match-p
5078 (number-to-string port) 5129 (number-to-string port)
5079 (shell-command-to-string (format "echo $%s" envvar)))))) 5130 (shell-command-to-string (format "echo $%s" envvar))))))
5080 5131
@@ -5202,7 +5253,7 @@ Use direct async.")
5202 (with-timeout (10) 5253 (with-timeout (10)
5203 (while (accept-process-output 5254 (while (accept-process-output
5204 (get-buffer-process (current-buffer)) nil nil t))) 5255 (get-buffer-process (current-buffer)) nil nil t)))
5205 (should (string-match "^foo$" (buffer-string))))) 5256 (should (string-match-p "^foo$" (buffer-string)))))
5206 5257
5207 ;; Cleanup. 5258 ;; Cleanup.
5208 (put 'explicit-shell-file-name 'permanent-local nil) 5259 (put 'explicit-shell-file-name 'permanent-local nil)
@@ -5337,25 +5388,27 @@ Use direct async.")
5337 (tramp-remote-process-environment tramp-remote-process-environment) 5388 (tramp-remote-process-environment tramp-remote-process-environment)
5338 (inhibit-message t) 5389 (inhibit-message t)
5339 (vc-handled-backends 5390 (vc-handled-backends
5340 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil 5391 (cond
5341 (cond 5392 ((tramp-find-executable
5342 ((tramp-find-executable 5393 tramp-test-vec vc-git-program
5343 v vc-git-program (tramp-get-remote-path v)) 5394 (tramp-get-remote-path tramp-test-vec))
5344 '(Git)) 5395 '(Git))
5345 ((tramp-find-executable 5396 ((tramp-find-executable
5346 v vc-hg-program (tramp-get-remote-path v)) 5397 tramp-test-vec vc-hg-program
5347 '(Hg)) 5398 (tramp-get-remote-path tramp-test-vec))
5348 ((tramp-find-executable 5399 '(Hg))
5349 v vc-bzr-program (tramp-get-remote-path v)) 5400 ((tramp-find-executable
5350 (setq tramp-remote-process-environment 5401 tramp-test-vec vc-bzr-program
5351 (cons (format "BZR_HOME=%s" 5402 (tramp-get-remote-path tramp-test-vec))
5352 (file-remote-p tmp-name1 'localname)) 5403 (setq tramp-remote-process-environment
5353 tramp-remote-process-environment)) 5404 (cons (format "BZR_HOME=%s"
5354 ;; We must force a reconnect, in order to activate $BZR_HOME. 5405 (file-remote-p tmp-name1 'localname))
5355 (tramp-cleanup-connection 5406 tramp-remote-process-environment))
5356 tramp-test-vec 'keep-debug 'keep-password) 5407 ;; We must force a reconnect, in order to activate $BZR_HOME.
5357 '(Bzr)) 5408 (tramp-cleanup-connection
5358 (t nil)))) 5409 tramp-test-vec 'keep-debug 'keep-password)
5410 '(Bzr))
5411 (t nil)))
5359 ;; Suppress nasty messages. 5412 ;; Suppress nasty messages.
5360 (inhibit-message t)) 5413 (inhibit-message t))
5361 (skip-unless vc-handled-backends) 5414 (skip-unless vc-handled-backends)
@@ -5681,7 +5734,7 @@ This does not support some special file names."
5681 "Check, whether an FTP-like method is used. 5734 "Check, whether an FTP-like method is used.
5682This does not support globbing characters in file names (yet)." 5735This does not support globbing characters in file names (yet)."
5683 ;; Globbing characters are ??, ?* and ?\[. 5736 ;; Globbing characters are ??, ?* and ?\[.
5684 (string-match 5737 (string-match-p
5685 "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method))) 5738 "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
5686 5739
5687(defun tramp--test-gvfs-p (&optional method) 5740(defun tramp--test-gvfs-p (&optional method)
@@ -5695,18 +5748,18 @@ If optional METHOD is given, it is checked first."
5695 "Check, whether the remote host runs HP-UX. 5748 "Check, whether the remote host runs HP-UX.
5696Several special characters do not work properly there." 5749Several special characters do not work properly there."
5697 ;; We must refill the cache. `file-truename' does it. 5750 ;; We must refill the cache. `file-truename' does it.
5698 (with-parsed-tramp-file-name 5751 (file-truename tramp-test-temporary-file-directory) nil
5699 (file-truename tramp-test-temporary-file-directory) nil 5752 (string-match-p
5700 (string-match "^HP-UX" (tramp-get-connection-property v "uname" "")))) 5753 "^HP-UX" (tramp-get-connection-property tramp-test-vec "uname" "")))
5701 5754
5702(defun tramp--test-ksh-p () 5755(defun tramp--test-ksh-p ()
5703 "Check, whether the remote shell is ksh. 5756 "Check, whether the remote shell is ksh.
5704ksh93 makes some strange conversions of non-latin characters into 5757ksh93 makes some strange conversions of non-latin characters into
5705a $'' syntax." 5758a $'' syntax."
5706 ;; We must refill the cache. `file-truename' does it. 5759 ;; We must refill the cache. `file-truename' does it.
5707 (with-parsed-tramp-file-name 5760 (file-truename tramp-test-temporary-file-directory) nil
5708 (file-truename tramp-test-temporary-file-directory) nil 5761 (string-match-p
5709 (string-match "ksh$" (tramp-get-connection-property v "remote-shell" "")))) 5762 "ksh$" (tramp-get-connection-property tramp-test-vec "remote-shell" "")))
5710 5763
5711(defun tramp--test-mock-p () 5764(defun tramp--test-mock-p ()
5712 "Check, whether the mock method is used. 5765 "Check, whether the mock method is used.
@@ -5758,7 +5811,7 @@ This does not support special characters."
5758 "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used. 5811 "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
5759This does not support utf8 based file transfer." 5812This does not support utf8 based file transfer."
5760 (and (eq system-type 'windows-nt) 5813 (and (eq system-type 'windows-nt)
5761 (string-match 5814 (string-match-p
5762 (regexp-opt '("pscp" "psftp")) 5815 (regexp-opt '("pscp" "psftp"))
5763 (file-remote-p tramp-test-temporary-file-directory 'method)))) 5816 (file-remote-p tramp-test-temporary-file-directory 'method))))
5764 5817
@@ -6021,6 +6074,7 @@ This requires restrictions of file name syntax."
6021 (skip-unless (tramp--test-enabled)) 6074 (skip-unless (tramp--test-enabled))
6022 (skip-unless (not (tramp--test-rsync-p))) 6075 (skip-unless (not (tramp--test-rsync-p)))
6023 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) 6076 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
6077 (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
6024 6078
6025 (tramp--test-special-characters)) 6079 (tramp--test-special-characters))
6026 6080
@@ -6032,6 +6086,8 @@ Use the `stat' command."
6032 (skip-unless (tramp--test-sh-p)) 6086 (skip-unless (tramp--test-sh-p))
6033 (skip-unless (not (tramp--test-rsync-p))) 6087 (skip-unless (not (tramp--test-rsync-p)))
6034 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) 6088 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
6089 (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
6090 ;; We cannot use `tramp-test-vec', because this fails during compilation.
6035 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil 6091 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
6036 (skip-unless (tramp-get-remote-stat v))) 6092 (skip-unless (tramp-get-remote-stat v)))
6037 6093
@@ -6050,6 +6106,8 @@ Use the `perl' command."
6050 (skip-unless (tramp--test-sh-p)) 6106 (skip-unless (tramp--test-sh-p))
6051 (skip-unless (not (tramp--test-rsync-p))) 6107 (skip-unless (not (tramp--test-rsync-p)))
6052 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) 6108 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
6109 (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
6110 ;; We cannot use `tramp-test-vec', because this fails during compilation.
6053 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil 6111 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
6054 (skip-unless (tramp-get-remote-perl v))) 6112 (skip-unless (tramp-get-remote-perl v)))
6055 6113
@@ -6072,6 +6130,7 @@ Use the `ls' command."
6072 (skip-unless (not (tramp--test-rsync-p))) 6130 (skip-unless (not (tramp--test-rsync-p)))
6073 (skip-unless (not (tramp--test-windows-nt-and-batch-p))) 6131 (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
6074 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) 6132 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
6133 (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
6075 6134
6076 (let ((tramp-connection-properties 6135 (let ((tramp-connection-properties
6077 (append 6136 (append
@@ -6140,6 +6199,7 @@ Use the `ls' command."
6140 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) 6199 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
6141 (skip-unless (not (tramp--test-ksh-p))) 6200 (skip-unless (not (tramp--test-ksh-p)))
6142 (skip-unless (not (tramp--test-crypt-p))) 6201 (skip-unless (not (tramp--test-crypt-p)))
6202 (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
6143 6203
6144 (tramp--test-utf8)) 6204 (tramp--test-utf8))
6145 6205
@@ -6155,6 +6215,8 @@ Use the `stat' command."
6155 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) 6215 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
6156 (skip-unless (not (tramp--test-ksh-p))) 6216 (skip-unless (not (tramp--test-ksh-p)))
6157 (skip-unless (not (tramp--test-crypt-p))) 6217 (skip-unless (not (tramp--test-crypt-p)))
6218 (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
6219 ;; We cannot use `tramp-test-vec', because this fails during compilation.
6158 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil 6220 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
6159 (skip-unless (tramp-get-remote-stat v))) 6221 (skip-unless (tramp-get-remote-stat v)))
6160 6222
@@ -6177,6 +6239,8 @@ Use the `perl' command."
6177 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) 6239 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
6178 (skip-unless (not (tramp--test-ksh-p))) 6240 (skip-unless (not (tramp--test-ksh-p)))
6179 (skip-unless (not (tramp--test-crypt-p))) 6241 (skip-unless (not (tramp--test-crypt-p)))
6242 (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
6243 ;; We cannot use `tramp-test-vec', because this fails during compilation.
6180 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil 6244 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
6181 (skip-unless (tramp-get-remote-perl v))) 6245 (skip-unless (tramp-get-remote-perl v)))
6182 6246
@@ -6202,6 +6266,7 @@ Use the `ls' command."
6202 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) 6266 (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
6203 (skip-unless (not (tramp--test-ksh-p))) 6267 (skip-unless (not (tramp--test-ksh-p)))
6204 (skip-unless (not (tramp--test-crypt-p))) 6268 (skip-unless (not (tramp--test-crypt-p)))
6269 (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
6205 6270
6206 (let ((tramp-connection-properties 6271 (let ((tramp-connection-properties
6207 (append 6272 (append
@@ -6490,7 +6555,7 @@ process sentinels. They shall not disturb each other."
6490 (message \"Tramp loaded: %%s\" (and (file-remote-p %S) t)))" 6555 (message \"Tramp loaded: %%s\" (and (file-remote-p %S) t)))"
6491 tramp-test-temporary-file-directory))) 6556 tramp-test-temporary-file-directory)))
6492 (should 6557 (should
6493 (string-match 6558 (string-match-p
6494 "Tramp loaded: t[\n\r]+" 6559 "Tramp loaded: t[\n\r]+"
6495 (shell-command-to-string 6560 (shell-command-to-string
6496 (format 6561 (format
@@ -6521,7 +6586,7 @@ process sentinels. They shall not disturb each other."
6521 ;; Tramp doesn't load when `tramp-mode' is nil. 6586 ;; Tramp doesn't load when `tramp-mode' is nil.
6522 (dolist (tm '(t nil)) 6587 (dolist (tm '(t nil))
6523 (should 6588 (should
6524 (string-match 6589 (string-match-p
6525 (format 6590 (format
6526 "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+" 6591 "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+"
6527 tm) 6592 tm)
@@ -6547,7 +6612,7 @@ process sentinels. They shall not disturb each other."
6547 tramp-test-temporary-file-directory 6612 tramp-test-temporary-file-directory
6548 temporary-file-directory))) 6613 temporary-file-directory)))
6549 (should-not 6614 (should-not
6550 (string-match 6615 (string-match-p
6551 "Recursive load" 6616 "Recursive load"
6552 (shell-command-to-string 6617 (shell-command-to-string
6553 (format 6618 (format
@@ -6572,7 +6637,7 @@ process sentinels. They shall not disturb each other."
6572 (load-path (cons \"/foo:bar:\" load-path))) \ 6637 (load-path (cons \"/foo:bar:\" load-path))) \
6573 (tramp-cleanup-all-connections))")) 6638 (tramp-cleanup-all-connections))"))
6574 (should 6639 (should
6575 (string-match 6640 (string-match-p
6576 (format 6641 (format
6577 "Loading %s" 6642 "Loading %s"
6578 (regexp-quote 6643 (regexp-quote
@@ -6619,11 +6684,11 @@ Since it unloads Tramp, it shall be the last test to run."
6619 (lambda (x) 6684 (lambda (x)
6620 (and (or (and (boundp x) (null (local-variable-if-set-p x))) 6685 (and (or (and (boundp x) (null (local-variable-if-set-p x)))
6621 (and (functionp x) (null (autoloadp (symbol-function x))))) 6686 (and (functionp x) (null (autoloadp (symbol-function x)))))
6622 (string-match "^tramp" (symbol-name x)) 6687 (string-match-p "^tramp" (symbol-name x))
6623 ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1. 6688 ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1.
6624 (not (eq 'tramp-completion-mode x)) 6689 (not (eq 'tramp-completion-mode x))
6625 (not (string-match "^tramp\\(-archive\\)?--?test" (symbol-name x))) 6690 (not (string-match-p "^tramp\\(-archive\\)?--?test" (symbol-name x)))
6626 (not (string-match "unload-hook$" (symbol-name x))) 6691 (not (string-match-p "unload-hook$" (symbol-name x)))
6627 (ert-fail (format "`%s' still bound" x))))) 6692 (ert-fail (format "`%s' still bound" x)))))
6628 ;; The defstruct `tramp-file-name' and all its internal functions 6693 ;; The defstruct `tramp-file-name' and all its internal functions
6629 ;; shall be purged. 6694 ;; shall be purged.
@@ -6631,15 +6696,15 @@ Since it unloads Tramp, it shall be the last test to run."
6631 (mapatoms 6696 (mapatoms
6632 (lambda (x) 6697 (lambda (x)
6633 (and (functionp x) 6698 (and (functionp x)
6634 (string-match "tramp-file-name" (symbol-name x)) 6699 (string-match-p "tramp-file-name" (symbol-name x))
6635 (ert-fail (format "Structure function `%s' still exists" x))))) 6700 (ert-fail (format "Structure function `%s' still exists" x)))))
6636 ;; There shouldn't be left a hook function containing a Tramp 6701 ;; There shouldn't be left a hook function containing a Tramp
6637 ;; function. We do not regard the Tramp unload hooks. 6702 ;; function. We do not regard the Tramp unload hooks.
6638 (mapatoms 6703 (mapatoms
6639 (lambda (x) 6704 (lambda (x)
6640 (and (boundp x) 6705 (and (boundp x)
6641 (string-match "-\\(hook\\|function\\)s?$" (symbol-name x)) 6706 (string-match-p "-\\(hook\\|function\\)s?$" (symbol-name x))
6642 (not (string-match "unload-hook$" (symbol-name x))) 6707 (not (string-match-p "unload-hook$" (symbol-name x)))
6643 (consp (symbol-value x)) 6708 (consp (symbol-value x))
6644 (ignore-errors (all-completions "tramp" (symbol-value x))) 6709 (ignore-errors (all-completions "tramp" (symbol-value x)))
6645 (ert-fail (format "Hook `%s' still contains Tramp function" x)))))) 6710 (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 8ff85470ece..cf1ed2896e4 100644
--- a/test/lisp/progmodes/tcl-tests.el
+++ b/test/lisp/progmodes/tcl-tests.el
@@ -50,14 +50,14 @@
50 (insert "proc notinthis {} {\n # nothing\n}\n\n") 50 (insert "proc notinthis {} {\n # nothing\n}\n\n")
51 (should-not (add-log-current-defun)))) 51 (should-not (add-log-current-defun))))
52 52
53(ert-deftest tcl-mode-function-name () 53(ert-deftest tcl-mode-function-name-2 ()
54 (with-temp-buffer 54 (with-temp-buffer
55 (tcl-mode) 55 (tcl-mode)
56 (insert "proc simple {} {\n # nothing\n}") 56 (insert "proc simple {} {\n # nothing\n}")
57 (backward-char 3) 57 (backward-char 3)
58 (should (equal "simple" (add-log-current-defun))))) 58 (should (equal "simple" (add-log-current-defun)))))
59 59
60(ert-deftest tcl-mode-function-name () 60(ert-deftest tcl-mode-function-name-3 ()
61 (with-temp-buffer 61 (with-temp-buffer
62 (tcl-mode) 62 (tcl-mode)
63 (insert "proc inthis {} {\n # nothing\n") 63 (insert "proc inthis {} {\n # nothing\n")
@@ -72,6 +72,16 @@
72 (indent-region (point-min) (point-max)) 72 (indent-region (point-min) (point-max))
73 (should (equal (buffer-string) text))))) 73 (should (equal (buffer-string) text)))))
74 74
75;; From bug#44834
76(ert-deftest tcl-mode-namespace-indent-2 ()
77 :expected-result :failed
78 (with-temp-buffer
79 (tcl-mode)
80 (let ((text "namespace eval Foo {\n proc foo {} {}\n\n proc bar {}{}}\n"))
81 (insert text)
82 (indent-region (point-min) (point-max))
83 (should (equal (buffer-string) text)))))
84
75(provide 'tcl-tests) 85(provide 'tcl-tests)
76 86
77;;; tcl-tests.el ends here 87;;; tcl-tests.el ends here
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 245a4a7c3af..843981fe8e8 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -87,6 +87,17 @@
87 ;; Returns the symbol. 87 ;; Returns the symbol.
88 (should (eq (define-prefix-command 'foo-bar) 'foo-bar))) 88 (should (eq (define-prefix-command 'foo-bar) 'foo-bar)))
89 89
90(ert-deftest subr-test-local-key-binding ()
91 (with-temp-buffer
92 (emacs-lisp-mode)
93 (should (keymapp (local-key-binding [menu-bar])))
94 (should-not (local-key-binding [f12]))))
95
96(ert-deftest subr-test-global-key-binding ()
97 (should (eq (global-key-binding [f1]) 'help-command))
98 (should (eq (global-key-binding "x") 'self-insert-command))
99 (should-not (global-key-binding [f12])))
100
90 101
91;;;; Mode hooks. 102;;;; Mode hooks.
92 103
@@ -433,6 +444,15 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
433 (should (equal (flatten-tree '(1 ("foo" "bar") 2)) 444 (should (equal (flatten-tree '(1 ("foo" "bar") 2))
434 '(1 "foo" "bar" 2)))) 445 '(1 "foo" "bar" 2))))
435 446
447(ert-deftest subr--tests-letrec ()
448 ;; Test that simple cases of `letrec' get optimized back to `let*'.
449 (should (equal (macroexpand '(letrec ((subr-tests-var1 1)
450 (subr-tests-var2 subr-tests-var1))
451 (+ subr-tests-var1 subr-tests-var2)))
452 '(let* ((subr-tests-var1 1)
453 (subr-tests-var2 subr-tests-var1))
454 (+ subr-tests-var1 subr-tests-var2)))))
455
436(defvar subr-tests--hook nil) 456(defvar subr-tests--hook nil)
437 457
438(ert-deftest subr-tests-add-hook-depth () 458(ert-deftest subr-tests-add-hook-depth ()
diff --git a/test/lisp/textmodes/fill-tests.el b/test/lisp/textmodes/fill-tests.el
index f2c63a93d3e..21efe620999 100644
--- a/test/lisp/textmodes/fill-tests.el
+++ b/test/lisp/textmodes/fill-tests.el
@@ -44,6 +44,37 @@
44 (fill-paragraph) 44 (fill-paragraph)
45 (should (string= (buffer-string) "Abc\nd efg\n(h ijk).")))) 45 (should (string= (buffer-string) "Abc\nd efg\n(h ijk)."))))
46 46
47(ert-deftest fill-test-unbreakable-paragraph ()
48 (with-temp-buffer
49 (let ((string "aaa = baaaaaaaaaaaaaaaaaaaaaaaaaaaa\n"))
50 (insert string)
51 (goto-char (point-min))
52 (search-forward "b")
53 (let* ((pos (point))
54 (beg (line-beginning-position))
55 (end (line-end-position))
56 (fill-prefix (make-string (- pos beg) ?\s))
57 ;; `fill-column' is too small to accomodate the current line
58 (fill-column (- end beg 10)))
59 (fill-region-as-paragraph beg end nil nil pos))
60 (should (equal (buffer-string) string)))))
61
62(ert-deftest fill-test-breakable-paragraph ()
63 (with-temp-buffer
64 (let ((string "aaa = baaaaaaaa aaaaaaaaaa aaaaaaaaaa\n"))
65 (insert string)
66 (goto-char (point-min))
67 (search-forward "b")
68 (let* ((pos (point))
69 (beg (line-beginning-position))
70 (end (line-end-position))
71 (fill-prefix (make-string (- pos beg) ?\s))
72 ;; `fill-column' is too small to accomodate the current line
73 (fill-column (- end beg 10)))
74 (fill-region-as-paragraph beg end nil nil pos))
75 (should (equal
76 (buffer-string)
77 "aaa = baaaaaaaa aaaaaaaaaa\n aaaaaaaaaa\n")))))
47 78
48(provide 'fill-tests) 79(provide 'fill-tests)
49 80
diff --git a/test/src/decompress-tests.el b/test/src/decompress-tests.el
index 67a7fefb05e..520445cca5a 100644
--- a/test/src/decompress-tests.el
+++ b/test/src/decompress-tests.el
@@ -29,16 +29,16 @@
29 29
30(ert-deftest zlib--decompress () 30(ert-deftest zlib--decompress ()
31 "Test decompressing a gzipped file." 31 "Test decompressing a gzipped file."
32 (when (and (fboundp 'zlib-available-p) 32 (skip-unless (and (fboundp 'zlib-available-p)
33 (zlib-available-p)) 33 (zlib-available-p)))
34 (should (string= 34 (should (string=
35 (with-temp-buffer 35 (with-temp-buffer
36 (set-buffer-multibyte nil) 36 (set-buffer-multibyte nil)
37 (insert-file-contents-literally 37 (insert-file-contents-literally
38 (expand-file-name "foo.gz" zlib-tests-data-directory)) 38 (expand-file-name "foo.gz" zlib-tests-data-directory))
39 (zlib-decompress-region (point-min) (point-max)) 39 (zlib-decompress-region (point-min) (point-max))
40 (buffer-string)) 40 (buffer-string))
41 "foo\n")))) 41 "foo\n")))
42 42
43(provide 'decompress-tests) 43(provide 'decompress-tests)
44 44
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index a9daf878b81..e0aed2a71b6 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -1040,3 +1040,61 @@
1040 (let ((list (list 1))) 1040 (let ((list (list 1)))
1041 (setcdr list list) 1041 (setcdr list list)
1042 (length< list #x1fffe)))) 1042 (length< list #x1fffe))))
1043
1044(defun approx-equal (list1 list2)
1045 (and (equal (length list1) (length list2))
1046 (cl-loop for v1 in list1
1047 for v2 in list2
1048 when (not (or (= v1 v2)
1049 (< (abs (- v1 v2)) 0.1)))
1050 return nil
1051 finally return t)))
1052
1053(ert-deftest test-buffer-line-stats-nogap ()
1054 (with-temp-buffer
1055 (insert "")
1056 (should (approx-equal (buffer-line-statistics) '(0 0 0))))
1057 (with-temp-buffer
1058 (insert "123\n")
1059 (should (approx-equal (buffer-line-statistics) '(1 3 3))))
1060 (with-temp-buffer
1061 (insert "123\n12345\n123\n")
1062 (should (approx-equal (buffer-line-statistics) '(3 5 3.66))))
1063 (with-temp-buffer
1064 (insert "123\n12345\n123")
1065 (should (approx-equal (buffer-line-statistics) '(3 5 3.66))))
1066 (with-temp-buffer
1067 (insert "123\n12345")
1068 (should (approx-equal (buffer-line-statistics) '(2 5 4))))
1069
1070 (with-temp-buffer
1071 (insert "123\n12é45\n123\n")
1072 (should (approx-equal (buffer-line-statistics) '(3 6 4))))
1073
1074 (with-temp-buffer
1075 (insert "\n\n\n")
1076 (should (approx-equal (buffer-line-statistics) '(3 0 0)))))
1077
1078(ert-deftest test-buffer-line-stats-gap ()
1079 (with-temp-buffer
1080 (dotimes (_ 1000)
1081 (insert "12345678901234567890123456789012345678901234567890\n"))
1082 (goto-char (point-min))
1083 ;; This should make a gap appear.
1084 (insert "123\n")
1085 (delete-region (point-min) (point))
1086 (should (approx-equal (buffer-line-statistics) '(1000 50 50.0))))
1087 (with-temp-buffer
1088 (dotimes (_ 1000)
1089 (insert "12345678901234567890123456789012345678901234567890\n"))
1090 (goto-char (point-min))
1091 (insert "123\n")
1092 (should (approx-equal (buffer-line-statistics) '(1001 50 49.9))))
1093 (with-temp-buffer
1094 (dotimes (_ 1000)
1095 (insert "12345678901234567890123456789012345678901234567890\n"))
1096 (goto-char (point-min))
1097 (insert "123\n")
1098 (goto-char (point-max))
1099 (insert "fóo")
1100 (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 edf88214f97..f2a60bcf327 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -190,4 +190,10 @@ literals (Bug#20852)."
190(ert-deftest lread-circular-hash () 190(ert-deftest lread-circular-hash ()
191 (should-error (read "#s(hash-table data #0=(#0# . #0#))"))) 191 (should-error (read "#s(hash-table data #0=(#0# . #0#))")))
192 192
193(ert-deftest test-inhibit-interaction ()
194 (let ((inhibit-interaction t))
195 (should-error (read-char "foo: "))
196 (should-error (read-event "foo: "))
197 (should-error (read-char-exclusive "foo: "))))
198
193;;; lread-tests.el ends here 199;;; lread-tests.el ends here
diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el
index b9cd255462d..28119fc999e 100644
--- a/test/src/minibuf-tests.el
+++ b/test/src/minibuf-tests.el
@@ -410,5 +410,20 @@
410 (should (equal (try-completion "baz" '("bAz" "baz")) 410 (should (equal (try-completion "baz" '("bAz" "baz"))
411 (try-completion "baz" '("baz" "bAz")))))) 411 (try-completion "baz" '("baz" "bAz"))))))
412 412
413(ert-deftest test-inhibit-interaction ()
414 (let ((inhibit-interaction t))
415 (should-error (read-from-minibuffer "foo: "))
416
417 (should-error (y-or-n-p "foo: "))
418 (should-error (yes-or-no-p "foo: "))
419 (should-error (read-blanks-no-input "foo: "))
420
421 ;; See that we get the expected error.
422 (should (eq (condition-case nil
423 (read-from-minibuffer "foo: ")
424 (inhibited-interaction 'inhibit)
425 (error nil))
426 'inhibit))))
427
413 428
414;;; minibuf-tests.el ends here 429;;; minibuf-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index ca98f54bdb1..57097cfa052 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -28,6 +28,7 @@
28(require 'puny) 28(require 'puny)
29(require 'rx) 29(require 'rx)
30(require 'subr-x) 30(require 'subr-x)
31(require 'dns)
31 32
32;; Timeout in seconds; the test fails if the timeout is reached. 33;; Timeout in seconds; the test fails if the timeout is reached.
33(defvar process-test-sentinel-wait-timeout 2.0) 34(defvar process-test-sentinel-wait-timeout 2.0)
@@ -350,14 +351,23 @@ See Bug#30460."
350;; All the following tests require working DNS, which appears not to 351;; All the following tests require working DNS, which appears not to
351;; be the case for hydra.nixos.org, so disable them there for now. 352;; be the case for hydra.nixos.org, so disable them there for now.
352 353
354;; This will need updating when IANA assign more IPv6 global ranges.
355(defun ipv6-is-available ()
356 (and (featurep 'make-network-process '(:family ipv6))
357 (cl-rassoc-if
358 (lambda (elt)
359 (and (eq 9 (length elt))
360 (= (logand (aref elt 0) #xe000) #x2000)))
361 (network-interface-list))))
362
353(ert-deftest lookup-family-specification () 363(ert-deftest lookup-family-specification ()
354 "`network-lookup-address-info' should only accept valid family symbols." 364 "`network-lookup-address-info' should only accept valid family symbols."
355 (skip-unless (not (getenv "EMACS_HYDRA_CI"))) 365 (skip-unless (not (getenv "EMACS_HYDRA_CI")))
356 (with-timeout (60 (ert-fail "Test timed out")) 366 (with-timeout (60 (ert-fail "Test timed out"))
357 (should-error (network-lookup-address-info "google.com" 'both)) 367 (should-error (network-lookup-address-info "localhost" 'both))
358 (should (network-lookup-address-info "google.com" 'ipv4)) 368 (should (network-lookup-address-info "localhost" 'ipv4))
359 (when (featurep 'make-network-process '(:family ipv6)) 369 (when (ipv6-is-available)
360 (should (network-lookup-address-info "google.com" 'ipv6))))) 370 (should (network-lookup-address-info "localhost" 'ipv6)))))
361 371
362(ert-deftest lookup-unicode-domains () 372(ert-deftest lookup-unicode-domains ()
363 "Unicode domains should fail." 373 "Unicode domains should fail."
@@ -380,7 +390,8 @@ See Bug#30460."
380 (addresses-v4 (network-lookup-address-info "google.com" 'ipv4))) 390 (addresses-v4 (network-lookup-address-info "google.com" 'ipv4)))
381 (should addresses-both) 391 (should addresses-both)
382 (should addresses-v4)) 392 (should addresses-v4))
383 (when (featurep 'make-network-process '(:family ipv6)) 393 (when (and (ipv6-is-available)
394 (dns-query "google.com" 'AAAA))
384 (should (network-lookup-address-info "google.com" 'ipv6))))) 395 (should (network-lookup-address-info "google.com" 'ipv6)))))
385 396
386(ert-deftest non-existent-lookup-failure () 397(ert-deftest non-existent-lookup-failure ()
@@ -565,6 +576,11 @@ FD_SETSIZE file descriptors (Bug#24325)."
565 (should (memq (process-status process) '(run exit))) 576 (should (memq (process-status process) '(run exit)))
566 (when (process-live-p process) 577 (when (process-live-p process)
567 (process-send-eof process)) 578 (process-send-eof process))
579 ;; FIXME: This `sleep-for' shouldn't be needed. It
580 ;; indicates a bug in Emacs; perhaps SIGCHLD is
581 ;; received in parallel with `accept-process-output',
582 ;; causing the latter to hang.
583 (sleep-for 0.1)
568 (while (accept-process-output process)) 584 (while (accept-process-output process))
569 (should (eq (process-status process) 'exit)) 585 (should (eq (process-status process) 'exit))
570 ;; If there's an error between fork and exec, Emacs 586 ;; 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 d13ce77a997..ec96d777ffb 100644
--- a/test/src/xdisp-tests.el
+++ b/test/src/xdisp-tests.el
@@ -72,4 +72,34 @@
72 (should (equal (nth 0 posns) (nth 1 posns))) 72 (should (equal (nth 0 posns) (nth 1 posns)))
73 (should (equal (nth 1 posns) (nth 2 posns))))) 73 (should (equal (nth 1 posns) (nth 2 posns)))))
74 74
75(ert-deftest xdisp-tests--window-text-pixel-size () ;; bug#45748
76 (with-temp-buffer
77 (insert "xxx")
78 (let* ((window
79 (display-buffer (current-buffer) '(display-buffer-in-child-frame . nil)))
80 (char-width (frame-char-width))
81 (size (window-text-pixel-size nil t t)))
82 (delete-frame (window-frame window))
83 (should (equal (/ (car size) char-width) 3)))))
84
85(ert-deftest xdisp-tests--window-text-pixel-size-leading-space () ;; bug#45748
86 (with-temp-buffer
87 (insert " xx")
88 (let* ((window
89 (display-buffer (current-buffer) '(display-buffer-in-child-frame . nil)))
90 (char-width (frame-char-width))
91 (size (window-text-pixel-size nil t t)))
92 (delete-frame (window-frame window))
93 (should (equal (/ (car size) char-width) 3)))))
94
95(ert-deftest xdisp-tests--window-text-pixel-size-trailing-space () ;; bug#45748
96 (with-temp-buffer
97 (insert "xx ")
98 (let* ((window
99 (display-buffer (current-buffer) '(display-buffer-in-child-frame . nil)))
100 (char-width (frame-char-width))
101 (size (window-text-pixel-size nil t t)))
102 (delete-frame (window-frame window))
103 (should (equal (/ (car size) char-width) 3)))))
104
75;;; xdisp-tests.el ends here 105;;; xdisp-tests.el ends here
diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el
index 632cf965fa2..a35b4d2ccc8 100644
--- a/test/src/xml-tests.el
+++ b/test/src/xml-tests.el
@@ -44,12 +44,12 @@
44 44
45(ert-deftest libxml-tests () 45(ert-deftest libxml-tests ()
46 "Test libxml." 46 "Test libxml."
47 (when (fboundp 'libxml-parse-xml-region) 47 (skip-unless (fboundp 'libxml-parse-xml-region))
48 (with-temp-buffer 48 (with-temp-buffer
49 (dolist (test libxml-tests--data-comments-preserved) 49 (dolist (test libxml-tests--data-comments-preserved)
50 (erase-buffer) 50 (erase-buffer)
51 (insert (car test)) 51 (insert (car test))
52 (should (equal (cdr test) 52 (should (equal (cdr test)
53 (libxml-parse-xml-region (point-min) (point-max)))))))) 53 (libxml-parse-xml-region (point-min) (point-max)))))))
54 54
55;;; libxml-tests.el ends here 55;;; libxml-tests.el ends here