diff options
| author | Andrea Corallo | 2021-01-16 13:26:10 +0100 |
|---|---|---|
| committer | Andrea Corallo | 2021-01-16 13:26:10 +0100 |
| commit | 0a7ac0b5504e75275699a3d8d2d5d94bcfda8708 (patch) | |
| tree | bb6158c8a9edeb1e716718abfc98dca16aef9e9e | |
| parent | f1efac1f9efbfa15b6434ebef507c00c1277633f (diff) | |
| parent | 0732fc31932c75c682c8b65b4dcb4376ca63e8fd (diff) | |
| download | emacs-0a7ac0b5504e75275699a3d8d2d5d94bcfda8708.tar.gz emacs-0a7ac0b5504e75275699a3d8d2d5d94bcfda8708.zip | |
Merge remote-tracking branch 'savannah/master' into native-comp
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 | |||
| 299 | nt/emacsclient.rc | 299 | nt/emacsclient.rc |
| 300 | src/gdb.ini | 300 | src/gdb.ini |
| 301 | /var/ | 301 | /var/ |
| 302 | src/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 | ||
| 27 | image: 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 | ||
| 29 | workflow: | ||
| 30 | rules: | ||
| 31 | - if: '$CI_PIPELINE_SOURCE == "merge_request_event"' | ||
| 32 | when: never | ||
| 33 | - when: always | ||
| 28 | 34 | ||
| 29 | variables: | 35 | variables: |
| 30 | GIT_STRATEGY: fetch | 36 | GIT_STRATEGY: fetch |
| 31 | EMACS_EMBA_CI: 1 | 37 | EMACS_EMBA_CI: 1 |
| 32 | 38 | ||
| 33 | before_script: | 39 | default: |
| 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 | ||
| 37 | stages: | 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 | ||
| 40 | test-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 | 90 | stages: |
| 91 | - fast | ||
| 92 | - normal | ||
| 93 | - slow | ||
| 94 | |||
| 95 | test-fast: | ||
| 96 | stage: fast | ||
| 97 | extends: [.job-template, .test-template] | ||
| 98 | variables: | ||
| 99 | target: emacs-inotify | ||
| 100 | make_params: "-C test check" | ||
| 101 | |||
| 102 | test-lisp: | ||
| 103 | stage: normal | ||
| 104 | extends: [.job-template, .test-template] | ||
| 105 | variables: | ||
| 106 | target: emacs-inotify | ||
| 107 | make_params: "-C test check-lisp" | ||
| 108 | |||
| 109 | test-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 | ||
| 77 | test-filenotify-gio: | 116 | test-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 | ||
| 96 | test-native-bootstrap-speed0: | 136 | test-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 | ||
| 128 | test-gnustep: | 168 | test-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 | |||
| 187 | test-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 | ||
| 11 | Changes to this branch propagate to elpa.gnu.org via a "deployment" script run | 10 | That leaves the elpa/packages directory empty; you must check out the |
| 12 | daily. This script (which is kept in elpa/admin/update-archive.sh) generates | 11 | ones you want. |
| 13 | the content visible at https://elpa.gnu.org/packages. | ||
| 14 | 12 | ||
| 15 | A new package is released as soon as the "version number" of that package is | 13 | If you wish to check out all the packages into the packages directory, |
| 16 | changed. So you can use 'elpa' to work on a package without fear of releasing | 14 | you can run the command: |
| 17 | those changes prematurely. And once the code is ready, just bump the | 15 | |
| 18 | version number to make a new release of the package. | 16 | make worktrees |
| 17 | |||
| 18 | You can check out a specific package <pkgname> into the packages | ||
| 19 | directory with: | ||
| 20 | |||
| 21 | make packages/<pkgname> | ||
| 22 | |||
| 23 | |||
| 24 | Changes to this repository propagate to elpa.gnu.org via a | ||
| 25 | "deployment" script run daily. This script generates the content | ||
| 26 | visible at https://elpa.gnu.org/packages. | ||
| 27 | |||
| 28 | A new package is released as soon as the "version number" of that | ||
| 29 | package is changed. So you can use 'elpa' to work on a package | ||
| 30 | without fear of releasing those changes prematurely. And once the | ||
| 31 | code is ready, just bump the version number to make a new release of | ||
| 32 | the package. | ||
| 19 | 33 | ||
| 20 | It is easy to use the elpa branch to deploy a "local" copy of the | 34 | It is easy to use the elpa branch to deploy a "local" copy of the |
| 21 | package archive. For details, see the README file in the elpa branch. | 35 | package archive. For details, see the README file in the elpa branch. |
diff --git a/admin/nt/dist-build/README-scripts b/admin/nt/dist-build/README-scripts index 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. | |||
| 33 | A location for the dependencies. This needs to contain two zip files | 33 | A location for the dependencies. This needs to contain two zip files |
| 34 | with the dependencies. build-dep-zips.py will create these files for you. | 34 | with 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 | ||
| 39 | Contain libXpm-noX4.dll. This file is used to load images for the | 38 | Contain libXpm-noX4.dll. This file is used to load images for the |
| 40 | splash screen, menu items and so on. Emacs runs without it, but looks | 39 | splash screen, menu items and so on. Emacs runs without it, but looks |
| 41 | horrible. The x86_64 comes from msys2, while the i686 comes from | 40 | horrible. The files came original from msys2, and contains no |
| 42 | ezwinports because it itself has no dependencies. These have to be | 41 | dependencies. It has to be placed manually (but probably never |
| 43 | placed manually (but probably never need updating). | 42 | need updating). |
| 44 | 43 | ||
| 45 | 44 | ~/emacs-build/build/$version | |
| 46 | ~/emacs-build/build/$version/i686 | ||
| 47 | ~/emacs-build/build/$version/x86_64 | ||
| 48 | 45 | ||
| 49 | We build Emacs out-of-source here. This directory is created by | 46 | We build Emacs out-of-source here. This directory is created by |
| 50 | build-zips.sh. This directory can be freely deleted after zips have | 47 | build-zips.sh. This directory can be freely deleted after zips have |
| 51 | been created | 48 | been created |
| 52 | 49 | ||
| 53 | 50 | ~/emacs-build/install/$version | |
| 54 | ~/emacs-build/install/$version/i686 | ||
| 55 | ~/emacs-build/install/$version/x86_64 | ||
| 56 | 51 | ||
| 57 | We install Emacs here. This directory is created by build-zips.sh. | 52 | We install Emacs here. This directory is created by build-zips.sh. |
| 58 | This directory can and *should* be deleted after zips have been | 53 | This directory can and *should* be deleted after zips have been |
| @@ -79,9 +74,9 @@ To do this: | |||
| 79 | 74 | ||
| 80 | Update msys to the latest version with `pacman -Syu`. | 75 | Update msys to the latest version with `pacman -Syu`. |
| 81 | 76 | ||
| 82 | Then run build-dep-zips.py, in the ~/emacs-build/deps directory. Three | 77 | Then run build-dep-zips.py, in the ~/emacs-build/deps directory. Two |
| 83 | zips will be created, containing the 64bit and 32bit dependencies, as | 78 | zips will be created, containing the dependencies, as well as the |
| 84 | well as the source for these. | 79 | source for these. |
| 85 | 80 | ||
| 86 | For emacs release or pre-test version: | 81 | For emacs release or pre-test version: |
| 87 | 82 | ||
| @@ -105,12 +100,12 @@ To do this: | |||
| 105 | 100 | ||
| 106 | Update msys to the latest version with `pacman -Syu`. | 101 | Update msys to the latest version with `pacman -Syu`. |
| 107 | 102 | ||
| 108 | Then run build-dep-zips.py, in ~/emacs-build/deps directory. Three | 103 | Then run build-dep-zips.py, in ~/emacs-build/deps directory. Two zips |
| 109 | zips will be created, containing the 64bit and 32bit dependencies, as | 104 | will be created, containing the dependencies, as well as the source |
| 110 | well as the source for these. These deps files contain the date of | 105 | for these. These deps files contain the date of creation in their |
| 111 | creation in their name. The deps file can be reused as desired, or a | 106 | name. The deps file can be reused as desired, or a new version |
| 112 | new version created. Where multiple deps files exist, the most | 107 | created. Where multiple deps files exist, the most recent will be |
| 113 | recent will be used. | 108 | used. |
| 114 | 109 | ||
| 115 | Now, run `build-zips.sh -s` to build a snapshot release. | 110 | Now, run `build-zips.sh -s` to build a snapshot release. |
| 116 | 111 | ||
| @@ -134,4 +129,5 @@ For snapshots from another branch | |||
| 134 | Snapshots can be build from any other branch. There is rarely a need | 129 | Snapshots can be build from any other branch. There is rarely a need |
| 135 | to do this, except where some significant, wide-ranging feature is | 130 | to do this, except where some significant, wide-ranging feature is |
| 136 | being added on a feature branch. In this case, the branch can be | 131 | being added on a feature branch. In this case, the branch can be |
| 137 | given using `build-zips.sh -b pdumper -s` for example. | 132 | given using `build-zips.sh -b pdumper -s` for example. Any "/" |
| 133 | characters in the branch title are replaced. | ||
diff --git a/admin/nt/dist-build/README-windows-binaries b/admin/nt/dist-build/README-windows-binaries index 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. | |||
| 25 | Windows Binaries | 25 | Windows Binaries |
| 26 | ================ | 26 | ================ |
| 27 | 27 | ||
| 28 | Currently, we provide six different binary packages for Emacs, which | 28 | Currently, we provide three different binary packages for Emacs, which |
| 29 | are: | 29 | are: |
| 30 | 30 | ||
| 31 | emacs-$VERSION-x86_64-installer.exe | 31 | emacs-$VERSION-installer.exe |
| 32 | 32 | ||
| 33 | Contains a 64-bit build of Emacs with dependencies as an installer | 33 | Contains Emacs with dependencies as an installer |
| 34 | package. Mostly, this is the best one to install. | 34 | package. Mostly, this is the best one to install. |
| 35 | 35 | ||
| 36 | emacs-$VERSION-x86_64.zip | 36 | emacs-$VERSION.zip |
| 37 | 37 | ||
| 38 | Contains a 64-bit build of Emacs with dependencies. This contains the | 38 | Contains Emacs with dependencies. This contains the same files as the |
| 39 | same files as the installer but as a zip file which some users may | 39 | installer but as a zip file which some users may prefer. |
| 40 | prefer. | ||
| 41 | 40 | ||
| 42 | emacs-$VERSION-x86_64-no-deps.zip | 41 | emacs-$VERSION-no-deps.zip |
| 43 | 42 | ||
| 44 | Contains a 64-bit build of Emacs without any dependencies. This may be | 43 | Contains Emacs without any dependencies. This may be useful if you |
| 45 | useful if you wish to install where the dependencies are already | 44 | wish to install where the dependencies are already available, or if |
| 46 | available, or if you want the small possible Emacs. | 45 | you want the small possible Emacs. |
| 47 | |||
| 48 | emacs-$VERSION-i686-installer.exe | ||
| 49 | |||
| 50 | Contains a 32-bit build of Emacs with dependencies as an installer | ||
| 51 | package. This is useful for running on a 32-bit machine. | ||
| 52 | |||
| 53 | emacs-$VERSION-i686.zip | ||
| 54 | |||
| 55 | Contains a 32-bit build of Emacs with dependencies. | ||
| 56 | |||
| 57 | emacs-$VERSION-i686-no-deps.zip | ||
| 58 | |||
| 59 | Contains a 32-bit build of Emacs without dependencies | ||
| 60 | 46 | ||
| 61 | In addition, we provide the following files which will not be useful | 47 | In addition, we provide the following files which will not be useful |
| 62 | for most end-users. | 48 | for most end-users. |
| 63 | 49 | ||
| 64 | emacs-$VERSION-x86_64-deps.zip | 50 | emacs-$VERSION-deps.zip |
| 65 | 51 | ||
| 66 | The dependencies. Unzipping this file on top of | 52 | The dependencies. Unzipping this file on top of |
| 67 | emacs-$VERSION-x86_64-no-deps.zip should result in the same install as | 53 | emacs-$VERSION-no-deps.zip should result in the same install as |
| 68 | emacs-$VERSION-x86_64.zip. | 54 | emacs-$VERSION.zip. |
| 69 | |||
| 70 | emacs-$VERSION-i686-deps.zip | ||
| 71 | |||
| 72 | The 32-bit version of the dependencies. | ||
| 73 | 55 | ||
| 74 | emacs-$VERSION-deps-mingw-w64-src.zip | 56 | emacs-$VERSION-deps-mingw-w64-src.zip |
| 75 | 57 | ||
| @@ -85,7 +67,8 @@ Snapshots | |||
| 85 | 67 | ||
| 86 | We also distribute "snapshots" of Emacs built at points throughout the | 68 | We also distribute "snapshots" of Emacs built at points throughout the |
| 87 | development cycle, for those interested in following this cycle. They | 69 | development cycle, for those interested in following this cycle. They |
| 88 | are not recommended for normal users. | 70 | are not recommended for normal users; however, they are useful for |
| 71 | people who want to report bugs against the current master. | ||
| 89 | 72 | ||
| 90 | The files follow the same naming convention, but also include a date | 73 | The 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/>. |
| 19 | import argparse | 19 | import argparse |
| 20 | import multiprocessing as mp | ||
| 21 | import os | 20 | import os |
| 22 | import shutil | 21 | import shutil |
| 23 | import re | 22 | import re |
| @@ -40,21 +39,84 @@ mingw-w64-x86_64-libtiff | |||
| 40 | mingw-w64-x86_64-libxml2 | 39 | mingw-w64-x86_64-libxml2 |
| 41 | mingw-w64-x86_64-xpm-nox'''.split() | 40 | mingw-w64-x86_64-xpm-nox'''.split() |
| 42 | 41 | ||
| 42 | DLL_REQ='''libgif | ||
| 43 | libgnutls | ||
| 44 | libharfbuzz | ||
| 45 | libjansson | ||
| 46 | liblcms2 | ||
| 47 | libturbojpeg | ||
| 48 | libpng | ||
| 49 | librsvg | ||
| 50 | libtiff | ||
| 51 | libxml | ||
| 52 | libXpm'''.split() | ||
| 53 | |||
| 43 | 54 | ||
| 44 | ## Options | 55 | ## Options |
| 45 | DRY_RUN=False | 56 | DRY_RUN=False |
| 46 | 57 | ||
| 58 | |||
| 59 | def 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 | ||
| 66 | def 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 | ||
| 82 | def 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 | ||
| 87 | def 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 | |||
| 93 | def 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 |
| 49 | SKIP_SRC_PKGS=["mingw-w64-gcc-libs"] | 114 | SKIP_SRC_PKGS=["mingw-w64-gcc-libs"] |
| 50 | SKIP_DEP_PKGS=["mingw-w64-x86_64-glib2"] | 115 | SKIP_DEP_PKGS=["mingw-w64-glib2"] |
| 51 | MUNGE_SRC_PKGS={"mingw-w64-libwinpthread-git":"mingw-w64-winpthreads-git"} | 116 | MUNGE_SRC_PKGS={"mingw-w64-libwinpthread-git":"mingw-w64-winpthreads-git"} |
| 52 | MUNGE_DEP_PKGS={ | 117 | MUNGE_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=[] | |||
| 62 | SRC_REPO="https://sourceforge.net/projects/msys2/files/REPOS/MINGW/Sources" | 124 | SRC_REPO="https://sourceforge.net/projects/msys2/files/REPOS/MINGW/Sources" |
| 63 | 125 | ||
| 64 | 126 | ||
| 65 | def check_output_maybe(*args,**kwargs): | ||
| 66 | if(DRY_RUN): | ||
| 67 | print("Calling: {}{}".format(args,kwargs)) | ||
| 68 | else: | ||
| 69 | return check_output(*args,**kwargs) | ||
| 70 | |||
| 71 | def immediate_deps(pkg): | 127 | def 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 | ||
| 90 | def extract_deps(): | 147 | def 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 | ||
| 108 | def 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 | ||
| 147 | def download_source(tarball): | 164 | def 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 | ||
| 163 | def 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 | 182 | def 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): | |||
| 220 | def clean(): | 221 | def 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() | |||
| 234 | parser.add_argument("-s", help="snapshot build", | 234 | parser.add_argument("-s", help="snapshot build", |
| 235 | action="store_true") | 235 | action="store_true") |
| 236 | 236 | ||
| 237 | parser.add_argument("-t", help="32 bit deps only", | ||
| 238 | action="store_true") | ||
| 239 | |||
| 240 | parser.add_argument("-f", help="64 bit deps only", | ||
| 241 | action="store_true") | ||
| 242 | |||
| 243 | parser.add_argument("-r", help="source code only", | 237 | parser.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 | ||
| 255 | args = parser.parse_args() | 249 | args = parser.parse_args() |
| 256 | do_all=not (args.c or args.r or args.f or args.t) | 250 | do_all=not (args.c or args.r) |
| 251 | |||
| 257 | 252 | ||
| 258 | deps=extract_deps() | ||
| 259 | 253 | ||
| 260 | DRY_RUN=args.d | 254 | DRY_RUN=args.d |
| 261 | 255 | ||
| @@ -269,13 +263,11 @@ if args.s: | |||
| 269 | else: | 263 | else: |
| 270 | DATE="" | 264 | DATE="" |
| 271 | 265 | ||
| 272 | if( do_all or args.t ): | 266 | if( do_all): |
| 273 | gather_deps(deps,"i686","mingw32") | 267 | gather_deps() |
| 274 | |||
| 275 | if( do_all or args.f ): | ||
| 276 | gather_deps(deps,"x86_64","mingw64") | ||
| 277 | 268 | ||
| 278 | if( do_all or args.r ): | 269 | if( do_all or args.r ): |
| 270 | deps=extract_deps() | ||
| 279 | gather_source(deps) | 271 | gather_source(deps) |
| 280 | 272 | ||
| 281 | if( args.c ): | 273 | if( 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 | ||
| 31 | function build_zip { | 31 | function 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 | ||
| 87 | function build_installer { | 77 | function 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 | ||
| 100 | set -o errexit | 90 | set -o errexit |
| @@ -103,7 +93,6 @@ SNAPSHOT= | |||
| 103 | CACHE= | 93 | CACHE= |
| 104 | 94 | ||
| 105 | BUILD=1 | 95 | BUILD=1 |
| 106 | BUILD_32=1 | ||
| 107 | BUILD_64=1 | 96 | BUILD_64=1 |
| 108 | GIT_UP=0 | 97 | GIT_UP=0 |
| 109 | CONFIG=1 | 98 | CONFIG=1 |
| @@ -114,19 +103,8 @@ INSTALL_TARGET="install-strip" | |||
| 114 | REPO_DIR=$HOME/emacs-build/git/ | 103 | REPO_DIR=$HOME/emacs-build/git/ |
| 115 | 104 | ||
| 116 | 105 | ||
| 117 | while getopts "36gb:hnsiV:" opt; do | 106 | while 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 | |||
| 208 | else | 187 | else |
| 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)) | |||
| 225 | then | 204 | then |
| 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 | ||
| 231 | fi | ||
| 232 | |||
| 233 | ## Do the 64 bit build first, because we reset some environment | ||
| 234 | ## variables during the 32 bit which will break the build. | ||
| 235 | if (($BUILD_32)) | ||
| 236 | then | ||
| 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 |
| 242 | fi | 210 | fi |
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 | ||
| 5 | Outfile "emacs-${OUT_VERSION}-${ARCH}-installer.exe" | 5 | Outfile "emacs-${OUT_VERSION}-installer.exe" |
| 6 | 6 | ||
| 7 | 7 | ||
| 8 | SetCompressor /solid lzma | 8 | SetCompressor /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 | |||
| 36 | Name Emacs-${EMACS_VERSION} | 36 | Name Emacs-${EMACS_VERSION} |
| 37 | 37 | ||
| 38 | function .onInit | 38 | function .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} | ||
| 52 | functionend | 40 | functionend |
| 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" |
| 70 | SectionEnd | 59 | SectionEnd |
| 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 |
| 5770 | fi | 5770 | fi |
| 5771 | 5771 | ||
| 5772 | if test -z "$GMP_H"; then | ||
| 5773 | HAVE_GMP=yes | ||
| 5774 | else | ||
| 5775 | HAVE_GMP=no | ||
| 5776 | fi | ||
| 5777 | |||
| 5772 | emacs_standard_dirs='Standard dirs' | 5778 | emacs_standard_dirs='Standard dirs' |
| 5773 | AS_ECHO([" | 5779 | AS_ECHO([" |
| 5774 | Configured for '${canonical}'. | 5780 | Configured 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. | ||
| 5786 | optsep= | 5793 | optsep= |
| 5787 | emacs_config_features= | 5794 | emacs_config_features= |
| 5788 | for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \ | 5795 | for 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 | |||
| 5825 | AC_DEFINE_UNQUOTED(EMACS_CONFIG_FEATURES, "${emacs_config_features}", | 5833 | AC_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 | ||
| 5828 | if test -z "$GMP_H"; then | ||
| 5829 | HAVE_GMP=yes | ||
| 5830 | else | ||
| 5831 | HAVE_GMP=no | ||
| 5832 | fi | ||
| 5833 | AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D} | 5836 | AS_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 | |||
| 76 | the user option @code{minibuffer-follows-selected-frame} to | 76 | the 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 |
| 78 | it, and you must switch back to that frame in order to complete (or | 78 | it, and you must switch back to that frame in order to complete (or |
| 79 | abort) the current command. Note that the effect of the command, when | 79 | abort) the current command. If you set that option to a value which |
| 80 | you finally finish using the minibuffer, always takes place in the | 80 | is neither @code{nil} nor @code{t}, the minibuffer moves frame only |
| 81 | frame where you first opened it. | 81 | after 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 | ||
| 84 | effect of the command, when you finally finish using the minibuffer, | ||
| 85 | always 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 | |||
| 57 | successive @kbd{C-g} characters to get out of a search. | 57 | successive @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 | ||
| 61 | opened that minibuffer, closing it. If that minibuffer is not the | ||
| 62 | most recently opened one (which can happen when | ||
| 63 | @code{minibuffer-follows-selected-frame} is @code{nil} (@pxref{Basic | ||
| 64 | Minibuffer})), @kbd{C-g} also closes the more recently opened ones, | ||
| 65 | quitting 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 |
| 61 | like @kbd{C-g}. The reason is that it is not feasible, on MS-DOS, to | 68 | like @kbd{C-g}. The reason is that it is not feasible, on MS-DOS, to |
| 62 | recognize @kbd{C-g} while a command is running, between interactions | 69 | recognize @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 |
| 2697 | not perform the translations described in @ref{Translation Keymaps}. | 2697 | not perform the translations described in @ref{Translation Keymaps}. |
| 2698 | If you wish to read a single key taking these translations into | 2698 | If you wish to read a single key taking these translations into |
| 2699 | account, use the function @code{read-key}: | 2699 | account (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 |
| 2702 | This function reads a single key. It is intermediate between | 2704 | This 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 |
| 2704 | reads a single key, not a key sequence. Unlike the latter, it does | 2706 | reads a single key, not a key sequence. Unlike the latter, it does |
| @@ -2708,6 +2710,14 @@ and @code{key-translation-map} (@pxref{Translation Keymaps}). | |||
| 2708 | 2710 | ||
| 2709 | The argument @var{prompt} is either a string to be displayed in the | 2711 | The argument @var{prompt} is either a string to be displayed in the |
| 2710 | echo area as a prompt, or @code{nil}, meaning not to display a prompt. | 2712 | echo area as a prompt, or @code{nil}, meaning not to display a prompt. |
| 2713 | |||
| 2714 | If argument @var{disable-fallbacks} is non-@code{nil} then the usual | ||
| 2715 | fallback logic for unbound keys in @code{read-key-sequence} is not | ||
| 2716 | applied. This means that mouse button-down and multi-click events | ||
| 2717 | will not be discarded and @code{local-function-key-map} and | ||
| 2718 | @code{key-translation-map} will not get applied. If @code{nil} or | ||
| 2719 | unspecified, the only fallback disabled is downcasing of the last | ||
| 2720 | event. | ||
| 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 | |||
| 2485 | the width could be specified with only a single number @var{n} instead | 2485 | the width could be specified with only a single number @var{n} instead |
| 2486 | of a list, such case is equivalent to @code{((abs @var{n}) . @var{n})}. | 2486 | of a list, such case is equivalent to @code{((abs @var{n}) . @var{n})}. |
| 2487 | 2487 | ||
| 2488 | The value @var{color} specifies the color to draw with. The default is | ||
| 2489 | the foreground color of the face for simple boxes, and the background | ||
| 2490 | color of the face for 3D boxes. | ||
| 2491 | |||
| 2492 | The value @var{style} specifies whether to draw a 3D box. If it is | 2488 | The 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 |
| 2494 | pressed. If it is @code{pressed-button}, the box looks like a 3D button | 2490 | being pressed. If it is @code{pressed-button}, the box looks like a |
| 2495 | that is being pressed. If it is @code{nil} or omitted, a plain 2D box | 2491 | 3D button that is being pressed. If it is @code{nil}, |
| 2496 | is used. | 2492 | @code{flat-button} or omitted, a plain 2D box is used. |
| 2493 | |||
| 2494 | The value @var{color} specifies the color to draw with. The default | ||
| 2495 | is the background color of the face for 3D boxes and | ||
| 2496 | @code{flat-button}, and the foreground color of the face for other | ||
| 2497 | boxes. | ||
| 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 | ||
| 744 | Completion | 745 | Completion |
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 |
| 232 | The message is @samp{Cannot determine image type}. @xref{Images}. | 232 | The message is @samp{Cannot determine image type}. @xref{Images}. |
| 233 | |||
| 234 | @item inhibited-interaction | ||
| 235 | The message is @samp{User interaction while inhibited}. This error is | ||
| 236 | signalled when @code{inhibit-interaction} is non-@code{nil} and a user | ||
| 237 | interaction 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 | |||
| 82 | incrementing the number at the end of the name. (The names begin with | 83 | incrementing the number at the end of the name. (The names begin with |
| 83 | a space so that they won't show up in normal buffer lists.) Of | 84 | a space so that they won't show up in normal buffer lists.) Of |
| 84 | several recursive minibuffers, the innermost (or most recently | 85 | several recursive minibuffers, the innermost (or most recently |
| 85 | entered) is the active minibuffer. We usually call this @emph{the} | 86 | entered) is the @dfn{active minibuffer}--it is the one you can |
| 86 | minibuffer. You can permit or forbid recursive minibuffers by setting | 87 | terminate by typing @key{RET} (@code{exit-minibuffer}) in. We usually |
| 87 | the variable @code{enable-recursive-minibuffers}, or by putting | 88 | call this @emph{the} minibuffer. You can permit or forbid recursive |
| 88 | properties of that name on command symbols (@xref{Recursive Mini}.) | 89 | minibuffers by setting the variable |
| 90 | @code{enable-recursive-minibuffers}, or by putting properties of that | ||
| 91 | name 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 |
| 2382 | This command exits the active minibuffer. It is normally bound to | 2385 | This command exits the active minibuffer. It is normally bound to |
| 2383 | keys in minibuffer local keymaps. | 2386 | keys in minibuffer local keymaps. The command throws an error if the |
| 2387 | current 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. | |||
| 2594 | If this variable is non-@code{nil}, you can invoke commands (such as | 2598 | If 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 |
| 2596 | active. Such invocation produces a recursive editing level for a new | 2600 | active. Such invocation produces a recursive editing level for a new |
| 2597 | minibuffer. The outer-level minibuffer is invisible while you are | 2601 | minibuffer. By default, the outer-level minibuffer is invisible while |
| 2598 | editing the inner one. | 2602 | you are editing the inner one. If you have |
| 2603 | @code{minibuffer-follows-selected-frame} set to @code{nil}, you can | ||
| 2604 | have minibuffers visible on several frames at the same time. | ||
| 2605 | @xref{Basic Minibuffer,,, emacs}. | ||
| 2599 | 2606 | ||
| 2600 | If this variable is @code{nil}, you cannot invoke minibuffer commands | 2607 | If this variable is @code{nil}, you cannot invoke minibuffer commands |
| 2601 | when the minibuffer is active, not even if you switch to another window | 2608 | when the minibuffer is active, not even if you switch to another window |
| @@ -2611,6 +2618,38 @@ to @code{t} in the interactive declaration (@pxref{Using Interactive}). | |||
| 2611 | The minibuffer command @code{next-matching-history-element} (normally | 2618 | The 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 | |||
| 2624 | It's sometimes useful to be able to run Emacs as a headless server | ||
| 2625 | process that responds to commands given over a network connection. | ||
| 2626 | However, Emacs is primarily a platform for interactive usage, so many | ||
| 2627 | commands prompt the user for feedback in certain anomalous situations. | ||
| 2628 | This makes this use case more difficult, since the server process will | ||
| 2629 | just hang waiting for user input. | ||
| 2630 | |||
| 2631 | @vindex inhibit-interaction | ||
| 2632 | Binding the @code{inhibit-interaction} variable to something | ||
| 2633 | non-@code{nil} makes Emacs signal a @code{inhibited-interaction} error | ||
| 2634 | instead of prompting, which can then be used by the server process to | ||
| 2635 | handle these situations. | ||
| 2636 | |||
| 2637 | Here'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 | |||
| 2647 | If @code{my-client-handling-function} ends up calling something that | ||
| 2648 | asks 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 | ||
| 2651 | code 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 |
| 2626 | This is a normal hook that is run whenever the minibuffer is entered. | 2665 | This 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 |
| 2644 | This is a normal hook that is run whenever the minibuffer is exited. | 2683 | This 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 | ||
| 110 | Matching entries are usually used in the order they appear, so placing | ||
| 111 | the most specific entries first in the file is a good idea. For | ||
| 112 | instance: | ||
| 113 | |||
| 114 | @example | ||
| 115 | machine example.com login foobar password geheimnis port smtp | ||
| 116 | machine example.com login foobar password hemmelig | ||
| 117 | @end example | ||
| 118 | |||
| 119 | Here we're using one password for the @code{smtp} service, and a | ||
| 120 | different one for all the other services. | ||
| 121 | |||
| 110 | You can also use this file to specify client certificates to use when | 122 | You can also use this file to specify client certificates to use when |
| 111 | setting up TLS connections. The format is: | 123 | setting 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. | |||
| 20195 | For example, to do hierarchical scoring but use a non-server-specific | 20195 | For example, to do hierarchical scoring but use a non-server-specific |
| 20196 | overall score file, you could use the value | 20196 | overall 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. | |||
| 443 | The default value for an empty local file name part is the remote | 443 | The default value for an empty local file name part is the remote |
| 444 | user's home directory. The shortest remote file name is | 444 | user'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 |
| 446 | default host is used for syntactical reasons, @ref{Default Host}. | 446 | default method is used for syntactical reasons, @ref{Default Method}. |
| 447 | 447 | ||
| 448 | The @code{method} part describes the connection method used to reach | 448 | The @code{method} part describes the connection method used to reach |
| 449 | the remote host, see below. | 449 | the 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} | ||
| 1625 | With @command{ssh}, you could use the @option{ProxyCommand} entry in | 1626 | With @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 | ||
| 2058 | When this property is non-@code{nil}, an alternative, more performant | 2059 | When this property is non-@code{nil}, an alternative, more performant |
| 2059 | implementation of @code{make-process} and | 2060 | implementation of @code{make-process} and @code{start-file-process} is |
| 2060 | @code{start-file-process} is applied. @ref{Improving performance of | 2061 | applied. The connection method must also be marked with a |
| 2061 | asynchronous remote processes} for a discussion of constraints. | 2062 | non-@code{nil} @code{tramp-direct-async} parameter in |
| 2063 | @code{tramp-methods}. @ref{Improving performance of asynchronous | ||
| 2064 | remote 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 | ||
| 2215 | This uses also the settings in @code{tramp-sh-extra-args}. | 2218 | This 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, | ||
| 2222 | do @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 | |||
| 3304 | hard-coded, fixed name. Note that using @code{:0} for X11 display name | 3312 | hard-coded, fixed name. Note that using @code{:0} for X11 display name |
| 3305 | here will not work as expected. | 3313 | here will not work as expected. |
| 3306 | 3314 | ||
| 3315 | @vindex ForwardX11@r{, ssh option} | ||
| 3316 | @vindex ForwardX11Trusted@r{, ssh option} | ||
| 3307 | An alternate approach is specify @option{ForwardX11 yes} or | 3317 | An 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 |
| 3309 | host. | 3319 | host. |
| @@ -3566,6 +3576,7 @@ Furthermore, this approach has the following limitations: | |||
| 3566 | It works only for connection methods defined in @file{tramp-sh.el} and | 3576 | It 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 |
| 3570 | It does not support interactive user authentication. With | 3581 | It 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 |
| 4273 | down. @value{tramp} cannot safely detect such hangs. The network | 4285 | down. @value{tramp} cannot safely detect such hangs. The network |
| 4274 | configuration for @command{ssh} can be configured to kill such hangs | 4286 | configuration 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 |
| 4290 | if a master session opened outside the Emacs session is no longer | 4304 | if a master session opened outside the Emacs session is no longer |
| @@ -4306,8 +4320,8 @@ which allows you to set the @option{ControlPath} provided the variable | |||
| 4306 | @end group | 4320 | @end group |
| 4307 | @end lisp | 4321 | @end lisp |
| 4308 | 4322 | ||
| 4309 | Note how "%r", "%h" and "%p" must be encoded as "%%r", "%%h" and | 4323 | Note 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 |
| 4313 | If the @file{~/.ssh/config} is configured appropriately for the above | 4327 | If 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} | ||
| 4321 | This shall also be set to @code{nil} if you use the | 4337 | This 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 |
| @@ -102,12 +102,13 @@ effect should be negligible in the vast majority of cases anyway. | |||
| 102 | By default, when you switch to another frame, an active minibuffer now | 102 | By default, when you switch to another frame, an active minibuffer now |
| 103 | moves to the newly selected frame. Nevertheless, the effect of what | 103 | moves to the newly selected frame. Nevertheless, the effect of what |
| 104 | you type in the minibuffer happens in the frame where the minibuffer | 104 | you type in the minibuffer happens in the frame where the minibuffer |
| 105 | was first activated, even if it moved to another frame. An | 105 | was first activated. An alternative behavior is available by |
| 106 | alternative behavior is available by customizing | 106 | customizing 'minibuffer-follows-selected-frame' to nil. Here, the |
| 107 | 'minibuffer-follows-selected-frame' to nil. Here, the minibuffer | 107 | minibuffer stays in the frame where you first opened it, and you must |
| 108 | stays in the frame where you first opened it, and you must switch back | 108 | switch back to this frame to continue or abort its command. The old |
| 109 | to this frame to continue or abort its command. The old, somewhat | 109 | behavior, which mixed these two, can be approximated by customizing |
| 110 | unsystematic behavior, which mixed these two is no longer available. | 110 | 'minibuffer-follows-selected-frame' to a value which is neither nil |
| 111 | nor 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. |
| 351 | The command previously extended the start of the region to the start | 354 | The command previously extended the start of the region to the start |
| 352 | of the line, but will now actually send the marked region, as | 355 | of 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. | ||
| 707 | Previously, 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 | ||
| 710 | encrypted/signed message. | ||
| 711 | |||
| 702 | +++ | 712 | +++ |
| 703 | *** Message now supports the OpenPGP header. | 713 | *** Message now supports the OpenPGP header. |
| 704 | To generate these headers, add the new function | 714 | To 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 | ||
| 1351 | in Xref buffers ('M-,'). This combination is easy to press | ||
| 1352 | semi-accidentally if the user wants to go back in the middle of | ||
| 1353 | choosing 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' |
| 1342 | If chosen, file names in *xref* buffers will be displayed relative | 1357 | If chosen, file names in *xref* buffers will be displayed relative |
| @@ -1361,6 +1376,15 @@ https://www.w3.org/TR/xml/#charsets). Now it rejects such strings. | |||
| 1361 | ** erc | 1376 | ** erc |
| 1362 | 1377 | ||
| 1363 | --- | 1378 | --- |
| 1379 | *** erc-services.el now supports NickServ passwords from auth-source. | ||
| 1380 | The 'erc-use-auth-source-for-nickserv-password' variable enables querying | ||
| 1381 | auth-source for NickServ passwords. To enable this, add the following | ||
| 1382 | to 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. |
| 1365 | Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m". | 1389 | Allowed 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'. | ||
| 1545 | This 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. | ||
| 1549 | If 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'. |
| 1558 | This is a plain 2D button, but uses the background color instead of | ||
| 1559 | the 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. | ||
| 750 | Try 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. |
| 750 | For example, XFree86 4.3.0 has one version and Gnome usually comes | 755 | For example, XFree86 4.3.0 has one version and Gnome usually comes |
| 751 | with a newer version. Emacs compiled with Gtk+ will then use the | 756 | with a newer version. Emacs compiled with Gtk+ will then use the |
diff --git a/etc/w32-feature.el b/etc/w32-feature.el index 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 | |||
| 64 | can be used to define that match without loading the specific project | 64 | can be used to define that match without loading the specific project |
| 65 | into memory.") | 65 | into 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." | |||
| 778 | Use the :set function to do so. This is useful for customizable options | 783 | Use the :set function to do so. This is useful for customizable options |
| 779 | that are defined before their standard value can really be computed. | 784 | that are defined before their standard value can really be computed. |
| 780 | E.g. dumped variables whose default depends on run-time information." | 785 | E.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. |
| 2066 | Each definition can take the form (FUNC ARGLIST BODY...) where | 2155 | +BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where |
| 2067 | FUNC is the function name, ARGLIST its arguments, and BODY the | 2156 | FUNC is the function name, ARGLIST its arguments, and BODY the |
| 2068 | forms of the function body. FUNC is defined in any BODY, as well | 2157 | forms of the function body. FUNC is defined in any BODY, as well |
| 2069 | as FORM, so you can write recursive and mutually recursive | 2158 | as 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. | ||
| 193 | All 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. | ||
| 439 | All 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. | ||
| 485 | It is used as a poor-man's \"free variables\" test. It differs from a true | ||
| 486 | test 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 \ | ||
| 1143 | function'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. | ||
| 173 | This option has an no effect if `erc-prompt-for-nickserv-password' | ||
| 174 | is non-nil, and passwords from `erc-nickserv-passwords' take | ||
| 175 | precedence." | ||
| 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 | ||
| 183 | passwords to be used. | ||
| 173 | 184 | ||
| 174 | Example of use: | 185 | Example 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. | |||
| 375 | If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the | 386 | If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the |
| 376 | password for this nickname, otherwise try to send it automatically." | 387 | password 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 | |||
| 427 | It uses `erc-nickserv-passwords' and additionally auth-source | ||
| 428 | when `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'. |
| 412 | Either call it interactively or run it with NICKNAME's password, | 447 | Either call it interactively or run it with NICKNAME's password, |
| 413 | depending on the value of `erc-prompt-for-nickserv-password'." | 448 | depending 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:- | |||
| 487 | Signal an error if the final event isn't the same type as the first one." | 487 | Signal 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. |
| 2579 | This is installed as a pre-command hook by `blink-cursor-start'. | 2579 | This is installed as a pre-command hook by `blink-cursor-start'. |
| 2580 | When run, it cancels the timer `blink-cursor-timer' and removes | 2580 | When run, it cancels the timer `blink-cursor-timer' and removes |
| 2581 | itself as a pre-command hook." | 2581 | itself 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. |
| 623 | This variable is only consulted when forwarding \"normally\", not | 623 | This variable is not consulted when forwarding encrypted messages |
| 624 | when forwarding as MIME or the like. | 624 | and `message-forward-show-mml' is `best'. |
| 625 | 625 | ||
| 626 | This may also be a list of regexps." | 626 | This 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 | ||
| 364 | The words preceding the quoted symbol can be used in doc strings to | 363 | The 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. |
| 2503 | Unlike `isearch-yank-pop-only', when this command is called not immediately | 2514 | Unlike `isearch-yank-pop-only', when this command is called not immediately |
| @@ -2506,37 +2517,31 @@ minibuffer to read a string from the `kill-ring' as `yank-pop' does." | |||
| 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. |
| 2526 | Unlike `isearch-yank-pop', when this command is called not immediately | 2526 | Unlike `isearch-yank-pop', when this command is called not immediately |
| 2527 | after a `isearch-yank-kill' or a `isearch-yank-pop-only', it only pops | 2527 | after a `isearch-yank-kill' or a `isearch-yank-pop-only', it only pops |
| 2528 | the last killed string instead of activating the minibuffer to read | 2528 | the last killed string instead of activating the minibuffer to read |
| 2529 | a string from the `kill-ring' as `yank-pop' does." | 2529 | a string from the `kill-ring' as `yank-pop' does. The prefix arg C-u |
| 2530 | (interactive) | 2530 | always 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. |
| 898 | If connection property \"direct-async-process\" is non-nil, an | 899 | If method parameter `tramp-direct-async' and connection property |
| 899 | alternative implementation will be used." | 900 | \"direct-async-process\" are non-nil, an alternative |
| 901 | implementation 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. |
| 2843 | STDERR can also be a file name. If connection property | 2843 | STDERR can also be a file name. If method parameter `tramp-direct-async' |
| 2844 | \"direct-async-process\" is non-nil, an alternative | 2844 | and connection property \"direct-async-process\" are non-nil, an |
| 2845 | implementation will be used." | 2845 | alternative 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." | |||
| 1755 | Message is formatted with FMT-STRING as control string and the remaining | 1755 | Message is formatted with FMT-STRING as control string and the remaining |
| 1756 | ARGUMENTS to actually emit the message (if applicable)." | 1756 | ARGUMENTS 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. | ||
| 1287 | TYPE 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." |
| 975 | Arguments 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. |
| 1203 | Actually this is just customized `prolog-mode'." | 1203 | Actually 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." | |||
| 992 | When there is more than one definition, split the selected window | 1001 | When there is more than one definition, split the selected window |
| 993 | and show the list in a small window at the bottom. And use a | 1002 | and show the list in a small window at the bottom. And use a |
| 994 | local keymap that binds `RET' to `xref-quit-and-goto-xref'." | 1003 | local 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. |
| 5610 | This variable also affects `kill-visual-line' in the same way as | ||
| 5611 | it 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. | |||
| 7319 | If ARG is zero, kill the text before point on the current visual | 7321 | If ARG is zero, kill the text before point on the current visual |
| 7320 | line. | 7322 | line. |
| 7321 | 7323 | ||
| 7324 | If the variable `kill-whole-line' is non-nil, and this command is | ||
| 7325 | invoked at start of a line that ends in a newline, kill the newline | ||
| 7326 | as well. | ||
| 7327 | |||
| 7322 | If you want to append the killed line to the last killed text, | 7328 | If you want to append the killed line to the last killed text, |
| 7323 | use \\[append-next-kill] before \\[kill-line]. | 7329 | use \\[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 | |||
| 929 | loaded, and ALTERNATE-FILENAME-FUNCTION is non-nil, then it is | 929 | loaded, and ALTERNATE-FILENAME-FUNCTION is non-nil, then it is |
| 930 | called with no arguments and should return the name of an | 930 | called with no arguments and should return the name of an |
| 931 | alternate init-file to load. If LOAD-DEFAULTS is non-nil, then | 931 | alternate init-file to load. If LOAD-DEFAULTS is non-nil, then |
| 932 | load default.el after the init-file. | 932 | load default.el after the init-file, unless `inhibit-default-init' |
| 933 | is non-nil. | ||
| 933 | 934 | ||
| 934 | This function sets `user-init-file' to the name of the loaded | 935 | This function sets `user-init-file' to the name of the loaded |
| 935 | init-file, or to a default value if loading is not possible." | 936 | init-file, or to a default value if loading is not possible." |
| @@ -985,8 +986,8 @@ init-file, or to a default value if loading is not possible." | |||
| 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. | ||
| 1189 | KEYS is a string or vector, a sequence of keystrokes. | ||
| 1190 | The binding is probably a symbol with a function definition. | ||
| 1191 | |||
| 1192 | If optional argument ACCEPT-DEFAULT is non-nil, recognize default | ||
| 1193 | bindings; see the description of `lookup-key' for more details | ||
| 1194 | about 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. | ||
| 1200 | KEYS is a string or vector, a sequence of keystrokes. | ||
| 1201 | The binding is probably a symbol with a function definition. | ||
| 1202 | This function's return values are the same as those of `lookup-key' | ||
| 1203 | \(which see). | ||
| 1204 | |||
| 1205 | If optional argument ACCEPT-DEFAULT is non-nil, recognize default | ||
| 1206 | bindings; see the description of `lookup-key' for more details | ||
| 1207 | about 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. |
| 1337 | The value is a keymap that is usually (but not necessarily) Emacs's | 1361 | The value is a keymap that is usually (but not necessarily) Emacs's |
| 1338 | global map.") | 1362 | global map. |
| 1363 | |||
| 1364 | See 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. |
| 2533 | Contrary to `read-event' this will not return a raw event but instead will | 2598 | Contrary to `read-event' this will not return a raw event but instead will |
| 2534 | obey the input decoding and translations usually done by `read-key-sequence'. | 2599 | obey the input decoding and translations usually done by `read-key-sequence'. |
| 2535 | So escape sequences and keyboard encoding are taken into account. | 2600 | So escape sequences and keyboard encoding are taken into account. |
| 2536 | When there's an ambiguity because the key looks like the prefix of | 2601 | When there's an ambiguity because the key looks like the prefix of |
| 2537 | some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." | 2602 | some sort of escape sequence, the ambiguity is resolved via `read-key-delay'. |
| 2603 | |||
| 2604 | If the optional argument PROMPT is non-nil, display that as a | ||
| 2605 | prompt. | ||
| 2606 | |||
| 2607 | If the optional argument DISABLE-FALLBACKS is non-nil, all | ||
| 2608 | unbound fallbacks usually done by `read-key-sequence' are | ||
| 2609 | disabled such as discarding mouse down events. This is generally | ||
| 2610 | what you want as `read-key' temporarily removes all bindings | ||
| 2611 | while calling `read-key-sequence'. If nil or unspecified, the | ||
| 2612 | only 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 | |||
| 2682 | This function exists for backward compatibility in code packaged | ||
| 2683 | with 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 | |||
| 935 | keyval style [..., label = {...}, ...] label definitions. The | 936 | keyval style [..., label = {...}, ...] label definitions. The |
| 936 | regexp for keyval style explicitly looks for environments | 937 | regexp for keyval style explicitly looks for environments |
| 937 | provided by the packages \"listings\" (\"lstlisting\"), | 938 | provided by the packages \"listings\" (\"lstlisting\"), |
| 938 | \"breqn\" (\"dmath\", \"dseries\", \"dgroup\", \"darray\") and | 939 | \"beamer\" (\"frame\"), \"breqn\" (\"dmath\", \"dseries\", |
| 939 | the macro \"\\ctable\" provided by the package of the same name. | 940 | \"dgroup\", \"darray\") and the macro \"\\ctable\" provided by |
| 941 | the package of the same name. | ||
| 940 | 942 | ||
| 941 | It is assumed that the regexp group 1 matches the label text, so | 943 | It is assumed that the regexp group 1 matches the label text, so |
| 942 | you have to define it using \\(?1:...\\) when adding new regexps. | 944 | you have to define it using \\(?1:...\\) when adding new regexps. |
| @@ -944,7 +946,7 @@ you have to define it using \\(?1:...\\) when adding new regexps. | |||
| 944 | When changed from Lisp, make sure to call | 946 | When 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 |
| 946 | effective." | 948 | effective." |
| 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 | ||
| 1232 | int | 1244 | int |
| 1233 | emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, | 1245 | emacs_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 | ||
| 6054 | Lisp_Object | 6061 | Lisp_Object |
| 6055 | sit_for (Lisp_Object timeout, bool reading, int display_option) | 6062 | sit_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 | |||
| 1176 | internal_catch (Lisp_Object tag, | 1176 | internal_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 | } |
| @@ -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 | ||
| 5551 | DEFUN ("buffer-line-statistics", Fbuffer_line_statistics, | ||
| 5552 | Sbuffer_line_statistics, 0, 1, 0, | ||
| 5553 | doc: /* Return data about lines in BUFFER. | ||
| 5554 | The data is returned as a list, and the first element is the number of | ||
| 5555 | lines in the buffer, the second is the length of the longest line, and | ||
| 5556 | the third is the mean line length. The lengths returned are in bytes, not | ||
| 5557 | characters. */ ) | ||
| 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 | |||
| 5551 | static bool | 5635 | static bool |
| 5552 | string_ascii_p (Lisp_Object string) | 5636 | string_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 | ||
| 1649 | DEFUN ("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. | ||
| 1651 | KEYS is a string or vector, a sequence of keystrokes. | ||
| 1652 | The binding is probably a symbol with a function definition. | ||
| 1653 | |||
| 1654 | If optional argument ACCEPT-DEFAULT is non-nil, recognize default | ||
| 1655 | bindings; 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 | |||
| 1666 | DEFUN ("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. | ||
| 1668 | KEYS is a string or vector, a sequence of keystrokes. | ||
| 1669 | The binding is probably a symbol with a function definition. | ||
| 1670 | This function's return values are the same as those of `lookup-key' | ||
| 1671 | \(which see). | ||
| 1672 | |||
| 1673 | If optional argument ACCEPT-DEFAULT is non-nil, recognize default | ||
| 1674 | bindings; 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 | |||
| 1682 | DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0, | 1649 | DEFUN ("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. |
| 1684 | Return an alist of pairs (MODENAME . BINDING), where MODENAME is | 1651 | Return 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; | |||
| 4368 | extern Lisp_Object last_minibuf_string; | 4368 | extern Lisp_Object last_minibuf_string; |
| 4369 | extern void move_minibuffer_onto_frame (void); | 4369 | extern void move_minibuffer_onto_frame (void); |
| 4370 | extern bool is_minibuffer (EMACS_INT, Lisp_Object); | 4370 | extern bool is_minibuffer (EMACS_INT, Lisp_Object); |
| 4371 | extern EMACS_INT this_minibuffer_depth (Lisp_Object); | ||
| 4372 | extern EMACS_INT minibuf_level; | ||
| 4371 | extern Lisp_Object get_minibuffer (EMACS_INT); | 4373 | extern Lisp_Object get_minibuffer (EMACS_INT); |
| 4372 | extern void init_minibuf_once (void); | 4374 | extern void init_minibuf_once (void); |
| 4373 | extern void syms_of_minibuf (void); | 4375 | extern void syms_of_minibuf (void); |
| 4376 | extern 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 | ||
| 4521 | extern int emacs_spawn (pid_t *, int, int, int, char **, char **, const char *, | 4524 | extern int emacs_spawn (pid_t *, int, int, int, char **, char **, |
| 4522 | const char *); | 4525 | const char *, const char *, const sigset_t *); |
| 4523 | extern char **make_environment_block (Lisp_Object); | 4526 | extern char **make_environment_block (Lisp_Object); |
| 4524 | extern void init_callproc_1 (void); | 4527 | extern void init_callproc_1 (void); |
| 4525 | extern void init_callproc (void); | 4528 | extern void init_callproc (void); |
| @@ -4598,6 +4601,7 @@ extern AVOID emacs_abort (void) NO_INLINE; | |||
| 4598 | extern int emacs_fstatat (int, char const *, void *, int); | 4601 | extern int emacs_fstatat (int, char const *, void *, int); |
| 4599 | extern int emacs_openat (int, char const *, int, int); | 4602 | extern int emacs_openat (int, char const *, int, int); |
| 4600 | extern int emacs_open (const char *, int, int); | 4603 | extern int emacs_open (const char *, int, int); |
| 4604 | extern int emacs_open_noquit (const char *, int, int); | ||
| 4601 | extern int emacs_pipe (int[2]); | 4605 | extern int emacs_pipe (int[2]); |
| 4602 | extern int emacs_close (int); | 4606 | extern int emacs_close (int); |
| 4603 | extern ptrdiff_t emacs_read (int, void *, ptrdiff_t); | 4607 | extern 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. | |||
| 767 | If the optional argument SECONDS is non-nil, it should be a number | 767 | If the optional argument SECONDS is non-nil, it should be a number |
| 768 | specifying the maximum number of seconds to wait for input. If no | 768 | specifying the maximum number of seconds to wait for input. If no |
| 769 | input arrives in that time, return nil. SECONDS may be a | 769 | input arrives in that time, return nil. SECONDS may be a |
| 770 | floating-point value. */) | 770 | floating-point value. |
| 771 | |||
| 772 | If `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 | ||
| 783 | DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0, | 788 | DEFUN ("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 | |||
| 791 | If you want to read non-character events, consider calling `read-key' | ||
| 792 | instead. `read-key' will decode events via `input-decode-map' that | ||
| 793 | `read-event' will not. On a terminal this includes function keys such | ||
| 794 | as <F7> and <RIGHT>, or mouse events generated by `xterm-mouse-mode'. | ||
| 795 | |||
| 785 | If the optional argument PROMPT is non-nil, display that as a prompt. | 796 | If the optional argument PROMPT is non-nil, display that as a prompt. |
| 786 | If PROMPT is nil or the string \"\", the key sequence/events that led | 797 | If PROMPT is nil or the string \"\", the key sequence/events that led |
| 787 | to the current command is used as the prompt. | 798 | to the current command is used as the prompt. |
| @@ -793,9 +804,14 @@ is used for reading a character. | |||
| 793 | If the optional argument SECONDS is non-nil, it should be a number | 804 | If the optional argument SECONDS is non-nil, it should be a number |
| 794 | specifying the maximum number of seconds to wait for input. If no | 805 | specifying the maximum number of seconds to wait for input. If no |
| 795 | input arrives in that time, return nil. SECONDS may be a | 806 | input arrives in that time, return nil. SECONDS may be a |
| 796 | floating-point value. */) | 807 | floating-point value. |
| 808 | |||
| 809 | If `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. | |||
| 822 | If the optional argument SECONDS is non-nil, it should be a number | 838 | If the optional argument SECONDS is non-nil, it should be a number |
| 823 | specifying the maximum number of seconds to wait for input. If no | 839 | specifying the maximum number of seconds to wait for input. If no |
| 824 | input arrives in that time, return nil. SECONDS may be a | 840 | input arrives in that time, return nil. SECONDS may be a |
| 825 | floating-point value. */) | 841 | floating-point value. |
| 826 | (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds) | 842 | |
| 843 | If `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 | ||
| 64 | static ptrdiff_t minibuf_prompt_width; | 64 | static ptrdiff_t minibuf_prompt_width; |
| 65 | 65 | ||
| 66 | static 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. */ | ||
| 67 | static bool | 71 | static bool |
| 68 | minibuf_follows_frame (void) | 72 | minibuf_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. */ | ||
| 80 | static bool | ||
| 81 | minibuf_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. */ | ||
| 88 | static bool | ||
| 89 | minibuf_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. */ | ||
| 128 | void move_minibuffer_onto_frame (void) | 163 | void 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 | ||
| 378 | DEFUN ("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. | ||
| 381 | No 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. */ | ||
| 395 | EMACS_INT | ||
| 396 | this_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 | |||
| 411 | DEFUN ("abort-minibuffers", Fabort_minibuffers, Sabort_minibuffers, 0, 0, "", | ||
| 412 | doc: /* Abort the current minibuffer. | ||
| 413 | If we are not currently in the innermost minibuffer, prompt the user to | ||
| 414 | confirm 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 | |||
| 339 | DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end, | 435 | DEFUN ("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. */ | ||
| 922 | static Lisp_Object | ||
| 923 | nth_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 | ||
| 1078 | void | ||
| 1079 | barf_if_interaction_inhibited (void) | ||
| 1080 | { | ||
| 1081 | if (inhibit_interaction) | ||
| 1082 | xsignal0 (Qinhibited_interaction); | ||
| 1083 | } | ||
| 1084 | |||
| 942 | DEFUN ("read-from-minibuffer", Fread_from_minibuffer, | 1085 | DEFUN ("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 | ||
| 1129 | If `inhibit-interaction' is non-nil, this function will signal an | ||
| 1130 | `inhibited-interaction' error. | ||
| 1131 | |||
| 986 | The remainder of this documentation string describes the | 1132 | The remainder of this documentation string describes the |
| 987 | INITIAL-CONTENTS argument in more detail. It is only relevant when | 1133 | INITIAL-CONTENTS argument in more detail. It is only relevant when |
| 988 | studying existing code, or when HIST is a cons. If non-nil, | 1134 | studying existing code, or when HIST is a cons. If non-nil, |
| @@ -998,6 +1144,8 @@ and some related functions, which use zero-indexing for POSITION. */) | |||
| 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. |
| 1072 | Such values are treated as in `read-from-minibuffer', but are normally | 1220 | Such values are treated as in `read-from-minibuffer', but are normally |
| 1073 | not useful in this function.) | 1221 | not useful in this function.) |
| 1222 | |||
| 1074 | Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits | 1223 | Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits |
| 1075 | the current input method and the setting of`enable-multibyte-characters'. */) | 1224 | the current input method and the setting of`enable-multibyte-characters'. |
| 1225 | |||
| 1226 | If `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. */); | |||
| 2032 | The function is called with the arguments passed to `read-buffer'. */); | 2186 | The 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. |
| 2037 | Nil means that a minibuffer will appear only in the frame which created it. | 2191 | Nil means that a minibuffer will appear only in the frame which created it. |
| 2192 | Any other value means the minibuffer will move onto another frame, but | ||
| 2193 | only when the user starts using a minibuffer there. | ||
| 2038 | 2194 | ||
| 2039 | Any buffer local or dynamic binding of this variable is ignored. Only the | 2195 | Any buffer local or dynamic binding of this variable is ignored. Only the |
| 2040 | default top level value is used. */); | 2196 | default 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' | |||
| 2183 | uses to hide passwords. */); | 2339 | uses 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. | ||
| 2345 | This variable can be bound when user interaction can't be performed, | ||
| 2346 | for instance when running a headless Emacs server. Functions like | ||
| 2347 | `read-from-minibuffer' (and the like) will signal `inhibited-interaction' | ||
| 2348 | instead. */); | ||
| 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 | |||
| 2325 | static int | ||
| 2326 | emacs_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 | |||
| 2339 | int | ||
| 2340 | emacs_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 | |||
| 3003 | static Lisp_Object | ||
| 3004 | make_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 | |||
| 3700 | Lisp_Object | ||
| 3701 | system_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 | ||
| 3666 | Lisp_Object | 3883 | Lisp_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 | |||
| 2663 | decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object *all_frames) | 2663 | decode_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 | ||
| 1125 | extern EMACS_INT command_loop_level; | 1125 | extern EMACS_INT command_loop_level; |
| 1126 | 1126 | ||
| 1127 | /* Depth in minibuffer invocations. */ | ||
| 1128 | |||
| 1129 | extern 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 | ||
| 257 | NET_TESTS := $(patsubst %.el,%,$(wildcard lisp/net/*.el)) | ||
| 258 | LISP_TESTS := $(patsubst %.el,%,$(wildcard lisp/*.el)) | ||
| 259 | check-net: ${NET_TESTS} | ||
| 260 | check-lisp: ${LISP_TESTS} | ||
| 261 | |||
| 256 | ifeq (@HAVE_MODULES@, yes) | 262 | ifeq (@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 |
| 258 | ifeq ($(SO),.dll) | 264 | ifeq ($(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~. | |||
| 57 | No guidance is given for the organization of resource files inside the | 57 | No 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 |
| 59 | discretion. | 59 | discretion. |
| 60 | |||
| 61 | ** Testing Infrastructure Files | ||
| 62 | |||
| 63 | Files used to support testing infrastructure such as EMBA should be | ||
| 64 | placed 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 | |||
| 27 | FROM debian:stretch as emacs-base | ||
| 28 | |||
| 29 | RUN 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 | |||
| 34 | FROM emacs-base as emacs-inotify | ||
| 35 | |||
| 36 | RUN 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 | |||
| 40 | COPY . /checkout | ||
| 41 | WORKDIR /checkout | ||
| 42 | RUN ./autogen.sh autoconf | ||
| 43 | RUN ./configure --without-makeinfo | ||
| 44 | RUN make bootstrap | ||
| 45 | RUN make -j4 | ||
| 46 | |||
| 47 | FROM emacs-base as emacs-filenotify-gio | ||
| 48 | |||
| 49 | RUN 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 | |||
| 53 | COPY . /checkout | ||
| 54 | WORKDIR /checkout | ||
| 55 | RUN ./autogen.sh autoconf | ||
| 56 | RUN ./configure --without-makeinfo --with-file-notification=gfile | ||
| 57 | RUN make bootstrap | ||
| 58 | RUN make -j4 | ||
| 59 | |||
| 60 | FROM emacs-base as emacs-gnustep | ||
| 61 | |||
| 62 | RUN 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 | |||
| 66 | COPY . /checkout | ||
| 67 | WORKDIR /checkout | ||
| 68 | RUN ./autogen.sh autoconf | ||
| 69 | RUN ./configure --without-makeinfo --with-ns | ||
| 70 | RUN make bootstrap | ||
| 71 | RUN 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 @@ | |||
| 1 | To: example <example@example.org> | ||
| 2 | From: example <example@example.org> | ||
| 3 | Date: Tue, 5 Jan 2021 10:30:34 +0100 | ||
| 4 | MIME-Version: 1.0 | ||
| 5 | Content-Type: multipart/mixed; boundary="------------FB569A4368539497CC91D1DC" | ||
| 6 | Content-Language: fr | ||
| 7 | Subject: test | ||
| 8 | |||
| 9 | --------------FB569A4368539497CC91D1DC | ||
| 10 | Content-Type: multipart/alternative; | ||
| 11 | boundary="------------61C81A7DC7592E4C6F856A85" | ||
| 12 | |||
| 13 | |||
| 14 | --------------61C81A7DC7592E4C6F856A85 | ||
| 15 | Content-Type: text/plain; charset=windows-1252; format=flowed | ||
| 16 | Content-Transfer-Encoding: 8bit | ||
| 17 | |||
| 18 | déjà raté | ||
| 19 | |||
| 20 | --------------61C81A7DC7592E4C6F856A85 | ||
| 21 | Content-Type: text/html; charset=windows-1252 | ||
| 22 | Content-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 | ||
| 36 | Content-Type: text/plain; charset="us-ascii" | ||
| 37 | MIME-Version: 1.0 | ||
| 38 | Content-Transfer-Encoding: 7bit | ||
| 39 | Content-Disposition: inline | ||
| 40 | |||
| 41 | mailing 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 @@ | |||
| 95 | key binding | 95 | key binding |
| 96 | --- ------- | 96 | --- ------- |
| 97 | 97 | ||
| 98 | C-g abort-recursive-edit | 98 | C-g abort-minibuffers |
| 99 | TAB minibuffer-complete | 99 | TAB minibuffer-complete |
| 100 | C-j minibuffer-complete-and-exit | 100 | C-j minibuffer-complete-and-exit |
| 101 | RET minibuffer-complete-and-exit | 101 | RET 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. | ||
| 33 | Requests 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. |
| 5682 | This does not support globbing characters in file names (yet)." | 5735 | This 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. |
| 5696 | Several special characters do not work properly there." | 5749 | Several 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. |
| 5704 | ksh93 makes some strange conversions of non-latin characters into | 5757 | ksh93 makes some strange conversions of non-latin characters into |
| 5705 | a $'' syntax." | 5758 | a $'' 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. |
| 5759 | This does not support utf8 based file transfer." | 5812 | This 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 |