[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/pkg b5099948bc 1/2: Merge remote-tracking branch 'origin/master'
|
From: |
Gerd Moellmann |
|
Subject: |
feature/pkg b5099948bc 1/2: Merge remote-tracking branch 'origin/master' into feature/pkg |
|
Date: |
Tue, 25 Oct 2022 07:34:28 -0400 (EDT) |
branch: feature/pkg
commit b5099948bcb9bc363ee8b1d9858417b20b032299
Merge: 2b5127902d 9bfe00dda6
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>
Merge remote-tracking branch 'origin/master' into feature/pkg
---
.dir-locals.el | 2 +-
.gitignore | 2 +-
ChangeLog.1 | 2 +-
ChangeLog.3 | 6 +-
INSTALL | 2 +-
Makefile.in | 13 +-
admin/automerge | 23 +-
admin/charsets/mapfiles/stdenc.txt | 2 +-
admin/charsets/mapfiles/symbol.txt | 2 +-
admin/diff-tar-files | 8 +-
admin/emacs-shell-lib | 87 +
admin/make-manuals | 13 +-
admin/make-tarball.txt | 2 +-
admin/notes/repo | 18 +
admin/unidata/README | 14 +-
admin/unidata/blocks.awk | 2 +-
admin/unidata/copyright.html | 18 +-
admin/update_autogen | 20 +-
admin/upload-manuals | 10 +-
doc/emacs/building.texi | 11 +-
doc/emacs/custom.texi | 30 +-
doc/emacs/emacs.texi | 2 +-
doc/emacs/killing.texi | 4 +-
doc/emacs/maintaining.texi | 28 +-
doc/emacs/modes.texi | 2 +-
doc/emacs/programs.texi | 213 +-
doc/emacs/text.texi | 17 +-
doc/emacs/vc1-xtra.texi | 32 +
doc/lispref/buffers.texi | 10 +-
doc/lispref/compile.texi | 20 +-
doc/lispref/customize.texi | 24 +-
doc/lispref/display.texi | 2 +-
doc/lispref/files.texi | 34 +-
doc/lispref/functions.texi | 38 +
doc/lispref/lists.texi | 8 +-
doc/lispref/loading.texi | 2 +-
doc/lispref/modes.texi | 9 +-
doc/lispref/numbers.texi | 48 +-
doc/lispref/searching.texi | 14 +-
doc/lispref/symbols.texi | 6 +-
doc/lispref/text.texi | 9 +-
doc/lispref/variables.texi | 108 +-
doc/lispref/windows.texi | 18 +-
doc/misc/Makefile.in | 2 +-
doc/misc/cc-mode.texi | 8 +-
doc/misc/efaq-w32.texi | 8 +-
doc/misc/efaq.texi | 6 +-
doc/misc/eglot.texi | 1138 +++++++
doc/misc/eshell.texi | 66 +-
doc/misc/gnus-faq.texi | 6 +-
doc/misc/gnus.texi | 22 +-
doc/misc/mh-e.texi | 14 +-
doc/misc/octave-mode.texi | 7 +-
doc/misc/org.org | 28 +-
doc/misc/remember.texi | 7 -
doc/misc/sem-user.texi | 2 +-
doc/misc/semantic.texi | 2 +-
doc/misc/sieve.texi | 2 +-
doc/misc/tramp.texi | 6 +
doc/misc/vhdl-mode.texi | 2 +-
etc/DEBUG | 2 +-
etc/HELLO | 1 +
etc/NEWS | 125 +-
etc/NEWS.21 | 2 +-
etc/NEWS.22 | 2 +-
etc/NEWS.25 | 2 +-
etc/NEWS.26 | 2 +-
etc/PROBLEMS | 11 +
etc/TODO | 10 +-
etc/images/gud/README | 4 +-
etc/srecode/ede-autoconf.srt | 2 +-
etc/srecode/ede-make.srt | 4 +-
etc/themes/adwaita-theme.el | 5 +-
etc/themes/deeper-blue-theme.el | 5 +-
etc/themes/dichromacy-theme.el | 5 +-
etc/themes/leuven-dark-theme.el | 8 +-
etc/themes/leuven-theme.el | 8 +-
etc/themes/light-blue-theme.el | 5 +-
etc/themes/manoj-dark-theme.el | 5 +-
etc/themes/misterioso-theme.el | 5 +-
etc/themes/modus-operandi-theme.el | 2 +
etc/themes/modus-vivendi-theme.el | 2 +
etc/themes/tango-dark-theme.el | 7 +-
etc/themes/tango-theme.el | 6 +-
etc/themes/tsdh-dark-theme.el | 6 +-
etc/themes/tsdh-light-theme.el | 6 +-
etc/themes/wheatgrass-theme.el | 5 +-
etc/themes/whiteboard-theme.el | 5 +-
etc/themes/wombat-theme.el | 5 +-
lib-src/rcs2log | 2 +-
lib-src/seccomp-filter.c | 6 +
lisp/ChangeLog.10 | 2 +-
lisp/ChangeLog.14 | 4 +-
lisp/ChangeLog.15 | 2 +-
lisp/ChangeLog.17 | 2 +-
lisp/Makefile.in | 6 +
lisp/ansi-osc.el | 12 +-
lisp/autoinsert.el | 2 +-
lisp/cedet/pulse.el | 2 +-
lisp/cedet/semantic/edit.el | 8 +-
lisp/cedet/srecode/fields.el | 4 +-
lisp/cedet/srecode/insert.el | 4 +-
lisp/comint.el | 30 +-
lisp/custom.el | 73 +-
lisp/dabbrev.el | 3 -
lisp/dired.el | 2 +-
lisp/ecomplete.el | 46 +-
lisp/emacs-lisp/benchmark.el | 1 +
lisp/emacs-lisp/bindat.el | 6 +-
lisp/emacs-lisp/byte-run.el | 5 +
lisp/emacs-lisp/bytecomp.el | 64 +-
lisp/emacs-lisp/cl-extra.el | 4 +-
lisp/emacs-lisp/cl-generic.el | 6 +-
lisp/emacs-lisp/comp.el | 198 +-
lisp/emacs-lisp/eldoc.el | 127 +-
lisp/emacs-lisp/gv.el | 7 +-
lisp/emacs-lisp/icons.el | 25 +-
lisp/emacs-lisp/loaddefs-gen.el | 15 +-
lisp/emacs-lisp/map.el | 164 +-
lisp/emacs-lisp/memory-report.el | 7 +-
lisp/emacs-lisp/package.el | 37 +-
lisp/emacs-lisp/shortdoc.el | 2 +
lisp/emacs-lisp/vtable.el | 14 +-
lisp/erc/ChangeLog.1 | 4 +-
lisp/erc/erc-button.el | 1 -
lisp/erc/erc.el | 7 +-
lisp/eshell/em-script.el | 3 +-
lisp/eshell/em-smart.el | 3 +-
lisp/eshell/em-unix.el | 6 +-
lisp/eshell/esh-arg.el | 3 +-
lisp/eshell/esh-cmd.el | 12 +-
lisp/eshell/esh-ext.el | 23 +-
lisp/eshell/esh-mode.el | 2 -
lisp/eshell/esh-proc.el | 18 +-
lisp/eshell/esh-util.el | 57 +-
lisp/eshell/esh-var.el | 156 +-
lisp/files-x.el | 118 +-
lisp/files.el | 36 +-
lisp/font-lock.el | 20 +-
lisp/format.el | 7 +-
lisp/forms.el | 6 +-
lisp/gnus/gnus-art.el | 206 +-
lisp/gnus/gnus-cite.el | 22 +-
lisp/gnus/gnus-gravatar.el | 1 -
lisp/gnus/gnus-group.el | 1 +
lisp/gnus/gnus-rfc1843.el | 3 +-
lisp/gnus/gnus-sum.el | 1 -
lisp/gnus/gnus-util.el | 5 +-
lisp/gnus/message.el | 19 +-
lisp/gnus/mm-uu.el | 2 +-
lisp/gnus/nndoc.el | 2 +-
lisp/help-fns.el | 2 +-
lisp/help-macro.el | 12 +-
lisp/help.el | 141 +-
lisp/hl-line.el | 3 +-
lisp/htmlfontify.el | 24 +-
lisp/image/wallpaper.el | 136 +-
lisp/info-look.el | 1 +
lisp/info.el | 7 +-
lisp/international/fontset.el | 3 +-
lisp/isearch.el | 3 +-
lisp/jit-lock.el | 26 +-
lisp/language/indonesian.el | 21 +-
lisp/language/misc-lang.el | 30 +-
lisp/language/philippine.el | 12 +-
lisp/ldefs-boot.el | 138 +-
lisp/leim/quail/indian.el | 161 +
lisp/leim/quail/misc-lang.el | 117 +
lisp/leim/quail/slovak.el | 125 +-
lisp/loadup.el | 5 +-
lisp/mail/rmail.el | 12 +-
lisp/menu-bar.el | 10 +-
lisp/mh-e/mh-junk.el | 4 +-
lisp/minibuf-eldef.el | 3 +-
lisp/minibuffer.el | 4 +-
lisp/net/browse-url.el | 5 +
lisp/net/dictionary.el | 5 +-
lisp/net/eudc.el | 61 +-
lisp/net/goto-addr.el | 89 +-
lisp/net/ldap.el | 8 +-
lisp/net/rcirc.el | 14 +-
lisp/net/tramp-integration.el | 23 +-
lisp/net/tramp-sh.el | 17 +-
lisp/net/tramp-sudoedit.el | 57 +-
lisp/net/tramp.el | 49 +-
lisp/nxml/nxml-mode.el | 6 +-
lisp/nxml/nxml-util.el | 6 -
lisp/nxml/rng-nxml.el | 77 +-
lisp/nxml/rng-uri.el | 8 +-
lisp/nxml/rng-valid.el | 37 +-
lisp/obsolete/linum.el | 5 +-
lisp/org/ob-matlab.el | 2 +-
lisp/org/ob-plantuml.el | 2 +-
lisp/org/org-ctags.el | 2 +-
lisp/org/org-protocol.el | 2 +-
lisp/org/org.el | 12 +-
lisp/outline.el | 318 +-
lisp/pcomplete.el | 15 +-
lisp/play/zone.el | 44 +-
lisp/printing.el | 6 +-
lisp/progmodes/antlr-mode.el | 18 +-
lisp/progmodes/cc-defs.el | 1 -
lisp/progmodes/cc-engine.el | 91 +-
lisp/progmodes/cc-fonts.el | 37 +-
lisp/progmodes/cc-langs.el | 27 +-
lisp/progmodes/cc-mode.el | 11 +-
lisp/progmodes/compile.el | 11 +-
lisp/progmodes/cperl-mode.el | 2 +-
lisp/progmodes/eglot.el | 3462 ++++++++++++++++++++
lisp/progmodes/elisp-mode.el | 4 +-
lisp/progmodes/fortran.el | 57 +-
lisp/progmodes/gdb-mi.el | 2 +-
lisp/progmodes/hideshow.el | 32 +-
lisp/progmodes/make-mode.el | 21 +-
lisp/progmodes/modula2.el | 63 +-
lisp/progmodes/opascal.el | 3 +-
lisp/progmodes/perl-mode.el | 9 +-
lisp/progmodes/project.el | 2 +-
lisp/progmodes/python.el | 56 +-
lisp/progmodes/verilog-mode.el | 13 +-
lisp/progmodes/vhdl-mode.el | 7 +-
lisp/progmodes/xref.el | 19 +-
lisp/server.el | 19 +-
lisp/simple.el | 88 +-
lisp/startup.el | 3 +-
lisp/subr.el | 30 +-
lisp/tab-bar.el | 100 +-
lisp/textmodes/bibtex.el | 132 +-
lisp/textmodes/emacs-news-mode.el | 9 +-
lisp/textmodes/enriched.el | 3 +-
lisp/textmodes/flyspell.el | 2 -
lisp/textmodes/less-css-mode.el | 2 +-
lisp/textmodes/sgml-mode.el | 4 +-
lisp/textmodes/string-edit.el | 12 +-
lisp/textmodes/table.el | 19 +-
lisp/textmodes/tex-mode.el | 2 +-
lisp/url/url-file.el | 1 -
lisp/vc/log-view.el | 1 +
lisp/vc/vc-bzr.el | 14 +
lisp/vc/vc-git.el | 69 +-
lisp/vc/vc-hg.el | 12 +
lisp/vc/vc.el | 186 +-
lisp/view.el | 7 -
lisp/x-dnd.el | 5 +-
nt/INSTALL | 24 +-
nt/INSTALL.W64 | 2 +-
oldXMenu/Activate.c | 10 -
oldXMenu/XMenu.h | 2 -
src/ChangeLog.13 | 4 +-
src/comp.c | 17 +-
src/dired.c | 5 +-
src/dispnew.c | 9 +
src/editfns.c | 13 +-
src/fileio.c | 5 +-
src/fns.c | 165 +-
src/frame.c | 28 +-
src/haikuterm.c | 32 +-
src/haikuterm.h | 5 +
src/lisp.h | 15 +-
src/menu.c | 12 +
src/minibuf.c | 12 +-
src/msdos.h | 1 -
src/nsterm.m | 23 +-
src/pdumper.c | 2 +-
src/regex-emacs.c | 14 +-
src/sqlite.c | 173 +-
src/sysdep.c | 2 +-
src/textprop.c | 10 +-
src/widget.c | 42 +-
src/widget.h | 2 +-
src/widgetprv.h | 3 -
src/window.c | 114 +-
src/xdisp.c | 17 +-
src/xfns.c | 129 +-
src/xmenu.c | 67 +-
src/xselect.c | 25 +-
src/xterm.c | 880 ++++-
src/xterm.h | 58 +-
test/lisp/apropos-tests.el | 17 +-
test/lisp/calendar/icalendar-tests.el | 2 +-
test/lisp/cedet/semantic-utest.el | 1 -
test/lisp/dnd-tests.el | 2 +-
test/lisp/emacs-lisp/bindat-tests.el | 19 +-
test/lisp/emacs-lisp/cl-extra-tests.el | 24 +-
test/lisp/emacs-lisp/cl-generic-tests.el | 22 +
test/lisp/emacs-lisp/comp-tests.el | 77 +
test/lisp/emacs-lisp/gv-tests.el | 75 +-
test/lisp/emacs-lisp/map-tests.el | 204 +-
.../package-resources/ustar-withsub-0.1.tar | Bin 0 -> 10240 bytes
.../package-resources/v7-withsub-0.1.tar | Bin 0 -> 10240 bytes
test/lisp/emacs-lisp/package-tests.el | 24 +-
test/lisp/eshell/esh-ext-tests.el | 76 +
test/lisp/eshell/esh-var-tests.el | 220 +-
test/lisp/eshell/eshell-tests-helpers.el | 45 +-
test/lisp/files-x-tests.el | 152 +-
test/lisp/image/wallpaper-tests.el | 98 +
test/lisp/net/eudc-tests.el | 155 +
test/lisp/net/puny-resources/IdnaTestV2.txt | 4 +-
.../progmodes/cperl-mode-resources/here-docs.pl | 66 +
test/lisp/progmodes/python-tests.el | 170 +
test/lisp/progmodes/ruby-mode-resources/ruby.rb | 4 +-
test/lisp/subr-tests.el | 5 +-
test/lisp/time-stamp-tests.el | 8 +-
test/manual/image-circular-tests.el | 41 +-
test/src/fns-tests.el | 92 +-
test/src/lcms-tests.el | 2 +-
test/src/regex-emacs-tests.el | 5 +
test/src/sqlite-tests.el | 13 +
308 files changed, 11482 insertions(+), 2755 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index 84617a7980..f7c73031cc 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,4 +1,4 @@
-;;; Directory Local Variables
+;;; Directory Local Variables -*- no-byte-compile: t; -*-
;;; For more information see (info "(emacs) Directory Variables")
((nil . ((tab-width . 8)
diff --git a/.gitignore b/.gitignore
index c10b3b33d3..a7828d3386 100644
--- a/.gitignore
+++ b/.gitignore
@@ -324,7 +324,7 @@ lib-src/seccomp-filter-exec.pfc
/etc/*.gschema.valid
# Ignore directory made by admin/make-manuals.
-manual/
+/manual/
# Ignore Finder files on MacOS.
.DS_Store
diff --git a/ChangeLog.1 b/ChangeLog.1
index cd31aacafb..35533d60ff 100644
--- a/ChangeLog.1
+++ b/ChangeLog.1
@@ -5685,7 +5685,7 @@
(__mktime_internal): Use it systematically for all isdst comparisons.
This completes the fix for libc BZ #6723, and removes the need for
normalizing tm_isdst.
- See <http://sourceware.org/bugzilla/show_bug.cgi?id=6723>
+ See <https://sourceware.org/bugzilla/show_bug.cgi?id=6723>
(not_equal_tm) [DEBUG]: Use isdst_differ here, too.
mktime: fix some integer overflow issues and sidestep the rest
diff --git a/ChangeLog.3 b/ChangeLog.3
index a09dc29cbe..f2245a4ed5 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -185373,7 +185373,7 @@
* lisp/image.el (image-type-header-regexps):
Allow two or more CRs or LFs in initial whitespace sequences. See:
- http://netpbm.sourceforge.net/doc/pbm.html
+ https://netpbm.sourceforge.net/doc/pbm.html
2017-10-16 Paul Eggert <eggert@cs.ucla.edu>
@@ -197097,7 +197097,7 @@
Clang on macOS warns about these with -Wtautological-compare. POSIX
guarantees that rlim_t is
unsigned (cf.
-
http://pubs.opengroup.org/onlinepubs/009695399/basedefs/sys/resource.h.html),
+
https://pubs.opengroup.org/onlinepubs/009695399/basedefs/sys/resource.h.html),
so these resource limits can never be negative.
* src/emacs.c (main): Remove tautological comparisons.
@@ -199197,7 +199197,7 @@
' is commonly used as an apostrophe in the prose sections of spec
files, which was erroneously highlighted as strings. See for example
- http://kmymoney2.sourceforge.net/phb/rpm-example.html
+ https://kmymoney2.sourceforge.net/phb/rpm-example.html
* lisp/progmodes/sh-script.el (sh-mode-syntax-table): Treat ' as
punctuation in RPM spec files.
diff --git a/INSTALL b/INSTALL
index 95d2dbda80..c0323f770b 100644
--- a/INSTALL
+++ b/INSTALL
@@ -187,7 +187,7 @@ X11 is being used.
libz (for PNG): https://www.zlib.net/
X libjpeg for JPEG: https://www.ijg.org/
X libtiff for TIFF: http://www.simplesystems.org/libtiff/
- X libgif for GIF: http://giflib.sourceforge.net/
+ X libgif for GIF: https://giflib.sourceforge.net/
librsvg2 for SVG: https://wiki.gnome.org/Projects/LibRsvg
libwebp for WebP: https://developers.google.com/speed/webp/
diff --git a/Makefile.in b/Makefile.in
index 741a4c5538..45b4a59e3d 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -52,14 +52,14 @@
# make bootstrap
# Removes all the compiled files to force a new bootstrap from a
# clean slate, and then build in the normal way. If the FAST Make
-# variable is set, then the config.cache file isn't removed. This
-# allows you to say
+# variable is set, then the autom4te.cache directory and the
+# config.cache file are not removed. This lets you say
#
# ./configure -C
# make FAST=true bootstrap
#
# and use the cached results from the configure run, which is much
-# faster.
+# faster though it does not work in general.
#
# make docs
# Make Emacs documentation files from their sources; requires makeinfo.
@@ -530,6 +530,11 @@ lisp: src
lib lib-src lisp nt: Makefile
$(MAKE) -C $@ all
+trampolines: src lisp
+ifeq ($(HAVE_NATIVE_COMP),yes)
+ $(MAKE) -C lisp trampolines
+endif
+
# Pass an unexpanded $srcdir to src's Makefile, which then
# expands it using its own value of srcdir (which points to the
# source directory of src/).
@@ -1035,7 +1040,7 @@ bootstrap-clean: $(distclean_dirs:=_bootstrap-clean)
rm -f ${srcdir}/etc/refcards/emacsver.tex
rm -rf native-lisp/ lisp/leim/ja-dic/
ifndef FAST
- rm -f config.cache
+ rm -fr autom4te.cache config.cache
endif
${top_bootclean}
diff --git a/admin/automerge b/admin/automerge
index c7c17dfb5e..d2c92948e1 100755
--- a/admin/automerge
+++ b/admin/automerge
@@ -35,18 +35,7 @@
## it with the -d option in the repository directory, in case a pull
## updates this script while it is working.
-set -o nounset
-
-die () # write error to stderr and exit
-{
- [ $# -gt 0 ] && echo "$PN: $*" >&2
- exit 1
-}
-
-PN=${0##*/} # basename of script
-PD=${0%/*}
-
-[ "$PD" = "$0" ] && PD=. # if PATH includes PWD
+source "${0%/*}/emacs-shell-lib"
usage ()
{
@@ -129,13 +118,7 @@ OPTIND=1
[ "$test" ] && build=1
-if [ -x "$(command -v mktemp)" ]; then
- tempfile=$(mktemp "/tmp/$PN.XXXXXXXXXX")
-else
- tempfile=/tmp/$PN.$$
-fi
-
-trap 'rm -f $tempfile 2> /dev/null' EXIT
+tempfile="$(emacs_mktemp)"
[ -e Makefile ] && [ "$build" ] && {
@@ -263,5 +246,3 @@ git push || die "push error"
exit 0
-
-### automerge ends here
diff --git a/admin/charsets/mapfiles/stdenc.txt
b/admin/charsets/mapfiles/stdenc.txt
index e39486a319..1c898bac0b 100644
--- a/admin/charsets/mapfiles/stdenc.txt
+++ b/admin/charsets/mapfiles/stdenc.txt
@@ -54,7 +54,7 @@
#
# [v0.1, 5 May 1995] First release.
#
-# Use the Unicode reporting form <http://www.unicode.org/reporting.html>
+# Use the Unicode reporting form <https://www.unicode.org/reporting.html>
# for any questions or comments or to report errors in the data.
#
0020 20 # SPACE # space
diff --git a/admin/charsets/mapfiles/symbol.txt
b/admin/charsets/mapfiles/symbol.txt
index b98baf6cf0..0a5aac8b61 100644
--- a/admin/charsets/mapfiles/symbol.txt
+++ b/admin/charsets/mapfiles/symbol.txt
@@ -57,7 +57,7 @@
#
# [v0.1, 5 May 1995] First release.
#
-# Use the Unicode reporting form <http://www.unicode.org/reporting.html>
+# Use the Unicode reporting form <https://www.unicode.org/reporting.html>
# for any questions or comments or to report errors in the data.
#
0020 20 # SPACE # space
diff --git a/admin/diff-tar-files b/admin/diff-tar-files
index 6ab39eab2f..869c942150 100755
--- a/admin/diff-tar-files
+++ b/admin/diff-tar-files
@@ -1,4 +1,4 @@
-#! /bin/sh
+#!/bin/bash
# Copyright (C) 2001-2022 Free Software Foundation, Inc.
@@ -17,6 +17,7 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+source "${0%/*}/emacs-shell-lib"
if [ $# != 2 ]; then
cat <<EOF
@@ -31,9 +32,8 @@ fi
old_tar=$1
new_tar=$2
-old_tmp=/tmp/old.$$
-new_tmp=/tmp/new.$$
-trap "rm -f $old_tmp $new_tmp; exit 1" 1 2 15
+old_tmp="$(emacs_mktemp ${PN}-old)"
+new_tmp="$(emacs_mktemp ${PN}-new)"
tar tf "$old_tar" | sed -e 's,^[^/]*,,' | sort > $old_tmp
tar tf "$new_tar" | sed -e 's,^[^/]*,,' | sort > $new_tmp
diff --git a/admin/emacs-shell-lib b/admin/emacs-shell-lib
new file mode 100644
index 0000000000..750f81e057
--- /dev/null
+++ b/admin/emacs-shell-lib
@@ -0,0 +1,87 @@
+#!/bin/bash
+### emacs-shell-lib - shared code for Emacs shell scripts
+
+## Copyright (C) 2022 Free Software Foundation, Inc.
+
+## Author: Stefan Kangas <stefankangas@gmail.com>
+
+## This file is part of GNU Emacs.
+
+## GNU Emacs is free software: you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+
+## GNU Emacs is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+
+## You should have received a copy of the GNU General Public License
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+### Code:
+
+# Set an explicit umask.
+umask 077
+
+# Treat unset variables as an error.
+set -o nounset
+
+# Exit immediately on error.
+set -o errexit
+
+# Avoid non-standard command output from non-C locales.
+unset LANG LC_ALL LC_MESSAGES
+
+PN=${0##*/} # basename of script
+PD=${0%/*} # script directory
+
+[ "$PD" = "$0" ] && PD=. # if PATH includes PWD
+
+die () # write error to stderr and exit
+{
+ [ $# -gt 0 ] && echo "$PN: $@" >&2
+ exit 1
+}
+
+emacs_tempfiles=()
+
+emacs_tempfiles_cleanup ()
+{
+ for file in ${emacs_tempfiles[@]}; do
+ rm -f "${file}" 2> /dev/null
+ done
+}
+
+trap '
+ ret=$?
+ emacs_tempfiles_cleanup
+ exit $ret
+' EXIT
+
+emacs_mktemp ()
+{
+ local readonly file="${1-}"
+ local tempfile
+ local prefix
+
+ if [ -z "$file" ]; then
+ prefix="$PN"
+ else
+ prefix="$1"
+ fi
+
+ if [ -x "$(command -v mktemp)" ]; then
+ tempfile=$(mktemp "${TMPDIR-/tmp}/${prefix}.XXXXXXXXXX")
+ else
+ tempfile="${TMPDIR-/tmp}/${prefix}.$RANDOM$$"
+ (umask 077 && touch "$tempfile")
+ fi
+
+ [ -z "${tempfile}" ] && die "Creating temporary file failed"
+
+ emacs_tempfiles+=("${tempfile}")
+
+ echo "$tempfile"
+}
diff --git a/admin/make-manuals b/admin/make-manuals
index cb0c00a423..a252bf20f1 100755
--- a/admin/make-manuals
+++ b/admin/make-manuals
@@ -33,15 +33,7 @@
### Code:
-set -o nounset
-
-die () # write error to stderr and exit
-{
- [ $# -gt 0 ] && echo "$PN: $@" >&2
- exit 1
-}
-
-PN=${0##*/} # basename of script
+source "${0%/*}/emacs-shell-lib"
usage ()
{
@@ -96,8 +88,7 @@ OPTIND=1
[ -e admin/admin.el ] || die "admin/admin.el not found"
-tempfile=/tmp/$PN.$$
-trap "rm -f $tempfile 2> /dev/null" EXIT
+tempfile="$(emacs_mktemp)"
[ "$continue" ] || rm -rf $outdir
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt
index 9a406b24fa..d881b81612 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -390,7 +390,7 @@ Next, regenerate the various manuals in HTML, PDF, and PS
formats:
Now change to the 'manual' directory and invoke upload-manuals:
- ../admin/updload-manuals /path/to/webpages/cvs/checkout
+ ../admin/upload-manuals /path/to/webpages/cvs/checkout
where /path/to/webpages/cvs/checkout is the place where you have the
CVS checkout of the Emacs Web pages, with subdirectories 'manual'
diff --git a/admin/notes/repo b/admin/notes/repo
index c2d7f993a0..2185c5a003 100644
--- a/admin/notes/repo
+++ b/admin/notes/repo
@@ -42,6 +42,24 @@ yet another fun excursion into the exciting world of version
control.
https://lists.gnu.org/r/emacs-devel/2010-04/msg00086.html
+* feature and scratch branches
+
+Besides the master branch, which is where development takes place, and
+the "emacs-NN" release branches, we also have branches whose names
+start with "scratch/" and "feature/". The "feature/" prefix is used
+for feature branches that are intended to live for some time, while
+"scratch/" is for one-off throw-away-after-use branches.
+
+We do not intend to "git merge" from scratch branches, so force-pushes
+are tolerated, as well as commits with poor style, incomplete commit
+messages, etc.
+
+We do expect to "git merge" from feature branches so: no force push,
+and no commits that don't have a proper commit message.
+
+Automatic tests are run for feature/* branches on EMBA.
+See: https://emba.gnu.org/emacs/emacs/-/pipelines
+
* Installing changes from gnulib
Some of the files in Emacs are copied from gnulib. To synchronize
diff --git a/admin/unidata/README b/admin/unidata/README
index 2da01402b7..2d421dfb6b 100644
--- a/admin/unidata/README
+++ b/admin/unidata/README
@@ -6,31 +6,31 @@ copyright.html.
The names, URLs, and dates for these files are as follows.
BidiBrackets.txt
-http://www.unicode.org/Public/UNIDATA/BidiBrackets.txt
+https://www.unicode.org/Public/UNIDATA/BidiBrackets.txt
2021-06-30
BidiMirroring.txt
-http://www.unicode.org/Public/UNIDATA/BidiMirroring.txt
+https://www.unicode.org/Public/UNIDATA/BidiMirroring.txt
2021-08-08
Blocks.txt
-http://www.unicode.org/Public/8.0.0/ucd/Blocks.txt
+https://www.unicode.org/Public/8.0.0/ucd/Blocks.txt
2021-01-22
IVD_Sequences.txt
-http://www.unicode.org/ivd/
+https://www.unicode.org/ivd/
2020-11-06
NormalizationTest.txt
-http://www.unicode.org/Public/UNIDATA/NormalizationTest.txt
+https://www.unicode.org/Public/UNIDATA/NormalizationTest.txt
2021-05-28
SpecialCasing.txt
-http://unicode.org/Public/UNIDATA/SpecialCasing.txt
+https://unicode.org/Public/UNIDATA/SpecialCasing.txt
2021-03-08
UnicodeData.txt
-http://www.unicode.org/Public/UNIDATA/UnicodeData.txt
+https://www.unicode.org/Public/UNIDATA/UnicodeData.txt
2021-07-06
emoji-data.txt
diff --git a/admin/unidata/blocks.awk b/admin/unidata/blocks.awk
index 1c571feff3..48a14ec3ca 100755
--- a/admin/unidata/blocks.awk
+++ b/admin/unidata/blocks.awk
@@ -23,7 +23,7 @@
### Commentary:
## This script takes as input Unicode's Blocks.txt
-## (http://www.unicode.org/Public/UNIDATA/Blocks.txt)
+## (https://www.unicode.org/Public/UNIDATA/Blocks.txt)
## and produces output for Emacs's lisp/international/charscript.el.
## It lumps together all the blocks belonging to the same language.
diff --git a/admin/unidata/copyright.html b/admin/unidata/copyright.html
index 0ae01c11ad..567c54e72a 100644
--- a/admin/unidata/copyright.html
+++ b/admin/unidata/copyright.html
@@ -13,7 +13,7 @@
<title>Unicode Terms of Use</title>
<link rel="stylesheet" type="text/css"
-href="http://www.unicode.org/webscripts/standard_styles.css";>
+href="https://www.unicode.org/webscripts/standard_styles.css";>
<style type="text/css">
pre {
@@ -32,8 +32,8 @@ pre {
<td colspan="2">
<table width="100%" border="0" cellpadding="0" cellspacing="0">
<tr>
- <td class="icon" style="width:38px; height:35px"><a
href="http://www.unicode.org/";><img border="0"
- src="http://www.unicode.org/webscripts/logo60s2.gif"; align="middle"
alt="[Unicode]" width="34" height="33"></a></td>
+ <td class="icon" style="width:38px; height:35px"><a
href="https://www.unicode.org/";><img border="0"
+ src="https://www.unicode.org/webscripts/logo60s2.gif"; align="middle"
alt="[Unicode]" width="34" height="33"></a></td>
<td class="icon" style="vertical-align:middle;"> <a class="bar"
href="https://www.unicode.org/copyright.html";><font size="3">Terms
of Use</font></a></td>
<td class="bar"><a href="https://www.unicode.org/main.html";
class="bar">Tech Site</a>
@@ -112,7 +112,7 @@ pre {
<p>For the general privacy policy governing access to this site,
see
the
- <a href="http://www.unicode.org/policies/privacy_policy.html";>
+ <a href="https://www.unicode.org/policies/privacy_policy.html";>
Unicode Privacy Policy</a>.</p>
<ol type="A">
@@ -158,7 +158,7 @@ http://site.icu-project.org/download/
specifications of rights and restrictions of use. For the book
editions (Unicode 5.0 and earlier), these are found on the back
of the
- <a
href="http://www.unicode.org/versions/Unicode5.0.0/Title.pdf";>title
page</a>.</li>
+ <a
href="https://www.unicode.org/versions/Unicode5.0.0/Title.pdf";>title
page</a>.</li>
<li>
The Unicode PDF <a
href="https://www.unicode.org/charts/";>online code charts</a> carry specific
restrictions. Those restrictions are incorporated as the
first page of each PDF code chart.</li>
@@ -224,7 +224,7 @@ http://site.icu-project.org/download/
<li><u><a name="5"></a>Trademarks & Logos</u>
<ol>
<li>The Unicode Word Mark and the Unicode Logo are trademarks
of Unicode, Inc. “The Unicode Consortium” and “Unicode, Inc.” are trade names
of Unicode, Inc. Use of the information and materials found on this website
indicates your acknowledgement of Unicode, Inc.’s exclusive worldwide rights in
the Unicode Word Mark, the Unicode Logo, and the Unicode trade names.</li>
-<li><a href="http://www.unicode.org/policies/logo_policy.html";>The Unicode
Consortium Name and Trademark Usage Policy</a> (“Trademark Policy”) are
incorporated herein by reference and you agree to abide by the provisions of
the Trademark Policy, which may be changed from time to time in the sole
discretion of Unicode, Inc.</li>
+<li><a href="https://www.unicode.org/policies/logo_policy.html";>The Unicode
Consortium Name and Trademark Usage Policy</a> (“Trademark Policy”) are
incorporated herein by reference and you agree to abide by the provisions of
the Trademark Policy, which may be changed from time to time in the sole
discretion of Unicode, Inc.</li>
<li>All third party trademarks referenced herein are the property of their
respective owners.</li>
</ol>
</li>
@@ -270,15 +270,15 @@ http://site.icu-project.org/download/
<center>
<table cellspacing="0" cellpadding="0" border="0" id="table2">
<tr>
- <td><a href="http://www.unicode.org/copyright.html";>
- <img src="http://www.unicode.org/img/hb_notice.gif";
+ <td><a href="https://www.unicode.org/copyright.html";>
+ <img src="https://www.unicode.org/img/hb_notice.gif";
border="0" alt="Access to Copyright and terms of use"
width="216" height="50"></a></td>
</tr>
</table>
<script language="Javascript" type="text/javascript"
- src="http://www.unicode.org/webscripts/lastModified.js";>
+ src="https://www.unicode.org/webscripts/lastModified.js";>
</script>
</center>
diff --git a/admin/update_autogen b/admin/update_autogen
index d1f49d9f25..55e11be95c 100755
--- a/admin/update_autogen
+++ b/admin/update_autogen
@@ -32,18 +32,7 @@
### Code:
-set -o nounset
-
-die () # write error to stderr and exit
-{
- [ $# -gt 0 ] && echo "$PN: $@" >&2
- exit 1
-}
-
-PN=${0##*/} # basename of script
-PD=${0%/*}
-
-[ "$PD" = "$0" ] && PD=. # if PATH includes PWD
+source "${0%/*}/emacs-shell-lib"
## This should be the admin directory.
cd $PD || exit
@@ -102,10 +91,7 @@ done
[ "$basegen" ] || die "internal error"
-tempfile=/tmp/$PN.$$
-
-trap 'rm -f $tempfile 2> /dev/null' EXIT
-
+tempfile="$(emacs_mktemp)"
while getopts ":hcfqA:CL" option ; do
case $option in
@@ -312,5 +298,3 @@ commit "loaddefs" $modified || die "commit error"
exit 0
-
-### update_autogen ends here
diff --git a/admin/upload-manuals b/admin/upload-manuals
index 50336ee64c..04f7c3acc7 100755
--- a/admin/upload-manuals
+++ b/admin/upload-manuals
@@ -36,15 +36,7 @@
### Code:
-set -o nounset
-
-die () # write error to stderr and exit
-{
- [ $# -gt 0 ] && echo "$PN: $@" >&2
- exit 1
-}
-
-PN=${0##*/} # basename of script
+source "${0%/*}/emacs-shell-lib"
usage ()
{
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index b79fa0a755..93ad4145cc 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -537,10 +537,13 @@ C/C++ files this is usually the C compiler. Flymake can
also use
build tools such as @code{make} for checking complicated projects.
To enable Flymake mode, type @kbd{M-x flymake-mode}. You can jump
-to the errors that it finds by using @kbd{M-x flymake-goto-next-error}
-and @kbd{M-x flymake-goto-prev-error}. To display any error messages
-associated with the current line, type @kbd{M-x
-flymake-display-err-menu-for-current-line}.
+to the errors that it finds by using @w{@kbd{M-x
+flymake-goto-next-error}} and @w{@kbd{M-x flymake-goto-prev-error}}.
+To display a detailed overview of the diagnostics for the current
+buffer, use the command @w{@kbd{M-x flymake-show-buffer-diagnostics}};
+to display a similar overview of diagnostics for the entire project
+(@pxref{Projects}), use @w{@kbd{M-x
+flymake-show-project-diagnostics}}.
For more details about using Flymake,
@ifnottex
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index ff7ab83190..08ada2a70b 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -667,6 +667,16 @@ type @kbd{M-x disable-theme}.
the @file{*Custom Themes*} buffer; or type @kbd{M-x describe-theme}
anywhere in Emacs and enter the theme name.
+@findex theme-choose-variant
+Some themes have variants (most often just two: light and dark). You
+can switch to another variant using @kbd{M-x theme-choose-variant}.
+If the currently active theme has only one other variant, it will be
+selected; if there are more variants, the command will prompt you
+which one to switch to.
+
+Note that @code{theme-choose-variant} only works if a single theme
+is active.
+
@node Creating Custom Themes
@subsection Creating Custom Themes
@cindex custom themes, creating
@@ -1261,7 +1271,7 @@ mode: my-new
disable a minor mode in a local variables list, use the @code{eval}
keyword with a Lisp expression that runs the mode command
(@pxref{Minor Modes}). For example, the following local variables
-list enables ElDoc mode (@pxref{Lisp Doc}) by calling
+list enables ElDoc mode (@pxref{Programming Language Doc}) by calling
@code{eldoc-mode} with no argument (calling it with an argument of 1
would do the same), and disables Font Lock mode (@pxref{Font Lock}) by
calling @code{font-lock-mode} with an argument of @minus{}1.
@@ -2811,6 +2821,24 @@ strings incorrectly. You should then avoid adding Emacs
Lisp code
that modifies the coding system in other ways, such as calls to
@code{set-language-environment}.
+ An alternative to using non-@acronym{ASCII} characters directly is
+to use one of the character escape syntaxes described in
+@pxref{General Escape Syntax,,, elisp, The Emacs Lisp Reference
+Manual}, as they allow all Unicode codepoints to be specified using
+only @acronym{ASCII} characters.
+
+ To bind non-@acronym{ASCII} keys, you must use a vector (@pxref{Init
+Rebinding}). The string syntax cannot be used, since the
+non-@acronym{ASCII} characters will be interpreted as meta keys. For
+instance:
+
+@example
+(global-set-key [?@var{char}] 'some-function)
+@end example
+
+@noindent
+Type @kbd{C-q}, followed by the key you want to bind, to insert @var{char}.
+
@node Early Init File
@subsection The Early Init File
@cindex early init file
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 727f5f93bf..5c81641bf6 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -718,7 +718,7 @@ Documentation Lookup
* Info Lookup:: Looking up library functions and commands in Info files.
* Man Page:: Looking up man pages of library functions and commands.
-* Lisp Doc:: Looking up Emacs Lisp functions, etc.
+* Programming Language Doc:: Looking up program functions, variables, etc.
C and Related Modes
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index bb8d51158a..bac2f7ff78 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -570,8 +570,8 @@ change the variable @code{select-enable-clipboard} to
@code{nil}.
instance, a web browser will usually let you choose ``Copy Image'' on
images, and this image will be put on the clipboard. On capable
platforms, Emacs can yank these objects with the @code{yank-media}
-command---but only in modes that have support for it (@w{@pxref{Yanking
-Media,,, elisp, The Emacs Lisp Reference Manual}}).
+command---but only in modes that have support for it (@pxref{Yanking
+Media,,, elisp, The Emacs Lisp Reference Manual}).
@cindex clipboard manager
@vindex x-select-enable-clipboard-manager
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 6857e67def..2de6b3604f 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -4,6 +4,8 @@
@c See file emacs.texi for copying conditions.
@node Maintaining
@chapter Maintaining Large Programs
+@cindex maintaining large programs
+@cindex large programming projects, maintaining
This chapter describes Emacs features for maintaining medium- to
large-size programs and packages. These features include:
@@ -2094,6 +2096,13 @@ definitions of symbols. (One disadvantage of this kind
of backend is
that it only knows about subunits that were loaded into the
interpreter.)
+@item
+If Eglot is activated for the current buffer's project
+(@pxref{Projects}) and the current buffer's major mode, Eglot consults
+an external language server program and provides the data supplied by
+the server regarding the definitions of the identifiers in the
+project. @xref{Eglot Features,,, eglot, Eglot: The Emacs LSP Client}.
+
@item
An external program can extract references by scanning the relevant
files, and build a database of these references. A backend can then
@@ -2302,7 +2311,9 @@ Display the reference on the current line in the other
window
@item r @var{pattern} @key{RET} @var{replacement} @key{RET}
Perform interactive query-replace on references that match
@var{pattern} (@code{xref-query-replace-in-results}), replacing
-the match with @var{replacement}. @xref{Identifier Search}.
+the match with @var{replacement}. This command can only be used in
+@file{*xref*} buffers that show all the matches for an identifier in
+all the relevant files. @xref{Identifier Search}.
@item g
@findex xref-revert-buffer
@@ -2336,7 +2347,8 @@ them.
@item M-?
Find all the references for the identifier at point.
-@item M-x xref-query-replace-in-results @key{RET} @var{replacement} @key{RET}
+@item r
+@itemx M-x xref-query-replace-in-results @key{RET} @var{replacement} @key{RET}
@itemx C-u M-x xref-query-replace-in-results @key{RET} @var{regexp} @key{RET}
@var{replacement} @key{RET}
Interactively replace @var{regexp} with @var{replacement} in the names
of all the identifiers shown in the @file{*xref*} buffer.
@@ -2382,16 +2394,18 @@ shown. The default value is @code{nil}, which just
shows the results
in the @file{*xref*} buffer, but doesn't select any of them.
@findex xref-query-replace-in-results
- @kbd{M-x xref-query-replace-in-results} reads a @var{replacement}
+ @kbd{r} (@code{xref-query-replace-in-results}) reads a @var{replacement}
string, just like ordinary @kbd{M-x query-replace-regexp}. It then
renames the identifiers shown in the @file{*xref*} buffer in all the
places in all the files where these identifiers are referenced, such
that their new name is @var{replacement}. This is useful when you
rename your identifiers as part of refactoring. This command should
-be invoked in the @file{*xref*} buffer generated by @kbd{M-?}. With a
-prefix argument, the command also prompts for a regexp to match
-identifier names, and renames that regexp in the names of the matching
-identifiers with @var{replacement}.
+be invoked in the @file{*xref*} buffer generated by @kbd{M-?}. By
+default, the command replaces the entire name of each identifier with
+@var{replacement}, but if invoked with a prefix argument, the command
+prompts for a regexp to match identifier names, and replaces only the
+matches of that regexp in the names of the identifiers with
+@var{replacement}.
@findex xref-find-references-and-replace
@kbd{M-x xref-find-references-and-replace} works similarly to
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index 56b779f8de..1a32f61947 100644
--- a/doc/emacs/modes.texi
+++ b/doc/emacs/modes.texi
@@ -127,7 +127,7 @@ see which mode is actually being entered.
Modes}). For example, you can put the following lines in your init
file to enable Flyspell minor mode in all text-based major modes
(@pxref{Spelling}), and ElDoc minor mode in Emacs Lisp mode
-(@pxref{Lisp Doc}):
+(@pxref{Programming Language Doc}):
@example
(add-hook 'text-mode-hook 'flyspell-mode)
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 03f565808d..6abf29c009 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -287,6 +287,13 @@ they occur in the buffer; if you want alphabetic sorting,
use the
symbol @code{imenu--sort-by-name} as the value. You can also
define your own comparison function by writing Lisp code.
+ If Eglot is activated for the current buffer's project
+(@pxref{Projects}) and the current buffer's major mode, Eglot provides
+its own facility for producing the buffer's index based on the
+analysis of the program source by the language-server which manages
+the current buffer. @xref{Eglot Features,,, eglot, Eglot: The Emacs
+LSP Client}.
+
Imenu provides the information to guide Which Function mode
@ifnottex
(@pxref{Which Function}).
@@ -985,7 +992,7 @@ Set comment column (@code{comment-set-column}).
@item @kbd{C-M-j}
@itemx @kbd{M-j}
Like @kbd{@key{RET}} followed by inserting and aligning a comment
-(@code{comment-indent-new-line}). @xref{Multi-Line Comments}.
+(@code{default-indent-new-line}). @xref{Multi-Line Comments}.
@item @kbd{M-x comment-region}
@itemx @kbd{C-c C-c} (in C-like modes)
Add comment delimiters to all the lines in the region.
@@ -1080,10 +1087,10 @@ the brace rather than at @code{comment-column}. For
full details see
@kindex C-M-j
@kindex M-j
@cindex blank lines in programs
-@findex comment-indent-new-line
+@findex default-indent-new-line
@vindex comment-multi-line
If you are typing a comment and wish to continue it to another line,
-type @kbd{M-j} or @kbd{C-M-j} (@code{comment-indent-new-line}). This
+type @kbd{M-j} or @kbd{C-M-j} (@code{default-indent-new-line}). This
breaks the current line, and inserts the necessary comment delimiters
and indentation to continue the comment.
@@ -1190,7 +1197,7 @@ use in your program.
@menu
* Info Lookup:: Looking up library functions and commands in Info
files.
* Man Page:: Looking up man pages of library functions and commands.
-* Lisp Doc:: Looking up Emacs Lisp functions, etc.
+* Programming Language Doc:: Looking up program functions, variables, etc.
@end menu
@node Info Lookup
@@ -1291,8 +1298,10 @@ WoMan Manual}.
the WoMan Info manual, which is distributed with Emacs.
@end ifnotinfo
-@node Lisp Doc
-@subsection Emacs Lisp Documentation Lookup
+@node Programming Language Doc
+@subsection Programming Language Documentation Lookup
+@cindex documentation for program symbols
+@cindex program functions and variables, documentation lookup
When editing Emacs Lisp code, you can use the commands @kbd{C-h f}
(@code{describe-function}) and @kbd{C-h v} (@code{describe-variable})
@@ -1300,43 +1309,120 @@ to view the built-in documentation for the Lisp
functions and
variables that you want to use. @xref{Name Help}.
@cindex ElDoc mode
+@cindex at-point documentation for program symbols
@findex eldoc-mode
@findex global-eldoc-mode
- ElDoc is a buffer-local minor mode that helps with looking up Lisp
-documentation. When it is enabled, the echo area displays some useful
-information whenever there is a Lisp function or variable at point;
-for a function, it shows the argument list, and for a variable it
-shows the first line of the variable's documentation string. To
-toggle ElDoc mode, type @kbd{M-x eldoc-mode}. There's also a Global
-ElDoc mode, which is turned on by default, and affects buffers whose
-major mode sets the variables described below. Use @w{@kbd{M-x
-global-eldoc-mode}} to turn it off globally.
-
-@vindex eldoc-documentation-strategy
-@vindex eldoc-documentation-functions
- These variables can be used to configure ElDoc mode:
+ ElDoc@footnote{
+The name ``ElDoc'' is a historical accident: this mode started by
+supporting Emacs Lisp buffers.
+} is a buffer-local minor mode that helps with looking up
+documentation of symbols (functions, methods, classes, variables,
+etc.) in your program. When this mode is enabled, the echo area
+displays useful information whenever there is a documented symbol at
+point. For example, in buffers under the Emacs Lisp mode, it shows
+the argument list of a function at point, and for a Lisp variable it
+shows the first line of the variable's documentation string.
+
+To toggle ElDoc mode, type @kbd{M-x eldoc-mode}. There's also a
+Global ElDoc mode, which is turned on by default, and turns on the
+ElDoc mode in buffers whose major mode sets the variables described
+below. Use @w{@kbd{M-x global-eldoc-mode}} to turn it off globally.
+
+Various major modes configure the Global ElDoc mode to use their
+documentation functions. Examples include Emacs Lisp mode, Python
+mode, and Cfengine mode. In addition, Emacs features that provide
+support for several major modes configure ElDoc to use their
+facilities for retrieving the documentation. Examples include Eglot
+(@pxref{Eglot Features,,, eglot, Eglot: The Emacs LSP Client}), which
+provides documentation based on information from language servers;
+Semantic's Idle Summary mode (@pxref{Idle Summary Mode,,, semantic,
+Semantic Manual}); and Flymake, which uses ElDoc to show diagnostics
+at point (@pxref{Finding diagnostics,,, flymake, GNU Flymake manual}).
+
+The ElDoc mode works by scheduling the display of the available
+documentation for the symbol at point after Emacs has been idle for
+some short time. This avoids annoying flickering of documentation
+messages in the echo area or the mode line when you type quickly and
+without delay.
+
+@findex eldoc-print-current-symbol-info
+You can also trigger the display of documentation for a symbol at
+point by using the command @kbd{M-x eldoc-print-current-symbol-info}.
+
+ The following variables can be used to configure ElDoc mode:
+
+@vtable @code
+@item eldoc-idle-delay
+The value of this user option controls the amount of idle time before
+the at-point documentation is displayed. It should be set to the
+number of seconds to wait; the value of zero means to display without
+any delay. The default is 0.5 sec.
+
+@item eldoc-print-after-edit
+If this user option is non-@code{nil}, ElDoc will show documentation
+only after some editing command, like inserting or deleting some
+text. This comes in handy if you want Emacs to display documentation
+only about symbols that you type, but not about symbols that are
+already in the buffer (so just reading the source code will not show
+documentation). The default value is @code{nil}. If you change the
+value, you need to toggle @code{eldoc-mode} off and on again.
+
+@item eldoc-echo-area-use-multiline-p
+This user option controls whether and how to truncate documentation
+text if it is longer than the echo-area can display as a single screen
+line. If the value is a positive number, it specifies the number of
+screen lines that ElDoc is allowed to display in the echo area without
+truncating the documentation. A positive integer specifies the
+absolute maximum number of screen lines to use; a floating-point
+number specifies the number of screen lines as a fraction of the
+frame's height. The value of @code{t} means never truncate the
+documentation (the echo-area will be resized up to the height allowed
+by @code{max-mini-window-height}, @pxref{Minibuffer Edit}), whereas
+the value of @code{nil} means truncate if the documentation is longer
+than a single screen line. Finally, the special value
+@code{truncate-sym-name-if-fit} (the default) means to truncate the
+part of the documentation that represents a symbol's name if doing
+that will allow the documentation to fit on a single screen line.
+
+@item eldoc-echo-area-display-truncation-message
+If non-@code{nil} (the default), and documentation shown in the echo
+area is truncated because it's too long, follow the documentation by
+instructions about how to view the complete documentation text. If
+@code{nil}, just indicate with @samp{@dots{}} that the documentation
+was truncated.
+
+@findex eldoc-doc-buffer
+@item eldoc-echo-area-prefer-doc-buffer
+If the value of this user option is @code{t}, ElDoc will not show the
+documentation in the echo area if the ElDoc buffer with the
+documentation is already displayed in some window. (You can use the
+command @kbd{M-x eldoc-doc-buffer} any time to show the ElDoc buffer.)
+If the value of this option is the symbol @code{maybe}, the
+documentation will not be displayed in the echo area if the ElDoc
+buffer is shown in some window, and the documentation text has to be
+truncated if displayed in the echo area. Finally, the value of
+@code{nil} (the default) means always show the documentation in the
+echo area.
-@table @code
@item eldoc-documentation-strategy
-This variable holds the function which is used to retrieve
-documentation for the item at point from the functions in the hook
-@code{eldoc-documentation-functions}. By default,
-@code{eldoc-documentation-strategy} returns the first documentation
-string produced by the @code{eldoc-documentation-functions} hook, but
-it may be customized to compose those functions' results in other
-ways.
+This customizable variable's value is the function which is used to
+retrieve and display documentation for the symbol at point. The
+documentation is produced by the functions in the hook
+@code{eldoc-documentation-functions}. The default value of
+@code{eldoc-documentation-strategy} specifies that ElDoc should
+display the first documentation text produced by functions in the
+@code{eldoc-documentation-functions} hook, but you can customize
+@code{eldoc-documentation-strategy} to work in other ways, such as
+displaying all of the documentation texts concatenated together.
@item eldoc-documentation-functions
-This abnormal hook holds documentation functions. It acts as a
-collection of backends for ElDoc. This is what modes should use to
-register their documentation functions with ElDoc.
-
-@vindex eldoc-display-truncation-message
-@item eldoc-display-truncation-message
-If non-@code{nil} (the default), display a verbose message about how
-to view a complete documentation (if it has been truncated in the echo
-area). If @code{nil}, just mark truncated messages with @samp{...}.
-@end table
+This abnormal hook's value is a list of functions that can produce
+documentation for the symbol at point as appropriate for the current
+buffer's major-mode. These functions act as a collection of backends
+for ElDoc. Major mode register their documentation lookup functions
+with ElDoc by adding their functions to the buffer-local value of this
+variable.
+@end vtable
@node Hideshow
@section Hideshow minor mode
@@ -1365,7 +1451,7 @@ count as blocks.
@findex hs-show-region
@findex hs-hide-level
@findex hs-toggle-hiding
-@findex hs-mouse-toggle-hiding
+@findex hs-toggle-hiding
@kindex C-c @@ C-h
@kindex C-c @@ C-s
@kindex C-c @@ C-c
@@ -1382,9 +1468,8 @@ Hide the current block (@code{hs-hide-block}).
Show the current block (@code{hs-show-block}).
@item C-c @@ C-c
@itemx C-c @@ C-e
+@itemx S-mouse-2
Either hide or show the current block (@code{hs-toggle-hiding}).
-@item S-mouse-2
-Toggle hiding for the block you click on (@code{hs-mouse-toggle-hiding}).
@item C-c @@ C-M-h
@itemx C-c @@ C-t
Hide all top-level blocks (@code{hs-hide-all}).
@@ -1422,27 +1507,45 @@ nor comments). The default value is @code{code}.
Completion is normally done in the minibuffer (@pxref{Completion}),
but you can also complete symbol names in ordinary Emacs buffers.
+@cindex tags-based completion
@kindex M-TAB
@kindex C-M-i
- In programming language modes, type @kbd{C-M-i} or @kbd{M-@key{TAB}}
-to complete the partial symbol before point. On graphical displays,
-the @kbd{M-@key{TAB}} key is usually reserved by the window manager
-for switching graphical windows, so you should type @kbd{C-M-i} or
-@kbd{@key{ESC} @key{TAB}} instead.
-
-@cindex tags-based completion
@findex completion-at-point@r{, in programming language modes}
@cindex Lisp symbol completion
@cindex completion (Lisp symbols)
In most programming language modes, @kbd{C-M-i} (or
-@kbd{M-@key{TAB}}) invokes the command @code{completion-at-point},
-which generates its completion list in a flexible way. If Semantic
-mode is enabled, it tries to use the Semantic parser data for
-completion (@pxref{Semantic}). If Semantic mode is not enabled or
-fails at performing completion, it tries to complete using the
-selected tags table (@pxref{Tags Tables}). If in Emacs Lisp mode, it
-performs completion using the function, variable, or property names
-defined in the current Emacs session.
+@kbd{M-@key{TAB}}@footnote{
+On graphical displays, the @kbd{M-@key{TAB}} key is usually reserved
+by the window manager for switching graphical windows, so you should
+type @kbd{C-M-i} or @kbd{@key{ESC} @key{TAB}} instead.
+}) invokes the command @code{completion-at-point}, which generates the
+list of possible completions for the symbol at point. This command
+uses the available support facilities to come up with the completion
+candidates:
+
+@itemize @bullet
+@item
+If Eglot is activated for the current buffer's project
+(@pxref{Projects}) and the current buffer's major mode, the command
+tries to use the corresponding language server for producing the list
+of completion candidates. @xref{Eglot Features,,, eglot, Eglot: The
+Emacs LSP Client}.
+
+@item
+If Semantic mode is enabled (@pxref{Semantic}), the command tries to
+use the Semantic parser data for completion.
+
+@item
+If Semantic mode is not enabled or fails at performing completion, the
+command tries to complete using the selected tags table (@pxref{Tags
+Tables}); you need to visit the tags table with @w{@kbd{M-x
+visit-tags-table}} for that to work.
+
+@item
+In Emacs Lisp mode, the command performs completion using the
+function, variable, or property names defined in the current Emacs
+session.
+@end itemize
In all other respects, in-buffer symbol completion behaves like
minibuffer completion. For instance, if Emacs cannot complete to
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index b103e22e39..0f1c4da0c6 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -998,15 +998,14 @@ major mode's special commands. (The variable
@vindex outline-minor-mode-use-buttons
If @code{outline-minor-mode-use-buttons} is non-@code{nil}, Outline
-minor mode will use buttons (at the start of the header lines) in
-addition to ellipsis to show that a section is hidden. Using
-@kbd{RET} (or clicking on the button with a mouse) will toggle
-displaying the section.
-
-@vindex outline-minor-mode-use-margins
- If @code{outline-minor-mode-use-margins} is non-@code{nil}, Outline
-minor mode will use the window margins in addition to ellipsis to show
-that a section is hidden.
+minor mode will use buttons at the beginning of the heading lines, in
+addition to ellipsis, to show that a section is hidden. Clicking the
+mouse on the button toggles display of the section. If the value of
+this variable is @code{insert}, the buttons are inserted directly into
+the buffer text, so @key{RET} on the button will also toggle display
+of the section, like a mouse click does. If the value is
+@code{in-margins}, Outline minor mode will use the window margins to
+indicate that a section is hidden.
@vindex outline-minor-mode-cycle
If the @code{outline-minor-mode-cycle} user option is
diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi
index 05d2144380..23d5f50432 100644
--- a/doc/emacs/vc1-xtra.texi
+++ b/doc/emacs/vc1-xtra.texi
@@ -16,6 +16,7 @@
* Revision Tags:: Symbolic names for revisions.
* Version Headers:: Inserting version control headers into working files.
* Editing VC Commands:: Editing the VC shell commands that Emacs will run.
+* Preparing Patches:: Preparing and Composing patches from within VC
@end menu
@node Change Logs and VC
@@ -282,6 +283,37 @@ type @w{@kbd{C-x v ! C-x v b l}} and then append the names
of
additional branches to the end of the @samp{git log} command that VC
is about to run.
+@node Preparing Patches
+@subsubsection Preparing Patches
+
+@findex vc-prepare-patch
+When collaborating on projects it is common to send patches via email,
+to share changes. If you wish to do this using VC, you can use the
+@code{vc-prepare-patch} command. This will prompt you for the
+revisions you wish to share, and which destination email address(es)
+to use. The revisions are separated using commas (or whatever was
+configured by @var{crm-separator}). The command will then prepare
+those revisions using your @abbr{MUA, Mail User Agent} for you to
+review and send.
+
+When invoked interactively in a Log View buffer with marked revisions,
+these revisions will be used.
+
+@vindex vc-prepare-patches-separately
+Depending on the value of the user option
+@code{vc-prepare-patches-separately}, @code{vc-prepare-patch} will
+generate one or more messages. The default value @code{t} means
+prepare and display a message for each revision, one after another. A
+value of @code{nil} means to generate a single message with all
+patches attached in the body.
+
+@vindex vc-default-patch-addressee
+If you expect to contribute patches on a regular basis, you can set
+the user option @code{vc-default-patch-addressee} to the address(es)
+you wish to use. This will be used as the default value when invoking
+@code{vc-prepare-patch}. Project maintainers may consider setting
+this as a directory local variable (@pxref{Directory Variables}).
+
@node Customizing VC
@subsection Customizing VC
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index 6a1d125701..c40e088293 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -427,19 +427,19 @@ It is a permanent local, unaffected by
@end defvar
@defvar buffer-file-number
-This buffer-local variable holds the file number and directory device
-number of the file visited in the current buffer, or @code{nil} if no
+This buffer-local variable holds the inode number and device
+identifier of the file visited in the current buffer, or @code{nil} if no
file or a nonexistent file is visited. It is a permanent local,
unaffected by @code{kill-all-local-variables}.
-The value is normally a list of the form @code{(@var{filenum}
-@var{devnum})}. This pair of numbers uniquely identifies the file among
+The value is normally a list of the form @code{(@var{inodenum}
+@var{device})}. This tuple uniquely identifies the file among
all files accessible on the system. See the function
@code{file-attributes}, in @ref{File Attributes}, for more information
about them.
If @code{buffer-file-name} is the name of a symbolic link, then both
-numbers refer to the recursive target.
+@var{inodenum} and @var{device} refer to the recursive target of the link.
@end defvar
@defun get-file-buffer filename
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index 7ccee08e53..6f8431c55c 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -843,6 +843,14 @@ native compilation of that file. In addition, a similar
variable
file. If both @code{no-byte-compile} and @code{no-native-compile} are
specified, the former takes precedence.
+@cindex native compilation, prevent writing @file{*.eln} files
+ Sometimes there could be a need to prevent the native compilation
+from writing its results, the @file{*.eln} files, into a subdirectory
+of @code{user-emacs-directory} (@pxref{Init File}). You can do that
+by either changing the value of @code{native-comp-eln-load-path}
+(@pxref{Native-Compilation Variables}) or by temporarily pointing the
+@env{HOME} environment variable to a non-existing directory.
+
@menu
* Native-Compilation Functions:: Functions to natively-compile Lisp.
* Native-Compilation Variables:: Variables controlling native compilation.
@@ -985,7 +993,7 @@ too late.
While setting this variable disables automatic compilation of Lisp
files, the compiler may still be invoked to install @dfn{trampolines}
if any built-in functions are redefined. However, these trampolines
-will not get written to disk.
+will not get written to your cache directory.
You can also use the @samp{EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION}
environment variable to disable native compilation.
@@ -1075,3 +1083,13 @@ subprocesses that are still running, thus preventing the
corresponding
@file{.eln} files from being written. If the value is @code{nil}, the
default, Emacs will kill these subprocesses without querying.
@end defopt
+
+The variable @code{native-comp-eln-load-path} holds the list of
+directories where Emacs looks for the @file{*.eln} files
+(@pxref{Library Search}); in that role it is the equivalent of
+@code{load-path} used to look for @file{*.el} and @file{*.elc} files.
+The directories in this list are also used for writing the
+@file{*.eln} files produced by asynchronous native-compilation;
+specifically, Emacs will write these files into the first writable
+directory in the list. Thus, you can control where native-compilation
+stores the results by changing the value of this variable.
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index 6ba35cffff..204719e942 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -1428,12 +1428,32 @@ emacs, The GNU Emacs Manual}.)
be a call to @code{deftheme}, and the last form should be a call to
@code{provide-theme}.
-@defmac deftheme theme &optional doc
+@defmac deftheme theme &optional doc &rest properties
This macro declares @var{theme} (a symbol) as the name of a Custom
theme. The optional argument @var{doc} should be a string describing
the theme; this is the description shown when the user invokes the
@code{describe-theme} command or types @kbd{?} in the @samp{*Custom
-Themes*} buffer.
+Themes*} buffer. The remaining arguments @var{properties} are used
+pass a property list with theme attributes.
+
+The following attributes are supported:
+
+@table @code
+@item :family
+A symbol designating what ``family'' a theme belongs to. A
+@dfn{family} of themes is a set of similar themes that differ by minor
+aspects, such as face colors that are meant for the light vs dark
+background of the frame.
+@item :kind
+A symbol. If a theme is enabled and this property has the value
+@code{color-scheme}, then the @code{theme-choose-variant} command will
+look for other available themes that belong to the same family in
+order to switch the themes. Other values are currently unspecified
+and should not be used.
+@item :background-mode
+A symbol, either @code{light} or @code{dark}. This attribute is
+currently unused, but should still be specified.
+@end table
Two special theme names are disallowed (using them causes an error):
@code{user} is a dummy theme that stores the user's direct
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 64400ef931..15cd5518d9 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -548,7 +548,7 @@ previous example as follows:
@end example
@end defmac
-@defmac dolist-with-progress-reporter (var count [result]) reporter-or-message
body@dots{}
+@defmac dolist-with-progress-reporter (var list [result]) reporter-or-message
body@dots{}
This is another convenience macro that works the same way as @code{dolist}
does, but also reports loop progress using the functions described
above. As in @code{dotimes-with-progress-reporter},
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index e1aa2de523..b26d4f1058 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -1253,14 +1253,6 @@ the @samp{smb} method. For all other connection
methods, runtime
tests are performed.
@end defun
-@defun file-in-directory-p file dir
-This function returns @code{t} if @var{file} is a file in directory
-@var{dir}, or in a subdirectory of @var{dir}. It also returns
-@code{t} if @var{file} and @var{dir} are the same directory. It
-compares the truenames of the two directories. If @var{dir} does not
-name an existing directory, the return value is @code{nil}.
-@end defun
-
@defun vc-responsible-backend file
This function determines the responsible VC backend of the given
@var{file}. For example, if @file{emacs.c} is a file tracked by Git,
@@ -1412,14 +1404,17 @@ The file's inode number
(@code{file-attribute-inode-number}),
a nonnegative integer.
@item
-The filesystem number of the device that the file is on
-@code{file-attribute-device-number}), an integer.
-This element and the file's inode number
-together give enough information to distinguish any two files on the
-system---no two files can have the same values for both of these
-numbers.
+The filesystem's identifier of the device that the file is on
+(@code{file-attribute-device-number}), an integer or a cons cell of
+two integers. The latter is sometimes used by remote files, in order
+to distinguish remote filesystems from local ones.
@end enumerate
+The file's inode and device together give enough information
+to distinguish any two files on the system---no two files can have the
+same values for both of these attributes. This tuple that uniquely
+identifies the file is returned by @code{file-attribute-file-identifier}.
+
For example, here are the file attributes for @file{files.texi}:
@example
@@ -3100,6 +3095,17 @@ is called with one argument (the file or directory) and
should return
non-@code{nil} if that directory is the one it is looking for.
@end defun
+@cindex parent directory of file
+@cindex ancestor directory of file
+@cindex file, ancestor directory of
+@defun file-in-directory-p file dir
+This function returns @code{t} if @var{file} is a file in directory
+@var{dir}, or in a subdirectory of @var{dir}. It also returns
+@code{t} if @var{file} and @var{dir} are the same directory. It
+compares the truenames of the two directories. If @var{dir} does not
+name an existing directory, the return value is @code{nil}.
+@end defun
+
@defun directory-files-and-attributes directory &optional full-name
match-regexp nosort id-format count
This is similar to @code{directory-files} in deciding which files
to report on and how to report their names. However, instead
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 8b858e0aa0..7ffde7d43d 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -533,6 +533,44 @@ Instead, use the @code{advertised-calling-convention}
declaration
compiler emit a warning message when it compiles Lisp programs which
use the deprecated calling convention.
+@cindex computed documentation string
+@kindex :documentation
+Documentation strings are usually static, but occasionally it can be
+necessary to generate them dynamically. In some cases you can do so
+by writing a macro which generates at compile time the code of the
+function, including the desired documentation string. But you can
+also generate the docstring dynamically by writing
+@code{(:documentation @var{form})} instead of the documentation
+string. This will evaluate @var{form} at run-time when the function
+is defined and use it as the documentation string@footnote{This only
+works in code using @code{lexical-binding}.}. You can also compute
+the documentation string on the fly when it is requested, by setting
+the @code{function-documentation} property of the function's symbol to
+a Lisp form that evaluates to a string.
+
+For example:
+@example
+@group
+(defun adder (x)
+ (lambda (y)
+ (:documentation (format "Add %S to the argument Y." x))
+ (+ x y)))
+(defalias 'adder5 (adder 5))
+(documentation 'adder5)
+ @result{} "Add 5 to the argument Y."
+@end group
+
+@group
+(put 'adder5 'function-documentation
+ '(concat (documentation (symbol-function 'adder5) 'raw)
+ " Consulted at " (format-time-string "%H:%M:%S")))
+(documentation 'adder5)
+ @result{} "Add 5 to the argument Y. Consulted at 15:52:13"
+(documentation 'adder5)
+ @result{} "Add 5 to the argument Y. Consulted at 15:52:18"
+@end group
+@end example
+
@node Function Names
@section Naming a Function
@cindex function definition
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 5c5c615f85..30f65e359a 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1961,12 +1961,12 @@ and later discarded; this is not possible with a
property list.
@cindex accessing plist properties
The following functions can be used to manipulate property lists.
-They all compare property names using @code{eq}.
+They all default to comparing property names using @code{eq}.
@defun plist-get plist property &optional predicate
This returns the value of the @var{property} property stored in the
property list @var{plist}. Comparisons are done with @var{predicate},
-and defaults to @code{eq}. It accepts a malformed @var{plist}
+which defaults to @code{eq}. It accepts a malformed @var{plist}
argument. If @var{property} is not found in the @var{plist}, it
returns @code{nil}. For example,
@@ -1985,7 +1985,7 @@ returns @code{nil}. For example,
@defun plist-put plist property value &optional predicate
This stores @var{value} as the value of the @var{property} property in
the property list @var{plist}. Comparisons are done with @var{predicate},
-and defaults to @code{eq}. It may modify @var{plist} destructively,
+which defaults to @code{eq}. It may modify @var{plist} destructively,
or it may construct a new list structure without altering the old. The
function returns the modified property list, so you can store that back
in the place where you got @var{plist}. For example,
@@ -2012,7 +2012,7 @@ compares properties using @code{equal} instead of
@code{eq}.
@defun plist-member plist property &optional predicate
This returns non-@code{nil} if @var{plist} contains the given
-@var{property}. Comparisons are done with @var{predicate}, and
+@var{property}. Comparisons are done with @var{predicate}, which
defaults to @code{eq}. Unlike @code{plist-get}, this allows you to
distinguish between a missing property and a property with the value
@code{nil}. The value is actually the tail of @var{plist} whose
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index 4e4f12dc32..c7fbdac1d7 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -662,7 +662,7 @@ and @code{define-overloadable-function} (see the commentary
in
and @code{define-global-minor-mode}.
@item Other definition types:
-@code{defcustom}, @code{defgroup}, @code{defclass}
+@code{defcustom}, @code{defgroup}, @code{deftheme}, @code{defclass}
(@pxref{Top,EIEIO,,eieio,EIEIO}), and @code{define-skeleton}
(@pxref{Top,Autotyping,,autotype,Autotyping}).
@end table
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 75eb21522f..434538dcbf 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1851,7 +1851,9 @@ to enable or disable the buffer-local minor mode
@var{mode} in all (or
some; see below) buffers. It also executes the @var{body} forms. To
turn on the minor mode in a buffer, it uses the function
@var{turn-on}; to turn off the minor mode, it calls @var{mode} with
-@minus{}1 as argument.
+@minus{}1 as argument. (The function @var{turn-on} is a separate
+function so it could determine whether to enable the minor mode or not
+when it is not a priori clear that it should always be enabled.)
Globally enabling the mode also affects buffers subsequently created
by visiting files, and buffers that use a major mode other than
@@ -3146,9 +3148,10 @@ match found by @var{matcher} acts as the anchor for
further searches
specified by @var{anchored-highlighter}. @var{anchored-highlighter}
is a list of the following form:
+@c Don't wrap the line in the next @example, because that tends to
+@c produce ugly indentation in Info
@example
-(@var{anchored-matcher} @var{pre-form} @var{post-form}
- @var{subexp-highlighters}@dots{})
+(@var{anchored-matcher} @var{pre-form} @var{post-form}
@var{subexp-highlighters}@dots{})
@end example
Here, @var{anchored-matcher}, like @var{matcher}, is either a regular
diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index fdcda328d8..2c7a1d3266 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -1238,6 +1238,9 @@ any given seed, the @code{random} function always
generates the same
sequence of numbers. By default, Emacs initializes the random seed at
startup, in such a way that the sequence of values of @code{random}
(with overwhelming likelihood) differs in each Emacs run.
+The random seed is typically initialized from system entropy;
+however, on obsolescent platforms lacking entropy pools,
+the seed is taken from less-random volatile data such as the current time.
Sometimes you want the random number sequence to be repeatable. For
example, when debugging a program whose behavior depends on the random
@@ -1256,12 +1259,45 @@ nonnegative and less than @var{limit}. Otherwise, the
value might be
any fixnum, i.e., any integer from @code{most-negative-fixnum} through
@code{most-positive-fixnum} (@pxref{Integer Basics}).
-If @var{limit} is @code{t}, it means to choose a new seed as if Emacs
-were restarting, typically from the system entropy. On systems
-lacking entropy pools, choose the seed from less-random volatile data
-such as the current time.
-
If @var{limit} is a string, it means to choose a new seed based on the
-string's contents.
+string's contents. This causes later calls to @code{random} to return
+a reproducible sequence of results.
+
+If @var{limit} is @code{t}, it means to choose a new seed as if Emacs
+were restarting. This causes later calls to @code{random} to return
+an unpredictable sequence of results.
@end defun
+
+If you need a random nonce for cryptographic purposes, using
+@code{random} is typically not the best approach, for several reasons:
+
+@itemize @bullet
+@item
+Although you can use @code{(random t)} to consult system entropy,
+doing so can adversely affect other parts of your program that benefit
+from reproducible results.
+
+@item
+The system-dependent pseudo-random number generator (PRNG) used by
+@code{random} is not necessarily suitable for cryptography.
+
+@item
+A call to @code{(random t)} does not give direct access to system
+entropy; the entropy is passed through the system-dependent PRNG, thus
+possibly biasing the results.
+
+@item
+On typical platforms the random seed contains only 32 bits, which is
+typically narrower than an Emacs fixnum, and is not nearly enough for
+cryptographic purposes.
+
+@item
+A @code{(random t)} call leaves information about the nonce scattered
+about Emacs's internal state, increasing the size of the internal
+attack surface.
+
+@item
+On obsolescent platforms lacking entropy pools, @code{(random t)} is
+seeded from a cryptographically weak source.
+@end itemize
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 5ee139a11d..04f9297ec4 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -1052,11 +1052,15 @@ customization.
@subsubsection Constructs in @code{rx} regexps
The various forms in @code{rx} regexps are described below. The
-shorthand @var{rx} represents any @code{rx} form, and @var{rx}@dots{}
-means zero or more @code{rx} forms. These are all valid arguments to
-the @code{rx} macro. Where the corresponding string
-regexp syntax is given, @var{A}, @var{B}, @dots{} are string regexp
-subexpressions.
+shorthand @var{rx} represents any @code{rx} form. @var{rx}@dots{}
+means zero or more @code{rx} forms and, unless stated otherwise,
+matches these forms in sequence as if wrapped in a @code{(seq @dots{})}
+subform.
+
+These are all valid arguments to the @code{rx} macro. All forms are
+defined by their described semantics; the corresponding string regexps
+are provided for ease of understanding only. @var{A}, @var{B}, @dots{}
+denote (suitably bracketed) string regexp subexpressions therein.
@subsubheading Literals
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi
index ea1e086ebf..1074a8a829 100644
--- a/doc/lispref/symbols.texi
+++ b/doc/lispref/symbols.texi
@@ -718,9 +718,9 @@ byte-compiling any of the two files has equivalent results.
The
shorthands @code{snu-split} and @code{snu-lines} used in the second
version are @emph{not} interned in the obarray. This is easily seen
by moving point to the location where the shorthands are used and
-waiting for ElDoc (@pxref{Lisp Doc, , Local Variables in Files, emacs,
-The GNU Emacs Manual}) to hint at the true full name of the symbol
-under point in the echo area.
+waiting for ElDoc (@pxref{Programming Language Doc, , Local Variables
+in Files, emacs, The GNU Emacs Manual}) to hint at the true full name
+of the symbol under point in the echo area.
Since @code{read-symbol-shorthands} is a file-local variable, it is
possible that multiple libraries depending on
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 8b859042ad..509ce56725 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5321,9 +5321,12 @@ This has exactly the same effect as the previous
example, but is more
efficient and safer (because it doesn't involve any string parsing or
interpolation).
-@code{sqlite-execute} returns the number of affected rows. For
-instance, an @samp{insert} statement will return @samp{1}, whereas an
-@samp{update} statement may return zero or a higher number.
+@code{sqlite-execute} usually returns the number of affected rows.
+For instance, an @samp{insert} statement will typically return
+@samp{1}, whereas an @samp{update} statement may return zero or a
+higher number. However, when using @acronym{SQL} statements like
+@w{@samp{insert into @dots{} returning @dots{}}} and the like, the values
+specified by @w{@samp{returning @dots{}}} will be returned instead.
Strings in SQLite are, by default, stored as @code{utf-8}, and
selecting a text column will decode the string using that charset.
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 1d891618da..cbe276b2dc 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -2239,9 +2239,26 @@ still respecting file-local variables (@pxref{File Local
Variables}).
@cindex connection local variables
Connection-local variables provide a general mechanism for different
-variable settings in buffers with a remote connection. They are bound
+variable settings in buffers with a remote connection (@pxref{Remote
+Files,, Remote Files, emacs, The GNU Emacs Manual}). They are bound
and set depending on the remote connection a buffer is dedicated to.
+@menu
+* Connection Local Profiles:: Storing variable settings to
+ apply to connections.
+* Applying Connection Local Variables:: Using connection-local values
+ in your code.
+@end menu
+
+@node Connection Local Profiles
+@subsection Connection Local Profiles
+@cindex connection local profiles
+
+ Emacs uses connection-local profiles to store the variable settings
+to apply to particular connections. You can then associate these with
+remote connections by defining the criteria when they should apply,
+using @code{connection-local-set-profiles}.
+
@defun connection-local-set-profile-variables profile variables
This function defines a set of variable settings for the connection
@var{profile}, which is a symbol. You can later assign the connection
@@ -2311,13 +2328,13 @@ always applies. Example:
@example
@group
(connection-local-set-profiles
- '(:application 'tramp :protocol "ssh" :machine "localhost")
+ '(:application tramp :protocol "ssh" :machine "localhost")
'remote-bash 'remote-null-device)
@end group
@group
(connection-local-set-profiles
- '(:application 'tramp :protocol "sudo"
+ '(:application tramp :protocol "sudo"
:user "root" :machine "localhost")
'remote-ksh 'remote-null-device)
@end group
@@ -2329,13 +2346,13 @@ Therefore, the example above would be equivalent to
@example
@group
(connection-local-set-profiles
- '(:application 'tramp :protocol "ssh" :machine "localhost")
+ '(:application tramp :protocol "ssh" :machine "localhost")
'remote-bash)
@end group
@group
(connection-local-set-profiles
- '(:application 'tramp :protocol "sudo"
+ '(:application tramp :protocol "sudo"
:user "root" :machine "localhost")
'remote-ksh)
@end group
@@ -2356,6 +2373,14 @@ names. The function
@code{connection-local-set-profiles} updates this
list.
@end deffn
+@node Applying Connection Local Variables
+@subsection Applying Connection Local Variables
+@cindex connection local variables, applying
+
+ When writing connection-aware code, you'll need to collect, and
+possibly apply, any connection-local variables. There are several
+ways to do this, as described below.
+
@defun hack-connection-local-variables criteria
This function collects applicable connection-local variables
associated with @var{criteria} in
@@ -2365,7 +2390,7 @@ Example:
@example
@group
(hack-connection-local-variables
- '(:application 'tramp :protocol "ssh" :machine "localhost"))
+ '(:application tramp :protocol "ssh" :machine "localhost"))
@end group
@group
@@ -2384,9 +2409,9 @@ This function looks for connection-local variables
according to
@var{criteria}, and immediately applies them in the current buffer.
@end defun
-@defmac with-connection-local-variables &rest body
-All connection-local variables, which are specified by
-@code{default-directory}, are applied.
+@defmac with-connection-local-application-variables application &rest body
+Apply all connection-local variables for @code{application}, which are
+specified by @code{default-directory}.
After that, @var{body} is executed, and the connection-local variables
are unwound. Example:
@@ -2394,20 +2419,20 @@ are unwound. Example:
@example
@group
(connection-local-set-profile-variables
- 'remote-perl
- '((perl-command-name . "/usr/local/bin/perl")
+ 'my-remote-perl
+ '((perl-command-name . "/usr/local/bin/perl5")
(perl-command-switch . "-e %s")))
@end group
@group
(connection-local-set-profiles
- '(:application 'tramp :protocol "ssh" :machine "remotehost")
- 'remote-perl)
+ '(:application my-app :protocol "ssh" :machine "remotehost")
+ 'my-remote-perl)
@end group
@group
(let ((default-directory "/ssh:remotehost:/working/dir/"))
- (with-connection-local-variables
+ (with-connection-local-application-variables 'my-app
do something useful))
@end group
@end example
@@ -2416,30 +2441,59 @@ are unwound. Example:
@defvar connection-local-default-application
The default application, a symbol, to be applied in
@code{with-connection-local-variables}. It defaults to @code{tramp},
-but in case you want to overwrite Tramp's settings temporarily, you
-could let-bind it like
+but you can let-bind it to change the application temporarily
+(@pxref{Local Variables}).
+
+This variable must not be changed globally.
+@end defvar
+
+@defmac with-connection-local-variables &rest body
+This is equivalent to
+@code{with-connection-local-application-variables}, but uses
+@code{connection-local-default-application} for the application.
+@end defmac
+
+@defmac setq-connection-local [symbol form]@dots{}
+This macro sets each @var{symbol} connection-locally to the result of
+evaluating the corresponding @var{form}, using the connection-local
+profile specified in @code{connection-local-profile-name-for-setq}; if
+the profile name is @code{nil}, this macro will just set the variables
+normally, as with @code{setq} (@pxref{Setting Variables}).
+
+For example, you can use this macro in combination with
+@code{with-connection-local-variables} or
+@code{with-connection-local-application-variables} to lazily
+initialize connection-local settings:
@example
@group
+(defvar my-app-variable nil)
+
(connection-local-set-profile-variables
- 'my-remote-perl
- '((perl-command-name . "/usr/local/bin/perl5")
- (perl-command-switch . "-e %s")))
-@end group
+ 'my-app-connection-default-profile
+ '((my-app-variable . nil)))
-@group
(connection-local-set-profiles
- '(:application 'my-app :protocol "ssh" :machine "remotehost")
- 'my-remote-perl)
+ '(:application my-app)
+ 'my-app-connection-default-profile)
@end group
@group
-(let ((default-directory "/ssh:remotehost:/working/dir/")
- (connection-local-default-application 'my-app))
- (with-connection-local-variables
- do something useful))
+(defun my-app-get-variable ()
+ (with-connection-local-application-variables 'my-app
+ (or my-app-variable
+ (setq-connection-local my-app-variable
+ do something useful))))
@end group
@end example
+@end defmac
+
+@defvar connection-local-profile-name-for-setq
+The connection-local profile name, a symbol, to use when setting
+variables via @code{setq-connection-local}. This is let-bound in the
+body of @code{with-connection-local-variables}, but you can also
+let-bind it yourself if you'd like to set variables on a different
+profile.
This variable must not be changed globally.
@end defvar
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index ee3b15992b..e946a408fd 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -6684,32 +6684,32 @@ time window change functions were run for
@var{window}'s frame. If it
returns @code{nil}, @var{window} has been created after that. If it
returns @code{t}, @var{window} was not shown at that time but has been
restored from a previously saved window configuration afterwards.
-Otherwise, the return value is the buffer shown by @code{window} at
+Otherwise, the return value is the buffer shown by @var{window} at
that time.
@end defun
@defun window-old-pixel-width &optional window
This function returns the total pixel width of @var{window} the
-last time window change functions found @code{window} live on its
-frame. It is zero if @code{window} was created after that.
+last time window change functions found @var{window} live on its
+frame. It is zero if @var{window} was created after that.
@end defun
@defun window-old-pixel-height &optional window
This function returns the total pixel height of @var{window} the last
-time window change functions found @code{window} live on its frame.
-It is zero if @code{window} was created after that.
+time window change functions found @var{window} live on its frame.
+It is zero if @var{window} was created after that.
@end defun
@defun window-old-body-pixel-width &optional window
This function returns the pixel width of @var{window}'s text area the
-last time window change functions found @code{window} live on its
-frame. It is zero if @code{window} was created after that.
+last time window change functions found @var{window} live on its
+frame. It is zero if @var{window} was created after that.
@end defun
@defun window-old-body-pixel-height &optional window
This function returns the pixel height of @var{window}'s text area the
-last time window change functions found @code{window} live on its
-frame. It is zero if @code{window} was created after that.
+last time window change functions found @var{window} live on its
+frame. It is zero if @var{window} was created after that.
@end defun
In order to find out which window or frame was selected the last time
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in
index 1d881a5fc7..b6eef7ea79 100644
--- a/doc/misc/Makefile.in
+++ b/doc/misc/Makefile.in
@@ -68,7 +68,7 @@ DOCMISC_W32 = @DOCMISC_W32@
## Info files to build and install on all platforms.
INFO_COMMON = auth autotype bovine calc ccmode cl \
- dbus dired-x ebrowse ede ediff edt eieio \
+ dbus dired-x ebrowse ede ediff edt eglot eieio \
emacs-mime epa erc ert eshell eudc efaq eww \
flymake forms gnus emacs-gnutls htmlfontify idlwave ido info.info \
mairix-el message mh-e modus-themes newsticker nxml-mode octave-mode \
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index 1f12c30b1f..ab41737794 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -580,7 +580,7 @@ you are going to be editing AWK files, @file{README}
describes how to
configure your (X)Emacs so that @ccmode{} will supersede the obsolete
@code{awk-mode.el} which might have been supplied with your (X)Emacs.
@ccmode{} might not work with older versions of Emacs or XEmacs. See
-the @ccmode{} release notes at @uref{http://cc-mode.sourceforge.net}
+the @ccmode{} release notes at @uref{https://cc-mode.sourceforge.net}
for the latest information on Emacs version and package compatibility
(@pxref{Updating CC Mode}).
@@ -3170,7 +3170,7 @@ E. Jones' Filladapt package@footnote{It's available from
lack a feature that makes it work suboptimally when
@code{c-comment-prefix-regexp} matches the empty string (which it does
by default). A patch for that is available from
-@uref{http://cc-mode.sourceforge.net/,, the CC Mode web site}.},
+@uref{https://cc-mode.sourceforge.net/,, the CC Mode web site}.},
@c 2005/11/22: The above is still believed to be the case.
which handles things like bulleted lists nicely. There's a convenience
function @code{c-setup-filladapt} that tunes the relevant variables in
@@ -7583,7 +7583,7 @@ have old versions of @ccmode{} and so should be upgraded.
Access to the
compatibility, etc.@: are all available on the web site:
@quotation
-@uref{http://cc-mode.sourceforge.net/}
+@uref{https://cc-mode.sourceforge.net/}
@end quotation
@@ -7617,7 +7617,7 @@ the GNU Bug Tracker at @url{https://debbugs.gnu.org},
then sends it on
to @email{bug-cc-mode@@gnu.org}. You can also send reports, other
questions, and suggestions (kudos?@: @t{;-)} to that address. It's a
mailing list which you can join or browse an archive of; see the web site at
-@uref{http://cc-mode.sourceforge.net/} for further details.
+@uref{https://cc-mode.sourceforge.net/} for further details.
@cindex announcement mailing list
If you want to get announcements of new @ccmode{} releases, send the
diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi
index 46c257e42e..b58f6be758 100644
--- a/doc/misc/efaq-w32.texi
+++ b/doc/misc/efaq-w32.texi
@@ -1744,7 +1744,7 @@ date now, so no concrete pointers are available.
You will need an implementation of TeX for Windows.
A number of implementations are listed on the
-@uref{http://www.tug.org/interest.html#free, TeX Users Group} website.
+@uref{https://www.tug.org/interest.html#free, TeX Users Group} website.
@node Spell check
@section How do I perform spell checks?
@@ -1899,7 +1899,7 @@ Christopher Payne wrote a Visual Studio add-in that makes
Emacs the
default text editor, this has now been taken over by Jeff Paquette.
See the following two URLs for details:
@itemize
-@item @uref{http://sourceforge.net/projects/visemacs/} for the latest version.
+@item @uref{https://sourceforge.net/projects/visemacs/} for the latest version.
@item @uref{http://www.smathers.net/VisEmacs.htm} for notes on usage.
@end itemize
@@ -2039,7 +2039,7 @@ this option is set. (I don't see it on VC++ 4.0.)
@cindex Borland C++, integration with Emacs
Jonathan Arnold has written an
-@uref{http://www.buddydog.org/C++Builder/c++builder.html, EmacsEdit
+@uref{https://www.buddydog.org/C++Builder/c++builder.html, EmacsEdit
``expert''} for interfacing C++ Builder and Emacs.
@node Version control
@@ -2194,7 +2194,7 @@ to port software to Windows.
@cindex image libraries, gnuwin32
@cindex image libraries, development
-@uref{http://gnuwin32.sourceforge.net/}
+@uref{https://gnuwin32.sourceforge.net/}
GnuWin32 provides precompiled native Windows ports of a wide selection
of Free software and libraries. Unfortunately, the ports are
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 0da397919d..23e3b086a3 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -3622,13 +3622,13 @@ To build Emacs from source for MS-DOS, see the
instructions in the file
on plain DOS, and also on all versions of MS-Windows from version 3.X
onwards, including Windows XP and Vista. Pre-built binaries may be
available at
-@uref{http://www.delorie.com/pub/djgpp/current/v2gnu/emacs.README}
+@uref{https://www.delorie.com/pub/djgpp/current/v2gnu/emacs.README}
For a list of other implementations of Emacs (and Emacs
look-alikes), consult the list of ``Emacs implementations and literature,''
available at
-@uref{http://www.finseth.com/emacs.html}
+@uref{https://www.finseth.com/emacs.html}
Note that while many of these programs look similar to Emacs, they often
lack certain features, such as the Emacs Lisp extension language.
@@ -3757,7 +3757,7 @@ Various spell-checkers are compatible with Emacs,
including:
@table @b
@item Hunspell
-@uref{http://hunspell.sourceforge.net/}
+@uref{https://hunspell.github.io/}
@item GNU Aspell
@uref{http://aspell.net/}
diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi
new file mode 100644
index 0000000000..0d82239c58
--- /dev/null
+++ b/doc/misc/eglot.texi
@@ -0,0 +1,1138 @@
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename ../../eglot.info
+@settitle Eglot: The Emacs Client for the Language Server Protocol
+@include docstyle.texi
+@syncodeindex vr cp
+@syncodeindex fn cp
+@c %**end of header
+
+@copying
+This manual is for Eglot, the Emacs LSP client.
+
+Copyright @copyright{} 2022 Free Software Foundation, Inc.
+
+@quotation
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover Texts being ``A GNU Manual'',
+and with the Back-Cover Texts as in (a) below. A copy of the license
+is included in the section entitled ``GNU Free Documentation License''.
+
+(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and
+modify this GNU manual.''
+@end quotation
+@end copying
+
+@dircategory Emacs misc features
+@direntry
+* Eglot: (eglot). Language Server Protocol client for Emacs.
+@end direntry
+
+@titlepage
+@sp 4
+@c The title is printed in a large font.
+@center @titlefont{User's Guide}
+@sp 1
+@center @titlefont{to}
+@sp 1
+@center @titlefont{Eglot: The Emacs LSP Client}
+@ignore
+@sp 2
+@center release 1.8
+@c -release-
+@end ignore
+@sp 3
+@center Jo@~ao T@'avora & Eli Zaretskii
+@c -date-
+
+@page
+@vskip 0pt plus 1filll
+@insertcopying
+@end titlepage
+
+@contents
+
+@ifnottex
+@node Top
+@top Eglot
+
+@cindex LSP
+@cindex language server protocol
+Eglot is the Emacs client for the @dfn{Language Server Protocol}
+(@acronym{LSP}). The name ``Eglot'' is an acronym that stands for
+@ifhtml
+``@emph{E}macs Poly@emph{glot}''.
+@end ifhtml
+@ifnothtml
+``Emacs polyGLOT''.
+@end ifnothtml
+@footnote{
+A @dfn{polyglot} is a
+person who is able to use several languages.
+} Eglot provides infrastructure and a set of commands for enriching
+the source code editing capabilities of Emacs via LSP@. LSP is a
+standardized communications protocol between source code editors (such
+as Emacs) and language servers---programs external to Emacs which
+analyze the source code on behalf of Emacs. The protocol allows Emacs
+to receive various source code services from the server, such as
+description and location of function calls, types of variables, class
+definitions, syntactic errors, etc. This way, Emacs doesn't need to
+implement the language-specific parsing and analysis capabilities in
+its own code, but is still capable of providing sophisticated editing
+features that rely on such capabilities, such as automatic code
+completion, go-to definition of function/class, documentation of
+symbol at-point, refactoring, on-the-fly diagnostics, and more.
+
+Eglot itself is completely language-agnostic, but it can support any
+programming language for which there is a language server and an Emacs
+major mode.
+
+This manual documents how to configure, use, and customize Eglot.
+
+@insertcopying
+
+@menu
+* Quick Start:: For the impatient.
+* Eglot and LSP Servers:: How to work with language servers.
+* Using Eglot:: Important Eglot commands and variables.
+* Customizing Eglot:: Eglot customization and advanced features.
+* Troubleshooting Eglot:: Troubleshooting and reporting bugs.
+* GNU Free Documentation License:: The license for this manual.
+* Index::
+@end menu
+@end ifnottex
+
+@node Quick Start
+@chapter Quick Start
+@cindex quick start
+
+This chapter provides concise instructions for setting up and using
+Eglot with your programming project in common usage scenarios. For
+more detailed instructions regarding Eglot setup, @pxref{Eglot and LSP
+Servers}. @xref{Using Eglot}, for detailed description of using Eglot,
+and see @ref{Customizing Eglot}, for adapting Eglot to less common use
+patterns.
+
+Here's how to start using Eglot with your programming project:
+
+@enumerate
+@item
+Select and install a language server.
+
+Eglot comes pre-configured with many popular language servers, see the
+value of @code{eglot-server-programs}. If the server(s) mentioned
+there satisfy your needs for the programming language(s) with which
+you want to use Eglot, you just need to make sure those servers are
+installed on your system. Alternatively, install one or more servers
+of your choice and add them to the value of
+@code{eglot-server-programs}, as described in @ref{Setting Up LSP
+Servers}.
+
+@item
+Turn on Eglot for your project.
+
+To start using Eglot for a project, type @kbd{M-x eglot @key{RET}} in
+a buffer visiting any file that belongs to the project. This starts
+the language server configured for the programming language of that
+buffer, and causes Eglot to start managing all the files of the
+project which use the same programming language. The notion of a
+``project'' used by Eglot is the same Emacs uses (@pxref{Projects,,,
+emacs, GNU Emacs Manual}): in the simplest case, the ``project'' is
+the single file you are editing, but it can also be all the files in a
+single directory or a directory tree under some version control
+system, such as Git.
+
+Alternatively, you can start Eglot automatically from the major-mode
+hook of the mode used for the programming language; see @ref{Starting
+Eglot}.
+
+@item
+Use Eglot.
+
+Most Eglot facilities are integrated into Emacs features, such as
+ElDoc, Flymake, Xref, and Imenu. However, Eglot also provides
+commands of its own, mainly to perform tasks by the LSP server, such
+as @kbd{M-x eglot-rename} (to rename an identifier across the entire
+project), @kbd{M-x eglot-format} (to reformat and reindent code), and
+some others. @xref{Eglot Commands}, for the detailed list of Eglot
+commands.
+
+@item
+That's it!
+@end enumerate
+
+@node Eglot and LSP Servers
+@chapter Eglot and LSP Servers
+
+This chapter describes how to set up Eglot for your needs, and how to
+start it.
+
+@menu
+* Setting Up LSP Servers:: How to configure LSP servers for your needs.
+* Starting Eglot:: Ways of starting Eglot for your project.
+* Shutting Down LSP Servers::
+@end menu
+
+@node Setting Up LSP Servers
+@section Setting Up LSP Servers
+@cindex setting up LSP server for Eglot
+@cindex language server for Eglot
+
+For Eglot to be useful, it must first be combined with a suitable
+language server. Usually, that means running the server program
+locally as a child process of Emacs (@pxref{Processes,,, elisp, GNU
+Emacs Lisp Reference Manual}) and communicating with it via the
+standard input and output streams.
+
+The language server program must be installed separately, and is not
+further discussed in this manual; refer to the documentation of the
+particular server(s) you want to install.
+
+To use a language server, Eglot must know how to start it and which
+programming languages each server supports. This information is
+provided by the variable @code{eglot-server-programs}.
+
+@defvar eglot-server-programs
+This variable associates major modes with names and command-line
+arguments of the language server programs corresponding to the
+programming language of each major mode. It provides all the
+information that Eglot needs to know about the programming language of
+the source you are editing.
+
+The value of the variable is an alist, whose elements are of the form
+@w{@code{(@var{major-mode} . @var{server})}}.
+
+The @var{major-mode} of the alist elements can be either a symbol of
+an Emacs major mode or a list of the form @w{@code{(@var{mode}
+:language-id @var{id})}}, with @var{mode} being a major-mode symbol
+and @var{id} a string that identifies the language to the server (if
+Eglot cannot by itself convert the major-mode to the language
+identifier string required by the server). In addition,
+@var{major-mode} can be a list of several major modes specified in one
+of the above forms -- this means a running instance of the associated
+server is responsible for files of multiple major modes or languages
+in the project.
+
+The @var{server} part of the alist elements can be one of the
+following:
+
+@table @code
+@item (@var{program} @var{args}@dots{})
+This says to invoke @var{program} with zero or more arguments
+@var{args}; the program is expected to communicate with Emacs via the
+standard input and standard output streams.
+
+@item (@var{program} @var{args}@dots{} :initializationOptions
@var{options}@dots{})
+Like above, but with @var{options} specifying the options to be
+used for constructing the @samp{initializationOptions} JSON object for
+the server. @var{options} can also be a function of one argument, in
+which case it will be called with the server instance as the argument,
+and should return the JSON object to use for initialization.
+
+@item (@var{host} @var{port} @var{args}@dots{})
+Here @var{host} is a string and @var{port} is a positive integer
+specifying a TCP connection to a remote server. The @var{args} are
+passed to @code{open-network-stream}, e.g.@: if the connection needs
+to use encryption or other non-default parameters (@pxref{Network,,,
+elisp, GNU Emacs Lisp Reference Manual}).
+
+@item (@var{program} @var{args}@dots{} :autoport @var{moreargs}@dots{})
+@var{program} is started with a command line constructed from
+@var{args} followed by an available server port and the rest of
+arguments in @var{moreargs}; Eglot then establishes a TCP connection
+with the server via that port on the local host.
+
+@item @var{function}
+This should be a function of a single argument: non-@code{nil} if the
+connection was requested interactively (e.g., by the @code{eglot}
+command), otherwise @code{nil}. The function should return a value of
+any of the forms described above. This allows interaction with the
+user for determining the program to start and its command-line
+arguments.
+@end table
+
+@end defvar
+
+Eglot comes with a fairly complete set of associations of major-modes
+to popular language servers predefined. If you need to add server
+associations to the default list, use @code{add-to-list}. For
+example, if there is a hypothetical language server program
+@command{fools} for the language @code{Foo} which is supported by an
+Emacs major-mode @code{foo-mode}, you can add it to the alist like
+this:
+
+@lisp
+(add-to-list 'eglot-server-programs
+ '(foo-mode . ("fools" "--stdio")))
+@end lisp
+
+This will invoke the program @command{fools} with the command-line
+argument @option{--stdio} in support of editing source files for which
+Emacs turns on @code{foo-mode}, and will communicate with the program
+via the standard streams. As usual with invoking programs, the
+executable file @file{fools} should be in one of the directories
+mentioned by the @code{exec-path} variable (@pxref{Subprocess
+Creation,,, elisp, GNU Emacs Lisp Reference Manual}), for Eglot to be
+able to find it.
+
+@node Starting Eglot
+@section Starting Eglot
+@cindex starting Eglot
+@cindex activating Eglot for a project
+
+@findex eglot
+The most common way to start Eglot is to simply visit a source file of
+a given language and use the command @kbd{M-x eglot}. This starts the
+language server suitable for the visited file's major-mode, and
+attempts to connect to it. If the connection to the language server
+is successful, you will see the @code{[eglot:@var{project}]} indicator
+on the mode line which reflects the server that was started. If the
+server program couldn't be started or connection to it failed, you
+will see an error message; in that case, try to troubleshoot the
+problem as described in @ref{Troubleshooting Eglot}. Once a language
+server was successfully started and Eglot connected to it, you can
+immediately start using the Emacs features supported by Eglot, as
+described in @ref{Eglot Features}.
+
+A single Eglot session for a certain major-mode usually serves all the
+buffers under that mode which visit files from the same project, so
+you don't need to invoke @kbd{M-x eglot} again when you visit another
+file from the same project which is edited using the same major-mode.
+This is because Eglot uses the Emacs project infrastructure, as
+described in @ref{Eglot and Buffers}, and this knows about files that
+belong to the same project. Thus, after starting an Eglot session for
+some buffer, that session is automatically reused when visiting files
+in the same project with the same major-mode.
+
+@findex eglot-ensure
+Alternatively, you could configure Eglot to start automatically for
+one or more major-modes from the respective mode hooks. Here's an
+example for a hypothetical @code{foo-mode}:
+
+@lisp
+ (add-hook 'foo-mode-hook 'eglot-ensure)
+@end lisp
+
+@noindent
+The function @code{eglot-ensure} will start an Eglot session for each
+buffer in which @code{foo-mode} is turned on, if there isn't already
+an Eglot session that handles the buffer. Note that this variant of
+starting an Eglot session is non-interactive, so it should be used
+only when you are confident that Eglot can be started reliably for any
+file which may be visited with the major-mode in question.
+
+When Eglot connects to a language server for the first time in an
+Emacs session, it runs the hook @code{eglot-connect-hook}
+(@pxref{Eglot Variables}).
+
+@node Shutting Down LSP Servers
+@section Shutting Down LSP Servers
+@cindex shutting down LSP server
+
+When Eglot is turned on, it arranges for turning itself off
+automatically if the language server process terminates. Turning off
+Eglot means that it shuts down the server connection, ceases its
+management of all the buffers that use the server connection which was
+terminated, deactivates its minor mode, and restores the original
+values of the Emacs variables that Eglot changed when it was turned
+on. @xref{Eglot and Buffers}, for more details of what Eglot
+management of a buffer entails.
+
+@findex eglot-shutdown
+You can also shut down a language server manually, by using the
+command @kbd{M-x eglot-shutdown}. This prompts for the server (unless
+there's only one connection and it's used in the current buffer), and
+then shuts it down. By default, it also kills the server's events
+buffer (@pxref{Troubleshooting Eglot}), but a prefix argument prevents
+that.
+
+Alternatively, you can customize the variable
+@code{eglot-autoshutdown} to a non-@code{nil} value, in which case
+Eglot will automatically shut down the language server process when
+the last buffer served by that language server is killed. The default
+of this variable is @code{nil}, so that visiting another file would
+automatically activate Eglot even when the project which started Eglot
+with the server no longer has any buffer associated with it. This
+default allows you to start a server only once in each Emacs session.
+
+@node Using Eglot
+@chapter Using Eglot
+
+This chapter describes in detail the features that Eglot provides and
+how it does that. It also provides reference sections for Eglot
+commands and variables.
+
+@menu
+* Eglot Features::
+* Eglot and Buffers::
+* Eglot Commands::
+* Eglot Variables::
+@end menu
+
+@node Eglot Features
+@section Eglot Features
+@cindex features in buffers supported by Eglot
+
+Once Eglot is enabled in a buffer, it uses LSP and the language-server
+capabilities to activate, enable, and enhance modern IDE features in
+Emacs. The features themselves are usually provided via other Emacs
+packages. Here's the list of the main features that Eglot enables and
+provides:
+
+@itemize @bullet
+@item
+At-point documentation: when point is at or near a symbol or an
+identifier, the information about the symbol/identifier, such as the
+signature of a function or class method and server-generated
+diagnostics, is made available via the ElDoc package (@pxref{Lisp
+Doc,,, emacs, GNU Emacs Manual}). This allows major modes to provide
+extensive help and documentation about the program identifiers.
+
+@item
+On-the-fly diagnostic annotations with server-suggested fixes, via the
+Flymake package (@pxref{Top,,, flymake, GNU Flymake manual}). This
+improves and enhances the Flymake diagnostics, replacing the other
+Flymake backends.
+
+@item
+Finding definitions and uses of identifiers, via Xref (@pxref{Xref,,,
+emacs, GNU Emacs Manual}). Eglot provides a backend for the Xref
+capabilities which uses the language-server understanding of the
+program source. In particular, it eliminates the need to generate
+tags tables (@pxref{Tags tables,,, emacs, GNU Emacs Manual}) for
+languages which are only supported by the @code{etags} backend.
+
+@item
+Buffer navigation by name of function, class, method, etc., via Imenu
+(@pxref{Imenu,,, emacs, GNU Emacs Manual}). Eglot provides its own
+variant of @code{imenu-create-index-function}, which generates the
+index for the buffer based on language-server program source analysis.
+
+@item
+Enhanced completion of symbol at point by the
+@code{completion-at-point} command (@pxref{Symbol Completion,,, emacs,
+GNU Emacs Manual}). This uses the language-server's parser data for
+the completion candidates.
+
+@item
+Automatic reformatting of source code as you type it. This is similar
+to what the @code{eglot-format} command does (see below), but is
+activated automatically as you type.
+
+@item
+If a completion package such as @code{company-mode}, a popular
+third-party completion package (or any other completion package), is
+installed, Eglot enhances it by providing completion candidates based
+on the language-server analysis of the source code.
+(@code{company-mode} can be installed from GNU ELPA.)
+
+@item
+If @code{yasnippet}, a popular third-party package for automatic
+insertion of code templates (snippets), is installed, and the language
+server supports snippet completion candidates, Eglot arranges for the
+completion package to instantiate these snippets using
+@code{yasnippet}. (@code{yasnippet} can be installed from GNU ELPA.)
+
+@item
+If the popular third-party package @code{markdown-mode} is installed,
+and the server provides at-point documentation formatted as Markdown
+in addition to plain text, Eglot arranges for the ElDoc package to
+enrich this text with fontifications and other nice formatting before
+displaying it to the user. This makes the documentation shown by
+ElDoc look nicer on display.
+
+@item
+In addition to enabling and enhancing other features and packages,
+Eglot also provides a small number of user commands based directly on
+the capabilities of language servers. These commands are:
+
+@table @kbd
+@item M-x eglot-rename
+This prompts for a new name for the symbol at point, and then modifies
+all the project source files to rename the symbol to the new name,
+based on editing data received from the language-server. @xref{Eglot
+and Buffers}, for the details of how project files are defined.
+
+@item M-x eglot-format
+This reformats and prettifies the current active region according to
+source formatting rules of the language-server. If the region is not
+active, it reformats the entire buffer instead.
+
+@item M-x eglot-format-buffer
+This reformats and prettifies the current buffer according to source
+formatting rules of the language-server.
+
+@cindex code actions
+@item M-x eglot-code-actions
+@itemx M-x eglot-code-action-organize-imports
+@itemx M-x eglot-code-action-quickfix
+@itemx M-x eglot-code-action-extract
+@itemx M-x eglot-code-action-inline
+@itemx M-x eglot-code-action-rewrite
+These command allow you to invoke the so-called @dfn{code actions}:
+requests for the language-server to provide editing commands for
+various code fixes, typically either to fix an error diagnostic or to
+beautify/refactor code. For example,
+@code{eglot-code-action-organize-imports} rearranges the program
+@dfn{imports}---declarations of modules whose capabilities the program
+uses. These commands affect all the files that belong to the
+project. The command @kbd{M-x eglot-code-actions} will pop up a menu
+of code applicable actions at point.
+@end table
+
+@end itemize
+
+Not all servers support the full set of LSP capabilities, but most of
+them support enough to enable the basic set of features mentioned
+above. Conversely, some servers offer capabilities for which no
+equivalent Emacs package exists yet, and so Eglot cannot (yet) expose
+these capabilities to Emacs users.
+
+@node Eglot and Buffers
+@section Buffers, Projects, and Eglot
+@cindex buffers managed by Eglot
+@cindex projects and Eglot
+
+@cindex workspace
+One of the main strong points of using a language server is that a
+language server has a broad view of the program: it considers more
+than just the single source file you are editing. Ideally, the
+language server should know about all the source files of your program
+which are written in the language supported by the server. In the
+language-server parlance, the set of the source files of a program is
+known as a @dfn{workspace}. The Emacs equivalent of a workspace is a
+@dfn{project} (@pxref{Projects,,, emacs, GNU Emacs Manual}). Eglot
+fully supports Emacs projects, and considers the file in whose buffer
+Eglot is turned on as belonging to a project. In the simplest case,
+that file is the entire project, i.e.@: your project consists of a
+single file. But there are other more complex projects:
+
+@itemize @bullet
+@item
+A single-directory project: several source files in a single common
+directory.
+
+@item
+A VC project: source files in a directory hierarchy under some VCS,
+e.g.@: a VCS repository (@pxref{Version Control,,, emacs, GNU Emacs
+Manual}).
+
+@item
+An EDE project: source files in a directory hierarchy managed via the
+Emacs Development Environment (@pxref{EDE,,, emacs, GNU Emacs
+Manual}).
+@end itemize
+
+Eglot uses the Emacs's project management infrastructure to figure out
+which files and buffers belong to what project, so any kind of project
+supported by that infrastructure is automatically supported by Eglot.
+
+When Eglot starts a server program, it does so in the project's root
+directory, which is usually the top-level directory of the project's
+directory hierarchy. This ensures the language server has the same
+comprehensive view of the project's files as you do.
+
+For example, if you visit the file @file{~/projects/fooey/lib/x.foo}
+and @file{x.foo} belongs to a project rooted at
+@file{~/projects/fooey} (perhaps because a @file{.git} directory
+exists there), then @kbd{M-x eglot} causes the server program to start
+with that root as the current working directory. The server then will
+analyze not only the file @file{lib/x.foo} you visited, but likely
+also all the other @file{*.foo} files under the
+@file{~/projects/fooey} directory.
+
+In some cases, additional information specific to a given project will
+need to be provided to the language server when starting it. The
+variable @code{eglot-workspace-configuration} (@pxref{Customizing
+Eglot}) exists for that purpose. It specifies the parameters and
+their values to communicate to each language server which needs that.
+
+When Eglot is active for a project, it performs several background
+activities on behalf of the project and its buffers:
+
+@itemize @bullet
+@cindex mode-line indication of language server
+@cindex mouse clicks on mode-line, and Eglot
+@vindex eglot-menu
+@item
+All of the project's file-visiting buffers under the same major-mode
+are served by a single language-server connection. (If the project
+uses several programming languages, there will usually be a separate
+server connection for each group of files written in the same language
+and using the same Emacs major-mode.) Eglot adds the
+@samp{[eglot:@var{project}]} indication to the mode line of
+each such buffer, where @var{server} is the name of the server and
+@var{project} identifies the project by its root directory. Clicking
+the mouse on the Eglot mode-line indication activates a menu with
+server-specific items.
+
+@item
+For each buffer in which Eglot is active, it notifies the language
+server that Eglot is @dfn{managing} the file visited by that buffer.
+This tells the language server that the file's contents on disk may no
+longer be up-to-date due to unsaved edits. Eglot reports to the
+server any changes in the text of each managed buffer, to make the
+server aware of unsaved changes. This includes your editing of the
+buffer and also changes done automatically by other Emacs features and
+commands. Killing a buffer relinquishes its management by Eglot and
+notifies the server that the file on disk is up-to-date.
+
+@vindex eglot-managed-mode-hook
+@vindex eglot-managed-p
+@item
+Eglot turns on a special minor mode in each buffer it manages. This
+minor mode ensures the server is notified about files Eglot manages,
+and also arranges for other Emacs features supported by Eglot
+(@pxref{Eglot Features}) to receive information from the language
+server, by changing the settings of these features. Unlike other
+minor-modes, this special minor mode is not activated manually by the
+user, but automatically as result of starting an Eglot session for the
+buffer. However, this minor mode provides a hook variable
+@code{eglot-managed-mode-hook} that can be used to customize the Eglot
+management of the buffer. This hook is run both when the minor mode
+is turned on and when it's turned off; use the variable
+@code{eglot-managed-p} to tell if current buffer is still being
+managed or not. When Eglot stops managing the buffer, this minor mode
+is turned off, and all the settings that Eglot changed are restored to
+their original values.
+
+@item
+When you visit a file under the same project, whether an existing or a
+new file, its buffer is automatically added to the set of buffers
+managed by Eglot, and the server which supports the buffer's
+major-mode is notified about that. Thus, visiting a non-existent file
+@file{/home/joe/projects/fooey/lib/y.foo} in the above example will
+notify the server of the @file{*.foo} files' language that a new file
+was added to the project, even before the file appears on disk. The
+special Eglot minor mode is also turned on automatically in the buffer
+visiting the file.
+@end itemize
+
+@node Eglot Commands
+@section Eglot Commands
+@cindex commands, Eglot
+
+This section provides a reference of the most commonly used Eglot
+commands:
+
+@ftable @code
+@item M-x eglot
+This command adds the current buffer and the file it visits to the
+group of buffers and files managed by Eglot on behalf of a suitable
+language server. If a language server for the buffer's
+@code{major-mode} (@pxref{Major Modes,,, emacs, GNU Emacs Manual}) is
+not yet running, it will be started; otherwise the buffer and its file
+will be added to those managed by an existing server session.
+
+The command attempts to figure out the buffer's major mode and the
+suitable language server; in case it fails, it might prompt for the
+major mode to use and for the server program to start. If invoked
+with @kbd{C-u}, it always prompts for the server program, and if
+invoked with @kbd{C-u C-u}, it also prompts for the major mode.
+
+If the language server is successfully started and contacted, this
+command arranges for any other buffers belonging to the same project
+and using the same major mode to use the same language-server session.
+That includes any buffers created by visiting files after this command
+succeeds to connect to a language server.
+
+All the Emacs features that are capable of using Eglot services
+(@pxref{Eglot Features}) are automatically configured by this command
+to start using the language server via Eglot. To customize which
+Emacs features will be configured to use Eglot, use the
+@code{eglot-stay-out-of} option (@pxref{Customizing Eglot}).
+
+@item M-x eglot-reconnect
+This command shuts down the current connection to the language
+server and immediately restarts it using the same options used
+originally. This can sometimes be useful to unclog a partially
+malfunctioning server connection.
+
+@item M-x eglot-shutdown
+This command shuts down a language server. It prompts for a language
+server to shut down (unless there's only one server session, and it
+manages the current buffer). Then the command shuts down the server
+and stops managing the buffers the server was used for. Emacs
+features (@pxref{Eglot Features}) that Eglot configured to work with
+the language server are restored back to their original configuration.
+
+Normally, this command kills the buffers used for communicating with
+the language server, but if invoked with a prefix argument @kbd{C-u},
+the command doesn't kill those buffers, allowing them to be used for
+diagnostics and problem reporting (@pxref{Troubleshooting Eglot}).
+
+@item M-x eglot-shutdown-all
+This command shuts down all the language servers active in the current
+Emacs session. As with @code{eglot-shutdown}, invoking this command
+with a prefix argument avoids killing the buffers used for
+communications with the language servers.
+
+@item M-x eglot-rename
+This command renames the program symbol (a.k.a.@: @dfn{identifier}) at
+point to another name. It prompts for the new name of the symbol, and
+then modifies all the files in the project which arte managed by the
+language server of the current buffer to implement the renaming.
+
+@item M-x eglot-format
+This command reformats the active region according to the
+language-server rules. If no region is active, it reformats the
+entire current buffer.
+
+@item M-x eglot-format-buffer
+This command reformats the current buffer, in the same manner as
+@code{eglot-format} does.
+
+@item M-x eglot-code-actions
+@itemx mouse-1
+This command asks the server for any @dfn{code actions} applicable at
+point. It can also be invoked by @kbd{mouse-1} clicking on
+diagnostics provided by the server.
+
+@item M-x eglot-code-action-organize-imports
+@itemx M-x eglot-code-action-quickfix
+@itemx M-x eglot-code-action-extract
+@itemx M-x eglot-code-action-inline
+@itemx M-x eglot-code-action-rewrite
+These commands invoke specific code actions supported by the language
+server.
+@c FIXME: Need more detailed description of each action.
+@end ftable
+
+The following Eglot commands are used less commonly, mostly for
+diagnostic and troubleshooting purposes:
+
+@ftable @code
+@item M-x eglot-events-buffer
+This command pops up the events buffer used for communication with the
+language server of the current buffer.
+
+@item M-x eglot-stderr-buffer
+This command pops up the buffer with the debug info printed by the
+language server to its standard error stream.
+
+@item M-x eglot-forget-pending-continuations
+Forget pending requests for the server of the current buffer.
+@c FIXME: Better description of the need.
+
+@item M-x eglot-signal-didChangeConfiguration
+This command updates the language server configuration according to
+the current value of the variable @code{eglot-workspace-configuration}
+(@pxref{Customizing Eglot}).
+
+@item M-x eglot-clear-status
+Clear the last JSONRPC error for the server of the current buffer.
+Eglot keeps track of erroneous situations encountered by the server in
+its mode-line indication so that the user may inspect the
+communication leading up to it (@pxref{Troubleshooting Eglot}). If
+the situation is deemed uninteresting or temporary, this command can
+be used to ``forget'' the error. Note that the command @code{M-x
+eglot-reconnect} can sometimes be used to unclog a temporarily
+malfunctioning server.
+@end ftable
+
+As described in @ref{Eglot Features} most features associated with
+Eglot are actually provided by other Emacs packages and features, and
+Eglot only enhances them by allowing them to use the information
+coming from the language servers. For completeness, here's the list
+of commands of those other packages that are very commonly used in
+Eglot-managed buffers:
+
+@c Not @ftable, because the index entries should mention Eglot
+@table @code
+@cindex eldoc, and Eglot
+@cindex documentation using Eglot
+@item M-x eldoc
+Ask the ElDoc system for help at point.
+
+@cindex flymake, and Eglot
+@cindex on-the-fly diagnostics using Eglot
+@item M-x flymake-show-buffer-diagnostics
+Ask Flymake system to display diagnostics for the current buffer.
+
+@item M-x flymake-show-project-diagnostics
+Ask Flymake to list diagnostics for all the files in the current
+project.
+
+@cindex xref, and Eglot
+@cindex finding definitions of identifiers using Eglot
+@item M-x xref-find-definitions
+Ask Xref to go the definition of the identifier at point.
+
+@cindex imenu navigation using Eglot
+@item M-x imenu
+Let the user navigate the program source code using buffer index,
+categorizing program elements by syntactic class (class, method,
+variable, etc.) and offering completion.
+
+@cindex symbol completion using Eglot
+@item M-x completion-at-point
+Request completion of the symbol at point.
+@end table
+
+@node Eglot Variables
+@section Eglot Variables
+@cindex variables, Eglot
+
+This section provides a reference of the Eglot' user options.
+
+@vtable @code
+@item eglot-autoreconnect
+This option controls the ability to reconnect automatically to the
+language server when Eglot detects that the server process terminated
+unexpectedly. The default value 3 means to attempt reconnection only
+if the previous successful connection lasted for more than that number
+of seconds; a different positive value changes the minimal length of
+the connection to trigger reconnection. A value of @code{t} means
+always reconnect automatically, and @code{nil} means never reconnect
+(in which case you will need to reconnect manually using @kbd{M-x
+eglot}).
+
+@item eglot-connect-timeout
+This specifies the number of seconds before connection attempt to a
+language server times out. The value of @code{nil} means never time
+out. The default is 30 seconds.
+
+@item eglot-sync-connect
+This setting is mainly important for connections which are slow to
+establish. Whereas the variable @code{eglot-connect-timeout} controls
+how long to wait for, this variable controls whether to block Emacs's
+user interface while waiting. The default value is 3; a positive
+value means block for that many seconds, then wait for the connection
+in the background. The value of @code{t} means block during the whole
+waiting period. The value of @code{nil} or zero means don't block at
+all during the waiting period.
+
+@item eglot-events-buffer-size
+This determines the size of the Eglot events buffer. @xref{Eglot
+Commands, eglot-events-buffer}, for how to display that buffer. If
+the value is changed, for it to take effect the connection should be
+restarted using @kbd{M-x eglot-reconnect}.
+@c FIXME: Shouldn't the defcustom do this by itself using the :set
+@c attribute?
+@xref{Troubleshooting Eglot}, for when this could be useful.
+
+@item eglot-autoshutdown
+If this is non-@code{nil}, Eglot shuts down a language server when the
+last buffer managed by it is killed. @xref{Shutting Down LSP Servers}.
+The default is @code{nil}; if you want to shut down a server, use
+@kbd{M-x eglot-shutdown} (@pxref{Eglot Commands}).
+
+@item eglot-confirm-server-initiated-edits
+Various Eglot commands and code actions result in the language server
+sending editing commands to Emacs. If this option's value is
+non-@code{nil} (the default), Eglot will ask for confirmation before
+performing edits initiated by the server or edits whose scope affects
+buffers other than the one where the user initiated the request.
+
+@item eglot-ignored-server-capabilities
+This variable's value is a list of language server capabilities that
+Eglot should not use. The default is @code{nil}: Eglot uses all of
+the capabilities supported by each server.
+
+@item eglot-extend-to-xref
+If this is non-@code{nil}, and @kbd{M-.}
+(@code{xref-find-definitions}) lands you in a file outside of your
+project, such as a system-installed library or header file,
+transiently consider that file as managed by the same language server.
+That file is still outside your project (i.e. @code{project-find-file}
+won't find it), but Eglot and the server will consider it to be part
+of the workspace. The default is @code{nil}.
+
+@item eglot-mode-map
+This variable is the keymap for binding Eglot-related command. It is
+in effect only as long as the buffer is managed by Eglot. By default,
+it is empty, with the single exception: @kbd{C-h .} is remapped to
+invoke @code{eldoc-doc-buffer}. You can bind additional commands in
+this map. For example:
+
+@lisp
+ (define-key eglot-mode-map (kbd "C-c r") 'eglot-rename)
+ (define-key eglot-mode-map (kbd "C-c o") 'eglot-code-action-organize-imports)
+ (define-key eglot-mode-map (kbd "C-c h") 'eldoc)
+ (define-key eglot-mode-map (kbd "<f6>") 'xref-find-definitions)
+@end lisp
+
+@end vtable
+
+Additional variables, which are relevant for customizing the server
+connections, are documented in @ref{Customizing Eglot}.
+
+@node Customizing Eglot
+@chapter Customizing Eglot
+@cindex customizing Eglot
+
+Eglot itself has a relatively small number of customization options.
+A large part of customizing Eglot to your needs and preferences should
+actually be done via options of the Emacs packages and features which
+Eglot supports and enhances (@pxref{Eglot Features}). For example:
+
+@itemize @bullet
+@item
+To configure the face used for server-derived errors and warnings,
+customize the Flymake faces @code{flymake-error} and
+@code{flymake-error}.
+
+@item
+To configure the amount of space taken up by documentation in the
+echo area, customize the ElDoc variable
+@code{eldoc-echo-area-use-multiline-p}.
+
+@item
+To completely change how ElDoc displays the at-point documentation
+destination, customize the ElDoc variable
+@code{eldoc-display-functions}.
+@end itemize
+
+For this reason, this manual describes only how to customize the
+Eglot's own operation, which mainly has to do with the server
+connections and the server features to be used by Eglot.
+
+@c @table, not @vtable, because some of the variables are indexed
+@c elsewhere
+@table @code
+@item eglot-server-programs
+This variable determines which language server to start for each
+supported major mode, and how to invoke that server's program.
+@xref{Setting Up LSP Servers}, for the details.
+
+@vindex eglot-strict-mode
+@item eglot-strict-mode
+This is @code{nil} by default, meaning that Eglot is generally lenient
+about non-conforming servers. If you need to debug a server, set this
+to @w{@code{(disallow-non-standard-keys enforce-required-keys)}}.
+
+@vindex eglot-server-initialized-hook
+@item eglot-server-initialized-hook
+A hook run after the server object is successfully initialized.
+
+@vindex eglot-connect-hook
+@item eglot-connect-hook
+A hook run after connection to the server is successfully
+established. @xref{Starting Eglot}.
+
+@item eglot-managed-mode-hook
+A hook run after Eglot started or stopped managing a buffer.
+@xref{Eglot and Buffers}, for details of its usage.
+
+@vindex eglot-stay-out-of
+@item eglot-stay-out-of
+This variable's value lists Emacs features that Eglot shouldn't
+automatically try to manage on user's behalf. It is useful, for
+example, when you need to use non-LSP Flymake or Company back-ends.
+To have Eglot stay away of some Emacs feature, add that feature's
+symbol or a regexp that will match a symbol's name to the list: for
+example, the symbol @code{xref} to leave Xref alone, or the string
+@samp{company} to stay away of your Company customizations. Here's an
+example:
+
+@lisp
+(add-to-list 'eglot-stay-out-of 'flymake)
+@end lisp
+
+Note that you can still configure the excluded Emacs features manually
+to use Eglot in your @code{eglot-managed-mode-hook} or via some other
+mechanism.
+
+@vindex eglot-workspace-configuration
+@cindex server workspace configuration
+@item eglot-workspace-configuration
+This variable is meant to be set in the @file{.dir-locals.el} file, to
+provide per-project settings, as described below in more detail.
+@end table
+
+Some language servers need to know project-specific settings, which
+the LSP calls @dfn{workspace configuration}. Eglot allows such fine
+tuning of per-project settings via the variable
+@code{eglot-workspace-configuration}. Eglot sends the portion of the
+settings contained in this variable to each server for which such
+settings were defined in the variable. These settings are
+communicated to the server initially (upon establishing the
+connection) or when the settings are changed, or in response to the
+configuration request from the server.
+
+In many cases, servers can be configured globally using a
+configuration file in the user's home directory or in the project
+directory, which the language server reads. For example, the
+@command{pylsp} server for Python reads the file
+@file{~/.config/pycodestyle} and the @command{clangd} server reads the
+file @file{.clangd} anywhere in the current project's directory tree.
+If possible, we recommend to use these configuration files that are
+independent of Eglot and Emacs; they have the advantage that they will
+work with other LSP clients as well.
+
+If you do need to provide Emacs-specific configuration for a language
+server, we recommend to define the appropriate value in the
+@file{.dir-locals.el} file in the project's directory. The value of
+this variable should be a property list of the following format:
+
+@lisp
+ (:@var{server} @var{plist}@dots{})
+@end lisp
+
+@noindent
+Here @code{:@var{server}} identifies a particular language server and
+@var{plist} is the corresponding keyword-value property list of one or
+more parameter settings for that server, serialized by Eglot as a JSON
+object. @var{plist} may be arbitrarity complex, generally containing
+other keywork-value property sublists corresponding to JSON subobjects.
+The JSON values @code{true}, @code{false}, @code{null} and @code{@{@}}
+are represented by the Lisp values @code{t}, @code{:json-false},
+@code{nil}, and @code{eglot-@{@}}, respectively.
+
+@findex eglot-show-workspace-configuration
+When experimenting with workspace settings, you can use the command
+@kbd{M-x eglot-show-workspace-configuration} to inspect and debug the
+JSON value to be sent to the server. This helper command works even
+before actually connecting to the server.
+
+Here's an example of defining the workspace-configuration settings for
+a project that uses two different language servers, one for Python,
+whose server is @command{pylsp}, the other one for Go, with
+@command{gopls} as its server (presumably, the project is written in a
+combination of these two languages):
+
+@lisp
+((python-mode
+ . ((eglot-workspace-configuration
+ . (:pylsp (:plugins (:jedi_completion (:include_params t
+ :fuzzy t)
+ :pylint (:enabled :json-false)))))))
+ (go-mode
+ . ((eglot-workspace-configuration
+ . (:gopls (:usePlaceholders t))))))
+@end lisp
+
+@noindent
+This should go into the @file{.dir-locals.el} file in the project's
+root directory. It sets up the value of
+@code{eglot-workspace-configuration} separately for each major mode.
+
+Alternatively, the same configuration could be defined as follows:
+
+@lisp
+((nil
+ . ((eglot-workspace-configuration
+ . (:pylsp (:plugins (:jedi_completion (:include_params t
+ :fuzzy t)
+ :pylint (:enabled :json-false)))
+ :gopls (:usePlaceholders t))))))
+@end lisp
+
+This is an equivalent setup which sets the value for all the
+major-modes inside the project; Eglot will use for each server only
+the section of the parameters intended for that server.
+
+As yet another alternative, you can set the value of
+@code{eglot-workspace-configuration} programmatically, via the
+@code{dir-locals-set-class-variables} function, @pxref{Directory Local
+Variables,,, elisp, GNU Emacs Lisp Reference Manual}.
+
+Finally, if one needs to determine the workspace configuration based
+on some dynamic context, @code{eglot-workspace-configuration} can be
+set to a function. The function is called with the
+@code{eglot-lsp-server} instance of the connected server (if any) and
+with @code{default-directory} set to the root of the project. The
+function should return a value of the form described above.
+
+Some servers need special hand-holding to operate correctly. If your
+server has some quirks or non-conformity, it's possible to extend
+Eglot via Elisp to adapt to it, by defining a suitable
+@code{eglot-initialization-options} method via @code{cl-defmethod}
+(@pxref{Generic Functions,,, elisp, GNU Emacs Lisp Reference Manual}).
+
+Here's an example:
+
+@lisp
+(add-to-list 'eglot-server-programs
+ '((c++ mode c-mode) . (eglot-cquery "cquery")))
+
+(defclass eglot-cquery (eglot-lsp-server) ()
+ :documentation "A custom class for cquery's C/C++ langserver.")
+
+(cl-defmethod eglot-initialization-options ((server eglot-cquery))
+ "Passes through required cquery initialization options"
+ (let* ((root (car (project-roots (eglot--project server))))
+ (cache (expand-file-name ".cquery_cached_index/" root)))
+ (list :cacheDirectory (file-name-as-directory cache)
+ :progressReportFrequencyMs -1)))
+@end lisp
+
+@noindent
+See the doc string of @code{eglot-initialization-options} for more
+details.
+@c FIXME: The doc string of eglot-initialization-options should be
+@c enhanced and extended.
+
+@node Troubleshooting Eglot
+@chapter Troubleshooting Eglot
+@cindex troubleshooting Eglot
+
+This section documents commands and variables that can be used to
+troubleshoot Eglot problems. It also provides guidelines for
+reporting Eglot bugs in a way that facilitates their resolution.
+
+When you encounter problems with Eglot, try first using the commands
+@kbd{M-x eglot-events-server} and @kbd{M-x eglot-stderr-buffer}. They
+pop up special buffers that can be used to inspect the communications
+between the Eglot and language server. In many cases, this will
+indicate the problems or at least provide a hint.
+
+A common and easy-to-fix cause of performance problems is the length
+of these two buffers. If Eglot is operating correctly but slowly,
+customize the variable @code{eglot-events-buffer-size} (@pxref{Eglot
+Variables}) to limit logging, and thus speed things up.
+
+If you need to report an Eglot bug, please keep in mind that, because
+there are so many variables involved, it is generally both very
+@emph{difficult} and @emph{absolutely essential} to reproduce bugs
+exactly as they happened to you, the user. Therefore, every bug
+report should include:
+
+@enumerate
+@item
+The transcript of events obtained from the buffer popped up by
+@kbd{M-x eglot-events-buffer}. If the transcript can be narrowed down
+to show the problematic exchange, so much the better. This is
+invaluable for the investigation and reproduction of the problem.
+
+@item
+If Emacs signaled an error (an error message was seen or heard), make
+sure to repeat the process after toggling @code{debug-on-error} on
+(via @kbd{M-x toggle-debug-on-error}). This normally produces a
+backtrace of the error that should also be attached to the bug report.
+
+@item
+An explanation how to obtain and install the language server you used.
+If possible, try to replicate the problem with the C/C@t{++} or Python
+servers, as these are very easy to install.
+
+@item
+A description of how to setup the @emph{minimal} project (one or two
+files and their contents) where the problem happens.
+
+@item
+A recipe to replicate the problem with @emph{a clean Emacs run}. This
+means @kbd{emacs -Q} invocation or a very minimal (no more that 10
+lines) @file{.emacs} initialization file. @code{eglot-ensure} and
+@code{use-package} calls are generally @emph{not} needed.
+
+@item
+Make sure to double check all the above elements and re-run the
+recipe to see that the problem is reproducible.
+@end enumerate
+
+Please keep in mind that some problems reported against Eglot may
+actually be bugs in the language server or the Emacs feature/package
+that used Eglot to communicate with the language server.
+
+@node GNU Free Documentation License
+@appendix GNU Free Documentation License
+@include doclicense.texi
+
+@node Index
+@unnumbered Index
+@printindex cp
+
+@bye
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index 0ee33f2c2a..2945c05e85 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -439,11 +439,6 @@ Print the current local time as a human-readable string.
This command
is similar to, but slightly different from, the GNU Coreutils
@command{date} command.
-@item define
-@cmindex define
-Define a variable alias.
-@xref{Variable Aliases, , , elisp, The Emacs Lisp Reference Manual}.
-
@item diff
@cmindex diff
Compare files using Emacs's internal @code{diff} (not to be confused
@@ -699,10 +694,18 @@ used for comparing lists of strings.
This command can be loaded as part of the eshell-xtra module, which is
disabled by default.
+@item set
+@cmindex set
+Set variable values, using the function @code{set} like a command
+(@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}).
+A variable name can be a symbol, in which case it refers to a Lisp
+variable, or a string, referring to an environment variable
+(@pxref{Arguments}).
+
@item setq
@cmindex setq
-Set variable values, using the function @code{setq} like a command.
-@xref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}.
+Set variable values, using the function @code{setq} like a command
+(@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}).
@item source
@cmindex source
@@ -748,7 +751,9 @@ disabled by default.
@item unset
@cmindex unset
-Unset an environment variable.
+Unset one or more variables. As with @command{set}, a variable name
+can be a symbol, in which case it refers to a Lisp variable, or a
+string, referring to an environment variable.
@item wait
@cmindex wait
@@ -886,12 +891,35 @@ For example, you could handle a subset of the options for
the
@node Variables
@section Variables
-Since Eshell is just an Emacs @acronym{REPL}@footnote{
+@vindex eshell-prefer-lisp-variables
+Since Eshell is a combination of an Emacs @acronym{REPL}@footnote{
Short for ``Read-Eval-Print Loop''.
-}
-, it does not have its own scope, and simply stores variables the same
-you would in an Elisp program. Eshell provides a command version of
-@code{setq} for convenience.
+} and a command shell, it can refer to variables from two different
+sources: ordinary Emacs Lisp variables, as well as environment
+variables. By default, when using a variable in Eshell, it will first
+look in the list of built-in variables, then in the list of
+environment variables, and finally in the list of Lisp variables. If
+you would prefer to use Lisp variables over environment variables, you
+can set @code{eshell-prefer-lisp-variables} to @code{t}.
+
+You can set variables in a few different ways. To set a Lisp
+variable, you can use the command @samp{setq @var{name} @var{value}},
+which works much like its Lisp counterpart (@pxref{Setting Variables,
+, , elisp, The Emacs Lisp Reference Manual}). To set an environment
+variable, use @samp{export @var{name}=@var{value}}. You can also use
+@samp{set @var{variable} @var{value}}, which sets a Lisp variable if
+@var{variable} is a symbol, or an environment variable if it's a
+string (@pxref{Arguments}). Finally, you can temporarily set
+environment variables for a single command with
+@samp{@var{name}=@var{value} @var{command} @dots{}}. This is
+equivalent to:
+
+@example
+@{
+ export @var{name}=@var{value}
+ @var{command} @dots{}
+@}
+@end example
@subsection Built-in variables
Eshell knows a few built-in variables:
@@ -914,6 +942,16 @@ When using @code{$-}, you can also access older
directories in the
directory ring via subscripting, e.g.@: @samp{$-[1]} refers to the
working directory @emph{before} the previous one.
+@vindex $PATH
+@item $PATH
+This specifies the directories to search for executable programs. Its
+value is a string, separated by @code{":"} for Unix and GNU systems,
+and @code{";"} for MS systems. This variable is connection-aware, so
+whenever you change the current directory to a different host
+(@pxref{Remote Files, , , emacs, The GNU Emacs Manual}),
+the value will automatically update to reflect the search path on that
+host.
+
@vindex $_
@item $_
This refers to the last argument of the last command. With a
@@ -1138,7 +1176,7 @@ a number if possible.
@item one or both (non-@code{nil}) lists
Concatenate ``adjacent'' elements of each value (possibly converting
-back to a number as above). For example, @samp{$list("a" "b")c}
+back to a number as above). For example, @samp{$(list "a" "b")c}
returns @samp{("a" "bc")}.
@item anything else
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index 3aad985c5a..7cb5621b69 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -1330,7 +1330,7 @@ details.
However, what you really want is the Insidious Big Brother
Database bbdb. Get it from
-@uref{http://bbdb.sourceforge.net/, bbdb's website}.
+@uref{https://bbdb.sourceforge.net/, bbdb's website}.
Now place the following in @file{~/.gnus.el}, to activate bbdb for Gnus:
@example
@@ -1782,13 +1782,13 @@ when you're online.
Let's talk about Unix systems first: For the news part,
the easiest solution is a small nntp server like
@uref{https://www.leafnode.org/, Leafnode} or
-@uref{http://patrik.iki.fi/sn/, sn},
+@uref{https://patrik.iki.fi/sn/, sn},
of course you can also install a full featured news
server like
@uref{https://www.isc.org/othersoftware/, inn}.
Then you want to fetch your Mail, popular choices
are @uref{https://www.fetchmail.info/, fetchmail}
-and @uref{http://pyropus.ca/software/getmail/, getmail}.
+and @uref{https://pyropus.ca/software/getmail/, getmail}.
You should tell those to write the mail to your disk and
Gnus to read it from there. Last but not least the mail
sending part: This can be done with every MTA like
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index b1331e79bf..ec728c09ad 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -8045,7 +8045,7 @@ to a string containing the default command and options
(default
@findex gnus-summary-muttprint
@vindex gnus-summary-muttprint-program
Save the current article into muttprint. That is, print it using the
-external program @uref{http://muttprint.sourceforge.net/,
+external program @uref{https://muttprint.sourceforge.net/,
Muttprint}. The program name and options to use is controlled by the
variable @code{gnus-summary-muttprint-program}.
(@code{gnus-summary-muttprint}).
@@ -9343,7 +9343,7 @@ Use Gnus rendered based on w3m.
Use @uref{http://emacs-w3m.namazu.org/, emacs-w3m}.
@item w3m-standalone
-Use @uref{http://w3m.sourceforge.net/, w3m}.
+Use @uref{https://w3m.sourceforge.net/, w3m}.
@item links
Use @uref{http://links.twibright.com/, Links}.
@@ -13602,7 +13602,7 @@ Here's the method for a public spool:
If you are behind a firewall and only have access to the @acronym{NNTP}
server from the firewall machine, you can instruct Gnus to @code{rlogin}
on the firewall machine and connect with
-@uref{http://netcat.sourceforge.net/, netcat} from there to the
+@uref{https://netcat.sourceforge.net/, netcat} from there to the
@acronym{NNTP} server.
Doing this can be rather fiddly, but your virtual server definition
should probably look something like this:
@@ -23794,7 +23794,7 @@ On a GNU/Linux system, the @code{display} program is
included in the
ImageMagick package. For external conversion programs look for packages
with names like @code{netpbm}, @code{libgr-progs} and @code{compface}.
On Windows, you may use the packages @code{netpbm} and @code{compface}
-from @url{http://gnuwin32.sourceforge.net}. You need to add the
+from @url{https://gnuwin32.sourceforge.net}. You need to add the
@code{bin} directory to your @code{PATH} environment variable.
@c In fact only the following DLLs and binaries seem to be required:
@c compface1.dll uncompface.exe libnetpbm10.dll icontopbm.exe
@@ -26911,10 +26911,17 @@ Gnus 5.10 on May 1st 2003 (24 releases).
On the January 4th 2004, No Gnus was begun.
+Gnus 5.11 was bundled with GNU Emacs 22.1 in June 2007.
+
+A version of No Gnus was released as Gnus 5.13 with GNU Emacs 23.1 in
+July 2009.
+
On April 19, 2010 Gnus development was moved to Git.
On the January 31th 2012, Ma Gnus was begun.
+Since then, Gnus has only been released together with Emacs.
+
If you happen upon a version of Gnus that has a prefixed name---``(ding)
Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia Gnus'',
``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'', ``Ma Gnus''---don't
@@ -29080,8 +29087,9 @@ moving articles to a group that has not turned
auto-expire on.
@subsubsection Ma Gnus
@cindex Ma Gnus
-I'm sure there will be lots of text here. It's really spelled 真
-Gnus.
+It's really spelled 真Gnus. Ma Gnus was the code name for the
+development version of Gnus started in 2012. These days, Gnus is only
+released together with Emacs.
New features in Ma Gnus:
@@ -29111,6 +29119,8 @@ The new hooks @code{gnus-gcc-pre-body-encode-hook} and
the message body of the Gcc copy of a sent message.
@xref{Archived Messages}.
+For more recent changes, see the Emacs @file{NEWS} files.
+
@end itemize
@end itemize
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index 6aa2cf290d..1a80c62edb 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -3082,7 +3082,7 @@ retracted---without question@footnote{In previous
versions of MH-E,
this option suppressed the confirmation in @code{mh-kill-folder}.
Since this kept most users from setting this option,
@code{mh-kill-folder} was modified in version 6.0 to always ask for
-confirmation subject to @code{mh-kill-folder-suppress-prompt-hook}.
+confirmation subject to @code{mh-kill-folder-suppress-prompt-functions}.
@xref{Folders}.}.
@cindex MH-Folder mode
@@ -3364,7 +3364,7 @@ Hook run by q before quitting MH-E (default: @code{nil}).
Hook run by @code{mh-folder-mode} when visiting a new folder (default:
@code{nil}).
@c -------------------------
-@item mh-kill-folder-suppress-prompt-hook
+@item mh-kill-folder-suppress-prompt-functions
Abnormal hook run at the beginning of @code{mh-kill-folder} (default:
@code{'mh-search-p}).
@c -------------------------
@@ -7540,8 +7540,8 @@ Allowlisted message face
@cindex spam filters, bogofilter
MH-E depends on @uref{https://spamassassin.apache.org/, SpamAssassin},
-@uref{http://bogofilter.sourceforge.net/, bogofilter}, or
-@uref{http://spamprobe.sourceforge.net/, SpamProbe} to throw the dreck
+@uref{https://bogofilter.sourceforge.net/, bogofilter}, or
+@uref{https://spamprobe.sourceforge.net/, SpamProbe} to throw the dreck
away. This chapter describes briefly how to configure these programs
to work well with MH-E and how to use MH-E's interface that provides
continuing education for these programs.
@@ -7721,7 +7721,7 @@ done by adding the following to your @file{crontab}:
Bogofilter is a Bayesian spam filtering program. Get it from your
local distribution or from the
-@uref{http://bogofilter.sourceforge.net/, bogofilter web site}.
+@uref{https://bogofilter.sourceforge.net/, bogofilter web site}.
Bogofilter is taught by running:
@@ -7791,7 +7791,7 @@ bogofilter.
@cindex spam filters, SpamProbe
SpamProbe is a Bayesian spam filtering program. Get it from your local
-distribution or from the @uref{http://spamprobe.sourceforge.net,
+distribution or from the @uref{https://spamprobe.sourceforge.net,
SpamProbe web site}.
To use SpamProbe, add the following recipes to @file{~/.procmailrc}:
@@ -8633,7 +8633,7 @@ via SourceForge (@pxref{Bug Reports}).
@cindex FAQ
@cindex MH FAQ
-The article @uref{http://www.newt.com/faq/mh.html, @cite{MH Frequently
+The article @uref{https://www.newt.com/faq/mh.html, @cite{MH Frequently
Asked Questions (FAQ) with Answers}} appears monthly in the newsgroup
@samp{comp.mail.mh}. While very little is there that deals with MH-E
specifically, there is an incredible wealth of material about MH
diff --git a/doc/misc/octave-mode.texi b/doc/misc/octave-mode.texi
index 31d64c3d84..d7ea54198a 100644
--- a/doc/misc/octave-mode.texi
+++ b/doc/misc/octave-mode.texi
@@ -204,9 +204,10 @@ The GNU Emacs Manual}). Currently, function names can be
indexed.
@cindex ElDoc Mode Support
@vindex octave-eldoc-message-style
-ElDoc mode (@pxref{Lisp Doc,,, emacs, The GNU Emacs Manual}) is
-supported. By customizing @code{octave-eldoc-message-style} it can be
-changed from displaying one or multi line hints.
+ElDoc mode (@pxref{Programming Language Doc,,, emacs, The GNU Emacs
+Manual}) is supported. By customizing
+@code{octave-eldoc-message-style} it can be changed from displaying
+one or multi line hints.
@c @cindex TAGS
@c @cindex Emacs TAGS files
diff --git a/doc/misc/org.org b/doc/misc/org.org
index 1ce99728c6..ae3ca0b64f 100644
--- a/doc/misc/org.org
+++ b/doc/misc/org.org
@@ -68,8 +68,8 @@ of Org, as well as additional information, frequently asked
questions
[[https://orgmode.org]].
#+cindex: print edition
-An earlier version (7.3) of this manual is available as a
[[http://www.network-theory.co.uk/org/manual/][paperback
-book from Network Theory Ltd.]].
+An earlier version (7.3) of this manual was published as a paperback book by
+Network Theory Ltd. in 2010.
** Installation
:PROPERTIES:
@@ -3234,7 +3234,7 @@ options:
| Link Type | Example |
|------------+----------------------------------------------------------|
-| http | =http://staff.science.uva.nl/c.dominik/= |
+| http | =https://staff.science.uva.nl/c.dominik/= |
| https | =https://orgmode.org/= |
| doi | =doi:10.1000/182= |
| file | =file:/home/dominik/images/jupiter.jpg= |
@@ -3567,7 +3567,7 @@ replacement text. Here is an example:
'(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=";)
("Nu Html Checker" . "https://validator.w3.org/nu/?doc=%h";)
("duckduckgo" . "https://duckduckgo.com/?q=%s";)
- ("omap" .
"http://nominatim.openstreetmap.org/search?q=%s&polygon=1";)
+ ("omap" .
"https://nominatim.openstreetmap.org/search?q=%s&polygon=1";)
("ads" .
"https://ui.adsabs.harvard.edu/search/q=%20author%3A\"%s\"";)))
#+end_src
@@ -3596,7 +3596,7 @@ can define them in the file with
#+cindex: @samp{LINK}, keyword
#+begin_example
-,#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id=
+,#+LINK: bugzilla https://10.1.2.9/bugzilla/show_bug.cgi?id=
,#+LINK: duckduckgo https://duckduckgo.com/?q=%s
#+end_example
@@ -13642,7 +13642,7 @@ not have descriptions, such as these links
=[[file:img.jpg]]= or
=[[./img.jpg]]=, as direct image insertions in the final PDF output. In
the PDF, they are no longer links but actual images embedded on the
page. The LaTeX export back-end uses =\includegraphics= macro to
-insert the image. But for TikZ (http://sourceforge.net/projects/pgf/)
+insert the image. But for TikZ (https://sourceforge.net/projects/pgf/)
images, the back-end uses an ~\input~ macro wrapped within
a ~tikzpicture~ environment.
@@ -13982,7 +13982,7 @@ some text in German...
#+cindex: Markdown export
The Markdown export back-end, "md", converts an Org file to Markdown
-format, as defined at http://daringfireball.net/projects/markdown/.
+format, as defined at https://daringfireball.net/projects/markdown/.
Since it is built on top of the HTML back-end (see [[*HTML Export]]), it
converts every Org construct not defined in Markdown syntax, such as
@@ -22053,7 +22053,7 @@ MathJax are processed. When dvipng, dvisvgm, or
ImageMagick suite is
used to create images, any LaTeX environment is handled.
[fn:112] These are respectively available at
-[[http://sourceforge.net/projects/dvipng/]], [[http://dvisvgm.bplaced.net/]]
+[[https://sourceforge.net/projects/dvipng/]], [[http://dvisvgm.bplaced.net/]]
and from the ImageMagick suite. Choose the converter by setting the
variable ~org-preview-latex-default-process~ accordingly.
@@ -22123,9 +22123,9 @@ semantic relevance.
[fn:130] Please note that exported formulas are part of an HTML
document, and that signs such as =<=, =>=, or =&= have special
-meanings. See
[[http://docs.mathjax.org/en/latest/tex.html#tex-and-latex-in-html-documents][MathJax
TeX and LaTeX support]].
+meanings. See
[[https://docs.mathjax.org/en/latest/tex.html#tex-and-latex-in-html-documents][MathJax
TeX and LaTeX support]].
-[fn:131] See [[http://docs.mathjax.org/en/latest/tex.html#tex-extensions][TeX
and LaTeX extensions]] in the [[http://docs.mathjax.org][MathJax manual]] to
learn
+[fn:131] See [[https://docs.mathjax.org/en/latest/tex.html#tex-extensions][TeX
and LaTeX extensions]] in the [[https://docs.mathjax.org][MathJax manual]] to
learn
about extensions.
[fn:132] If the classes on TODO keywords and tags lead to conflicts,
@@ -22140,14 +22140,14 @@ as latexmk, can select the correct bibliography
compiler.
which requires the flag =-shell-escape= to be added to
~org-latex-pdf-process~.
-[fn:135] See
[[http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][Open Document
Format for Office Applications
+[fn:135] See
[[https://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][Open Document
Format for Office Applications
(OpenDocument) Version 1.2]].
[fn:136] See [[http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl][MathToWeb]].
-[fn:137] See [[http://dlmf.nist.gov/LaTeXML/]].
+[fn:137] See [[https://dlmf.nist.gov/LaTeXML/]].
-[fn:138]
[[http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][OpenDocument-v1.2
Specification]]
+[fn:138]
[[https://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][OpenDocument-v1.2
Specification]]
[fn:139] See the =<table:table-template>= element of the
OpenDocument-v1.2 specification.
@@ -22170,7 +22170,7 @@ are not evaluated when they appear in a keyword (see
[[*Summary of
In-Buffer Settings]]).
[fn:144] For noweb literate programming details, see
-http://www.cs.tufts.edu/~nr/noweb/.
+https://www.cs.tufts.edu/~nr/noweb/.
[fn:145] For more information, please refer to the commentary section
in =org-tempo.el=.
diff --git a/doc/misc/remember.texi b/doc/misc/remember.texi
index 9d1fe545d4..80bb6966e2 100644
--- a/doc/misc/remember.texi
+++ b/doc/misc/remember.texi
@@ -424,13 +424,6 @@ The default priority for remembered mail messages.
@section Saving to an Org Mode file
@cindex org mode, integration
-@ignore
-From org.texi:
-Up to version 6.36 Org used a special setup
-for @file{remember.el}. @file{org-remember.el} is still part of Org mode for
-backward compatibility with existing setups. You can find the documentation
-for org-remember at @url{http://orgmode.org/org-remember.pdf}.
-@end ignore
For instructions on how to integrate Remember with Org Mode,
consult @ref{Capture, , , org}.
diff --git a/doc/misc/sem-user.texi b/doc/misc/sem-user.texi
index 3141ab7c69..36e09b152e 100644
--- a/doc/misc/sem-user.texi
+++ b/doc/misc/sem-user.texi
@@ -621,7 +621,7 @@ Run the Semantic idle work function with debugging turned
on.
Semantic Idle Summary mode is a minor mode that displays a short
summary of the symbol at point, such as its function prototype, in the
echo area. Its functionality is similar to what ElDoc mode provides
-for Emacs Lisp (@pxref{Lisp Doc,,,emacs,Emacs manual}).
+for Emacs Lisp (@pxref{Programming Language Doc,,,emacs,Emacs manual}).
@deffn global-semantic-idle-summary-mode &optional arg
This command toggles Semantic Idle Summary mode in all
diff --git a/doc/misc/semantic.texi b/doc/misc/semantic.texi
index 25ba30d13c..b23e4c36fe 100644
--- a/doc/misc/semantic.texi
+++ b/doc/misc/semantic.texi
@@ -82,7 +82,7 @@ hippie-expand, and several other parts of Emacs.
To send bug reports, or participate in discussions about semantic,
use the mailing list cedet-semantic@@sourceforge.net via the URL:
-@url{http://lists.sourceforge.net/lists/listinfo/cedet-semantic}
+@url{https://lists.sourceforge.net/lists/listinfo/cedet-semantic}
@ifnottex
@insertcopying
diff --git a/doc/misc/sieve.texi b/doc/misc/sieve.texi
index df03dd0144..77a393192c 100644
--- a/doc/misc/sieve.texi
+++ b/doc/misc/sieve.texi
@@ -339,7 +339,7 @@ Indicate which script on the server should be active.
The Emacs Sieve package implements all or parts of a small but
hopefully growing number of RFCs and drafts documents. This chapter
lists the relevant ones. They can all be fetched from
-@uref{http://quimby.gnus.org/notes/}.
+@uref{https://quimby.gnus.org/notes/}.
@table @dfn
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 7de64829c0..e74d382fa1 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -925,6 +925,12 @@ Integration for containers in Kubernetes pods. The host
name is a pod
name returned by @samp{kubectl get pods}. The first container in a
pod is used.
+@samp{kubectl get pods} returns pods in the current context and
+namespace. Current namespace can be changed with @samp{kubectl config
+set-context --current --namespace=<name>}. After invoking this or
+other command which modifies Kubernetes environment outside of Emacs,
+call @code{tramp-cleanup-all-connections} to reset Tramp cache data.
+
This method does not support user names.
@end table
diff --git a/doc/misc/vhdl-mode.texi b/doc/misc/vhdl-mode.texi
index 7d451c71bd..8abf882a29 100644
--- a/doc/misc/vhdl-mode.texi
+++ b/doc/misc/vhdl-mode.texi
@@ -892,7 +892,7 @@ list. Send email to the maintainer @email{reto@@gnu.org}
to join
either of these lists.
The official Emacs VHDL Mode Home Page can be found at
-@uref{http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html}.
+@uref{https://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html}.
@node Sample Init File
@chapter Sample Init File
diff --git a/etc/DEBUG b/etc/DEBUG
index f57e6f197b..ef9160a209 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -1004,7 +1004,7 @@ incompatible with the --with-dumping=unexec option of
'configure'.
** Running Emacs under Valgrind
-Valgrind <http://valgrind.org/> is free software that can be useful
+Valgrind <https://valgrind.org/> is free software that can be useful
when debugging low-level Emacs problems. Unlike GCC sanitizers,
Valgrind does not need you to compile Emacs with special debugging
flags, so it can be helpful in investigating problems that vanish when
diff --git a/etc/HELLO b/etc/HELLO
index b05c09da3c..7bc12063f8 100644
--- a/etc/HELLO
+++ b/etc/HELLO
@@ -41,6 +41,7 @@ C printf (<x-color><param>orange red</param>"Hello,
world!\n"</x-color>);
Cham (ꨌꩌ) ꨦꨤꩌ ꨦꨁꨰ
Cherokee (ᏣᎳᎩ ᎦᏬᏂᎯᏍᏗ) ᎣᏏᏲ / ᏏᏲ
Comanche /kəˈmæntʃiː/ Haa marʉ́awe
+Coptic (ⲘⲉⲧⲢⲉⲙ̀ⲛⲭⲏⲙⲓ) Ⲛⲟⲩϥⲣⲓ
Cree (ᓀᐦᐃᔭᐍᐏᐣ) ᑕᓂᓯ / ᐙᒋᔮ
Czech (čeština) Dobrý den
Danish (dansk) Hej / Goddag / Halløj
diff --git a/etc/NEWS b/etc/NEWS
index 88b1431d6a..aacad8bc4d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -356,6 +356,11 @@ previous 'C-x ='.
** Eshell
+*** Eshell's PATH is now derived from 'exec-path'.
+For consistency with remote connections, Eshell now uses 'exec-path'
+to determine the execution path on the local system, instead of using
+the PATH environment variable directly.
+
---
*** 'source' and '.' no longer accept the '--help' option.
This is for compatibility with the shell versions of these commands,
@@ -815,22 +820,6 @@ This means Emacs built with GNUstep or built on macOS is
now able to
display different faces and images inside tooltips when the
'use-system-tooltips' user option is nil.
-** Connection-local variables
-
-+++
-*** Some connection-local variables are now user options.
-The variables 'connection-local-profile-alist' and
-'connection-local-criteria-alist' are now user options, in order to
-make it more convenient to inspect and modify them.
-
-+++
-*** The default connection-local application can be changed temporarily.
-Running 'with-connection-local-variables' defaults to application
-'tramp'. This can be changed by let-binding
-'connection-local-default-application' to another symbol. This is
-useful when running code in a buffer where Tramp has already set some
-connection-local variables.
-
---
** New minor mode 'pixel-scroll-precision-mode'.
When enabled, and if your mouse supports it, you can scroll the
@@ -1024,6 +1013,12 @@ The apropos commands will now select the apropos window
if
If the symbol at point is a keymap, 'describe-keymap' suggests it as
the default candidate.
+---
+*** New command 'help-quick' displays an overview of common commands.
+The command pops up a buffer at the bottom of the screen with a few
+helpful commands for various tasks. You can toggle the display using
+'C-h q'.
+
** Outline Mode
+++
@@ -1041,15 +1036,11 @@ or is itself too long.
+++
*** New user option 'outline-minor-mode-use-buttons'.
If non-nil, Outline Minor Mode will use buttons to hide/show outlines
-in addition to the ellipsis. The default is nil in editing modes, but
-non-nil in 'help-mode' and its derivatives.
-
-+++
-*** New user option 'outline-minor-mode-use-margins'.
-If non-nil, Outline Minor Mode will use the window margins to
-hide/show outlines in addition to the ellipsis. The default is
-non-nil in 'special-mode' and its derivatives, and it can be used in
-editing modes.
+in addition to the ellipsis. The default is nil, but in 'help-mode'
+it has the value 'insert' that inserts the buttons directly to the
+buffer where you can use 'RET' to cycle outline visibility. When
+the value is 'in-margins', Outline Minor Mode uses the window margins
+to hide/show outlines.
** Windows
@@ -1338,6 +1329,7 @@ Mende Kikakui script and language environment
Wancho script and language environment
Toto script and language environment
Gothic script and language environment
+Coptic script and language environment
---
*** The "Oriya" language environment was renamed to "Odia".
@@ -1361,6 +1353,16 @@ The default input method for the Tamil language
environment is now
change the input method's translation rules, customize the user option
'tamil-translation-rules'.
+---
+*** New tamil99 input method for the Tamil language.
+This supports the keyboard layout specifically designed for the Tamil
+language.
+
+---
+*** New input method 'slovak-qwerty'.
+This is a variant of the 'slovak' input method, which corresponds to
+the QWERTY Slovak keyboards.
+
* Changes in Specialized Modes and Packages in Emacs 29.1
@@ -1375,6 +1377,11 @@ the ecomplete database.
*** New user option 'ecomplete-auto-select'.
If non-nil and there's only one matching option, auto-select that.
+---
+*** New user option 'ecomplete-filter-regexp'.
+If non-nil, this user option describes what entries not to add to the
+database stored on disk.
+
** Dired
+++
@@ -1626,7 +1633,7 @@ This mode adds some highlighting, fixes the 'M-q'
command, and has
commands for doing maintenance of the Emacs NEWS files. In addition,
this mode turns on 'outline-minor-mode', and thus displays
customizable icons (see 'icon-preference') in the margins. To
-disable these icons, customize 'outline-minor-mode-use-margins' to a
+disable these icons, set 'outline-minor-mode-use-buttons' to a
nil value.
---
@@ -1865,6 +1872,24 @@ Git commands display summary lines. See the two new
user options
It is used to style the line that separates the 'log-edit' headers
from the 'log-edit' summary.
+---
+*** The function 'vc-read-revision' accepts a new MULTIPLE argument.
+If non-nil, multiple revisions can be queried. This is done using
+'completing-read-multiple'.
+
+---
+*** New function 'vc-read-multiple-revisions'.
+This function invokes 'vc-read-revision' with a non-nil value for
+MULTIPLE.
+
++++
+*** New command 'vc-prepare-patch'.
+Patches for any version control system can be prepared using VC. The
+command will query what commits to send and will compose messages for
+your mail user agent. The behavior of 'vc-prepare-patch' can be
+modified by the user options 'vc-prepare-patches-separately' and
+'vc-default-patch-addressee'.
+
** Message
---
@@ -2571,7 +2596,7 @@ otherwise be returned.
*** Concatenating Eshell expansions now works more similarly to other shells.
When concatenating an Eshell expansion that returns a list, "adjacent"
elements of each operand are now concatenated together,
-e.g. '$list("a" "b")c' returns '("a" "bc")'. See the "(eshell)
+e.g. '$(list "a" "b")c' returns '("a" "bc")'. See the "(eshell)
Expansion" node in the Eshell manual for more details.
+++
@@ -2730,6 +2755,13 @@ name.
* New Modes and Packages in Emacs 29.1
++++
+** Eglot: Emacs Client for the Language Server Protocol.
+Emacs now comes with the Eglot package, which enhances various Emacs
+features, such as completion, documentation, error detection, etc.,
+based on data provided by language servers using the Language Server
+Protocol (LSP).
+
+++
** New commands 'image-crop' and 'image-cut.
These commands allow interactively cropping/cutting the image at
@@ -2816,6 +2848,11 @@ Previously, ';;;###' specs inside a top-level form
(i.e., something
like '(when ... ;;;### ...)' would be ignored. They are now parsed as
normal.
+---
+** Themes have special autoload cookies.
+All build-in themes are scraped for ';;;###theme-autoload' cookies
+that are loaded along with the regular auto-loaded code.
+
+++
** 'buffer-modified-p' has been extended.
This function was previously documented to return only nil or t. This
@@ -3128,6 +3165,13 @@ The following generalized variables have been made
obsolete:
* Lisp Changes in Emacs 29.1
++++
+** New accessor function 'file-attribute-file-identifier'.
+It returns the list of the inode number and device identifier
+retrieved by 'file-attributes'. This value can be used to identify a
+file uniquely. The device identifier can be a single number or (for
+remote files) a cons of 2 numbers.
+
+++
** New macro 'while-let'.
This is like 'when-let', but repeats until a binding form is nil.
@@ -3177,6 +3221,33 @@ TIMEOUT is the idle time after which to deactivate the
transient map.
The default timeout value can be defined by the new variable
'set-transient-map-timeout'.
+** Connection-local variables
+
++++
+*** Some connection-local variables are now user options.
+The variables 'connection-local-profile-alist' and
+'connection-local-criteria-alist' are now user options, in order to
+make it more convenient to inspect and modify them.
+
++++
+*** New function 'connection-local-update-profile-variables'.
+This function allows to modify the settings of an existing
+connection-local profile.
+
++++
+*** New macro 'with-connection-local-application-variables'.
+This macro works like 'with-connection-local-variables', but it allows
+to use another application but 'tramp'. This is useful when running
+code in a buffer where Tramp has already set some connection-local
+variables.
+
++++
+*** New macro 'setq-connection-local'.
+This allows dynamically setting variable values for a particular
+connection within the body of 'with-connection-local-{application-}variables'.
+See the "(elisp) Connection Local Variables" node in the Lisp
+Reference manual for more information.
+
+++
** 'plist-get', 'plist-put' and 'plist-member' are no longer limited to 'eq'.
These function now take an optional comparison predicate argument.
diff --git a/etc/NEWS.21 b/etc/NEWS.21
index 6c25a76378..a718283191 100644
--- a/etc/NEWS.21
+++ b/etc/NEWS.21
@@ -217,7 +217,7 @@ Default is 'grow-only'.
** LessTif support.
Emacs now runs with the LessTif toolkit (see
-<http://lesstif.sourceforge.net>). You will need version 0.92.26, or later.
+<https://lesstif.sourceforge.net>). You will need version 0.92.26, or later.
** LessTif/Motif file selection dialog.
diff --git a/etc/NEWS.22 b/etc/NEWS.22
index d7b26dda51..b4ecbe7039 100644
--- a/etc/NEWS.22
+++ b/etc/NEWS.22
@@ -3540,7 +3540,7 @@ read-only on computers that are administered by someone
else.
PBM and XBM images are supported out of the box. Other image formats
depend on external libraries. All of these libraries have been ported
to Windows, and can be found in both source and binary form at
-http://gnuwin32.sourceforge.net/. Note that libpng also depends on
+https://gnuwin32.sourceforge.net/. Note that libpng also depends on
zlib, and tiff depends on the version of jpeg that it was compiled
against. For additional information, see nt/INSTALL.
diff --git a/etc/NEWS.25 b/etc/NEWS.25
index d1e43e0538..e716f8194f 100644
--- a/etc/NEWS.25
+++ b/etc/NEWS.25
@@ -72,7 +72,7 @@ using large fonts, at the price of a larger memory footprint.
** The version number of CC Mode has been changed from 5.33 to
5.32.99, although the software itself hasn't changed. This aims to
reduce confusion with the standalone CC Mode 5.33 (available from
-http://cc-mode.sourceforge.net), which is a more mature version than
+https://cc-mode.sourceforge.net), which is a more mature version than
the one included in Emacs 25.2.
diff --git a/etc/NEWS.26 b/etc/NEWS.26
index 50a711a0d1..9a6a799208 100644
--- a/etc/NEWS.26
+++ b/etc/NEWS.26
@@ -1223,7 +1223,7 @@ specialized for editing freedesktop.org desktop entries.
editing Less files.
** New package 'auth-source-pass' integrates 'auth-source' with the
-password manager password-store (http://passwordstore.org).
+password manager password-store (https://passwordstore.org).
* Incompatible Lisp Changes in Emacs 26.1
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index ed2bc1ae05..aaecc41f6e 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1229,6 +1229,17 @@ you should use an Emacs input method instead.
** X keyboard problems
+*** `x-focus-frame' fails to activate the frame.
+
+Some window managers prevent `x-focus-frame' from activating the given
+frame when Emacs is in the background.
+
+Emacs tries to work around this problem by default, but the workaround
+does not work on all window managers. You can try different
+workarounds by changing the value of `x-allow-focus-stealing' (see its
+doc string for more details). The value `imitate-pager' may be
+required on some versions of KWin.
+
*** You "lose characters" after typing Compose Character key.
This is because the Compose Character key is defined as the keysym
diff --git a/etc/TODO b/etc/TODO
index d884539037..cd02cf7023 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -509,7 +509,7 @@ Also for listing fonts, displaying a font as a sample, etc.
** Program Enriched mode to read and save in RTF
Is there actually a decent single definition of RTF? Maybe see info at
-http://latex2rtf.sourceforge.net/.
+https://latex2rtf.sourceforge.net/.
This task seems to be addressed by
https://savannah.nongnu.org/projects/emacs-rtf/, which is still in
@@ -886,7 +886,6 @@ window associated with that modeline.
https://lists.gnu.org/r/emacs-devel/2007-09/msg02416.html
** Random things that were planned for Emacs-24
-
Stefan Monnier writes: "Random things that cross my mind right now
that I'd like to see. Some of them from my local hacks, but it's not
obvious at all whether they'll make it."
@@ -1737,11 +1736,18 @@
https://lists.gnu.org/r/emacs-devel/2012-06/msg00354.html
** Maybe replace lib-src/rcs2log with a Lisp implementation
It wouldn't have to be a complete replacement, just enough
for vc-rcs-update-changelog.
+
** Allow Emacs to use the bottom-right corner of a TTY
Emacs doesn't use the bottom-right corner of a TTY when terminfo
capability "am" (auto_right_margin) is defined. It could use the
bottom-right corner nonetheless when certain other capabilities are
defined. See bug#57607.
+
+** Replace tramp-archive.el by a native libarchive(3) implementation.
+The former is based on the GVFS archive backend, which makes it
+available on GNU/Linux only. That implementation has further
+drawbacks like it doesn't support to write into archives.
+
* Other known bugs
** 'make-frame' forgets unhandled parameters, at least for X11 frames
diff --git a/etc/images/gud/README b/etc/images/gud/README
index 5edd99e2bf..c56c3fc0ee 100644
--- a/etc/images/gud/README
+++ b/etc/images/gud/README
@@ -13,10 +13,10 @@ License: GNU General Public License version 3 or later (see
COPYING)
Some icons are derived from Red Hat's Insight Debugger:
-<http://sourceware.org/insight/>
+<https://sourceware.org/insight/>
"Insight is a graphical user interface to GDB, the GNU Debugger"
-<http://sourceware.org/insight/aboutus.php>
+<https://sourceware.org/insight/aboutus.php>
"Insight is being released under the terms of the GNU General Public
License (GPL)"
diff --git a/etc/srecode/ede-autoconf.srt b/etc/srecode/ede-autoconf.srt
index ecca7afd00..51656eb73c 100644
--- a/etc/srecode/ede-autoconf.srt
+++ b/etc/srecode/ede-autoconf.srt
@@ -38,7 +38,7 @@ template ede-empty :project
{{comment_prefix}} by EDE when this file is updated.
{{comment_prefix}}
{{comment_prefix}} EDE is the Emacs Development Environment.
-{{comment_prefix}} http://cedet.sourceforge.net/ede.shtml
+{{comment_prefix}} https://cedet.sourceforge.net/ede.shtml
{{comment_prefix}}
{{comment_prefix}} Process this file with autoconf to produce a configure
script
diff --git a/etc/srecode/ede-make.srt b/etc/srecode/ede-make.srt
index cde1690f54..c01054e042 100644
--- a/etc/srecode/ede-make.srt
+++ b/etc/srecode/ede-make.srt
@@ -34,7 +34,7 @@ template ede-empty :file :project
#
# DO NOT MODIFY THIS FILE OR YOUR CHANGES MAY BE LOST.
# EDE is the Emacs Development Environment.
-# http://cedet.sourceforge.net/ede.shtml
+# https://cedet.sourceforge.net/ede.shtml
#
----
@@ -58,7 +58,7 @@ template ede-empty :file
#
# DO NOT MODIFY THIS FILE OR YOUR CHANGES MAY BE LOST.
# EDE is the Emacs Development Environment.
-# http://cedet.sourceforge.net/ede.shtml
+# https://cedet.sourceforge.net/ede.shtml
ARDUINO_DIR = {{ARDUINO_HOME}}
diff --git a/etc/themes/adwaita-theme.el b/etc/themes/adwaita-theme.el
index ba83a0578c..6ad8405559 100644
--- a/etc/themes/adwaita-theme.el
+++ b/etc/themes/adwaita-theme.el
@@ -21,10 +21,13 @@
;;; Code:
+;;;###theme-autoload
(deftheme adwaita
"Face colors similar to the default theme of Gnome 3 (Adwaita).
The colors are chosen to match Adwaita window decorations and the
-default look of the Gnome 3 desktop.")
+default look of the Gnome 3 desktop."
+ :background-mode 'light
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces
diff --git a/etc/themes/deeper-blue-theme.el b/etc/themes/deeper-blue-theme.el
index 8f19147f91..48ed9ba061 100644
--- a/etc/themes/deeper-blue-theme.el
+++ b/etc/themes/deeper-blue-theme.el
@@ -21,8 +21,11 @@
;;; Code:
+;;;###theme-autoload
(deftheme deeper-blue
- "Face colors using a deep blue background.")
+ "Face colors using a deep blue background."
+ :background-mode 'dark
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces
diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el
index d53c075d92..fe44d520cc 100644
--- a/etc/themes/dichromacy-theme.el
+++ b/etc/themes/dichromacy-theme.el
@@ -21,6 +21,7 @@
;;; Code:
+;;;###theme-autoload
(deftheme dichromacy
"Face colors suitable for red/green color-blind users.
The color palette is from B. Wong, Nature Methods 8, 441 (2011).
@@ -28,7 +29,9 @@ It is intended to provide good variability while being easily
differentiated by individuals with protanopia or deuteranopia.
Basic, Font Lock, Isearch, Gnus, Message, Flyspell, and
-Ansi-Color faces are included.")
+Ansi-Color faces are included."
+ :background-mode 'light
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89)))
(orange "#e69f00")
diff --git a/etc/themes/leuven-dark-theme.el b/etc/themes/leuven-dark-theme.el
index 0e162c8bab..08978a2668 100644
--- a/etc/themes/leuven-dark-theme.el
+++ b/etc/themes/leuven-dark-theme.el
@@ -5,7 +5,7 @@
;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")>
;; Contributor: Thibault Polge <(concat "thibault" at-sign "thb.lt")>
;; URL: https://github.com/fniessen/emacs-leuven-dark-theme
-;; Version: 20220202.1126
+;; Version: 20221010.1208
;; Keywords: color theme
;; This file is part of GNU Emacs.
@@ -93,11 +93,15 @@ CONTROL can be a number, nil, or t. When t, use
DEFAULT-HEIGHT."
;;; Theme Faces.
+;;;###theme-autoload
(deftheme leuven-dark
"Face colors with a light background.
Basic, Font Lock, Isearch, Gnus, Message, Org mode, Diff, Ediff,
Flyspell, Semantic, and Ansi-Color faces are included -- and much
-more...")
+more..."
+ :background-mode 'dark
+ :family 'leuven
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89)))
diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el
index d9a8d5391a..e712a79adf 100644
--- a/etc/themes/leuven-theme.el
+++ b/etc/themes/leuven-theme.el
@@ -4,7 +4,7 @@
;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")>
;; URL: https://github.com/fniessen/emacs-leuven-theme
-;; Version: 20200513.1928
+;; Version: 20221010.1209
;; Keywords: color theme
;; This file is part of GNU Emacs.
@@ -74,11 +74,15 @@ CONTROL can be a number, nil, or t. When t, use
DEFAULT-HEIGHT."
;;; Theme Faces.
+;;;###theme-autoload
(deftheme leuven
"Face colors with a light background.
Basic, Font Lock, Isearch, Gnus, Message, Org mode, Diff, Ediff,
Flyspell, Semantic, and Ansi-Color faces are included -- and much
-more...")
+more..."
+ :background-mode 'light
+ :kind 'color-scheme
+ :family 'leuven)
(let ((class '((class color) (min-colors 89)))
diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el
index eeca46210c..808fcbfeb2 100644
--- a/etc/themes/light-blue-theme.el
+++ b/etc/themes/light-blue-theme.el
@@ -26,8 +26,11 @@
;;; Code:
+;;;###theme-autoload
(deftheme light-blue
- "Face colors utilizing a light blue background.")
+ "Face colors utilizing a light blue background."
+ :background-mode 'light
+ :kind 'color-scheme)
(make-obsolete 'light-blue nil "29.1")
diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el
index af5576386c..f9aaa97c25 100644
--- a/etc/themes/manoj-dark-theme.el
+++ b/etc/themes/manoj-dark-theme.el
@@ -64,10 +64,13 @@
;;; Code:
+;;;###theme-autoload
(deftheme manoj-dark
"Very high contrast faces with a black background.
This theme avoids subtle color variations, while avoiding the
-jarring angry fruit salad look to reduce eye fatigue.")
+jarring angry fruit salad look to reduce eye fatigue."
+ :background-mode 'dark
+ :kind 'color-scheme)
(custom-theme-set-faces
'manoj-dark
diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el
index 55186384ad..3fd6cdb5af 100644
--- a/etc/themes/misterioso-theme.el
+++ b/etc/themes/misterioso-theme.el
@@ -21,8 +21,11 @@
;;; Code:
+;;;###theme-autoload
(deftheme misterioso
- "Predominantly blue/cyan faces on a dark cyan background.")
+ "Predominantly blue/cyan faces on a dark cyan background."
+ :background-mode 'dark
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89))))
diff --git a/etc/themes/modus-operandi-theme.el
b/etc/themes/modus-operandi-theme.el
index 6e609c0803..0f0630a6d1 100644
--- a/etc/themes/modus-operandi-theme.el
+++ b/etc/themes/modus-operandi-theme.el
@@ -71,4 +71,6 @@ which corresponds to a minimum contrast in relative luminance
of
(provide-theme 'modus-operandi))
+;;;###theme-autoload (put 'modus-operandi 'theme-properties '(:background-mode
light :kind color-scheme :family modus))
+
;;; modus-operandi-theme.el ends here
diff --git a/etc/themes/modus-vivendi-theme.el
b/etc/themes/modus-vivendi-theme.el
index 0983e26c78..02c2d9e129 100644
--- a/etc/themes/modus-vivendi-theme.el
+++ b/etc/themes/modus-vivendi-theme.el
@@ -71,4 +71,6 @@ which corresponds to a minimum contrast in relative luminance
of
(provide-theme 'modus-vivendi))
+;;;###theme-autoload (put 'modus-vivendi 'theme-properties '(:background-mode
dark :kind color-scheme :family modus))
+
;;; modus-vivendi-theme.el ends here
diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el
index ef00d2ac49..85995e4e99 100644
--- a/etc/themes/tango-dark-theme.el
+++ b/etc/themes/tango-dark-theme.el
@@ -27,10 +27,15 @@
;;; Code:
+;;;###theme-autoload
(deftheme tango-dark
"Face colors using the Tango palette (dark background).
Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
-Semantic, and Ansi-Color faces are included.")
+Semantic, and Ansi-Color faces are included."
+ :background-mode 'dark
+ :kind 'color-scheme
+ :family 'tango)
+
(let ((class '((class color) (min-colors 89)))
;; Tango palette colors.
diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el
index ecbbf03753..2ac1b42294 100644
--- a/etc/themes/tango-theme.el
+++ b/etc/themes/tango-theme.el
@@ -27,10 +27,14 @@
;;; Code:
+;;;###theme-autoload
(deftheme tango
"Face colors using the Tango palette (light background).
Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
-Semantic, and Ansi-Color faces are included.")
+Semantic, and Ansi-Color faces are included."
+ :background-mode 'light
+ :kind 'color-scheme
+ :family 'tango)
(let ((class '((class color) (min-colors 89)))
;; Tango palette colors.
diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el
index a88ad75520..6b1e865e42 100644
--- a/etc/themes/tsdh-dark-theme.el
+++ b/etc/themes/tsdh-dark-theme.el
@@ -19,8 +19,12 @@
;;; Code:
+;;;###theme-autoload
(deftheme tsdh-dark
- "A dark theme used and created by Tassilo Horn.")
+ "A dark theme used and created by Tassilo Horn."
+ :background-mode 'dark
+ :kind 'color-scheme
+ :family 'tsdh)
(custom-theme-set-faces
'tsdh-dark
diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el
index d9d09b702b..ac964d66d6 100644
--- a/etc/themes/tsdh-light-theme.el
+++ b/etc/themes/tsdh-light-theme.el
@@ -19,9 +19,13 @@
;;; Code:
+;;;###theme-autoload
(deftheme tsdh-light
"A light Emacs theme.
-Used and created by Tassilo Horn.")
+Used and created by Tassilo Horn."
+ :background-mode 'light
+ :kind 'color-scheme
+ :family 'tsdh)
(custom-theme-set-faces
'tsdh-light
diff --git a/etc/themes/wheatgrass-theme.el b/etc/themes/wheatgrass-theme.el
index c56c8a2d8a..20e7bbbac2 100644
--- a/etc/themes/wheatgrass-theme.el
+++ b/etc/themes/wheatgrass-theme.el
@@ -19,11 +19,14 @@
;;; Code:
+;;;###theme-autoload
(deftheme wheatgrass
"High-contrast green/blue/brown faces on a black background.
Basic, Font Lock, Isearch, Gnus, and Message faces are included.
The default face foreground is wheat, with other faces in shades
-of green, brown, and blue.")
+of green, brown, and blue."
+ :background-mode 'dark
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces
diff --git a/etc/themes/whiteboard-theme.el b/etc/themes/whiteboard-theme.el
index f21b18b421..2f86234b32 100644
--- a/etc/themes/whiteboard-theme.el
+++ b/etc/themes/whiteboard-theme.el
@@ -21,8 +21,11 @@
;;; Code:
+;;;###theme-autoload
(deftheme whiteboard
- "Face colors similar to markers on a whiteboard.")
+ "Face colors similar to markers on a whiteboard."
+ :background-mode 'light
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces
diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el
index d9fab8ac78..9bb026ead1 100644
--- a/etc/themes/wombat-theme.el
+++ b/etc/themes/wombat-theme.el
@@ -21,11 +21,14 @@
;;; Code:
+;;;###theme-autoload
(deftheme wombat
"Medium-contrast faces with a dark gray background.
Adapted, with permission, from a Vim color scheme by Lars H. Nielsen.
Basic, Font Lock, Isearch, Gnus, Message, and Ansi-Color faces
-are included.")
+are included."
+ :background-mode 'dark
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces
diff --git a/lib-src/rcs2log b/lib-src/rcs2log
index bc7875cfdd..2a72404d9e 100755
--- a/lib-src/rcs2log
+++ b/lib-src/rcs2log
@@ -209,7 +209,7 @@ month_data='
if type mktemp >/dev/null 2>&1; then
logdir=`mktemp -d`
else
- logdir=$TMPDIR/rcs2log$$
+ logdir="${TMPDIR-/tmp}/rcs2log$$"
(umask 077 && mkdir "$logdir")
fi || exit
case $logdir in
diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c
index 041bf5c749..7e54b878a2 100644
--- a/lib-src/seccomp-filter.c
+++ b/lib-src/seccomp-filter.c
@@ -206,6 +206,9 @@ main (int argc, char **argv)
SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
~(PROT_NONE | PROT_READ | PROT_WRITE), 0));
+ /* Allow restartable sequences. The dynamic linker uses them. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (rseq));
+
/* Futexes are used everywhere. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (futex),
SCMP_A1_32 (SCMP_CMP_EQ, FUTEX_WAKE_PRIVATE));
@@ -218,6 +221,7 @@ main (int argc, char **argv)
RULE (SCMP_ACT_ALLOW, SCMP_SYS (getuid));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (geteuid));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpid));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (gettid));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpgrp));
/* Allow operations on open file descriptors. File descriptors are
@@ -324,6 +328,8 @@ main (int argc, char **argv)
| CLONE_SETTLS | CLONE_PARENT_SETTID
| CLONE_CHILD_CLEARTID),
0));
+ /* glibc 2.34+ pthread_create uses clone3. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (clone3));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaltstack));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_robust_list));
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index 0b97a64109..6053ffa65a 100644
--- a/lisp/ChangeLog.10
+++ b/lisp/ChangeLog.10
@@ -9490,7 +9490,7 @@
toolbar/rescan.pbm, toolbar/rescan.xpm, toolbar/show.pbm,
toolbar/show.xpm, toolbar/widen.pbm, toolbar/widen.xpm:
Upgraded to mh-e version 6.1.1. Full ChangeLog available in
- http://prdownloads.sourceforge.net/mh-e/mh-e-6.1.tgz?download .
+ https://prdownloads.sourceforge.net/mh-e/mh-e-6.1.tgz?download .
There were no user-visible changes in 6.1.1 from 6.1--only the
section of the Makefile that installs the files into Emacs was changed.
diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14
index c84e44536d..686746abe0 100644
--- a/lisp/ChangeLog.14
+++ b/lisp/ChangeLog.14
@@ -155,7 +155,7 @@
* epa.el (epa-decrypt-region): Detect encoding if
coding-system-for-read is not specified.
- <http://sourceforge.jp/ticket/browse.php?group_id=2267&tid=17018>
+ <https://sourceforge.jp/ticket/browse.php?group_id=2267&tid=17018>
(epa-verify-region): Ditto.
2009-06-04 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -540,7 +540,7 @@
* epa-file.el (epa-file-decode-and-insert):
Use string-to-multibyte instead of set-buffer-multibyte.
- <http://sourceforge.jp/ticket/browse.php?group_id=2267&tid=15259>
+ <https://sourceforge.jp/ticket/browse.php?group_id=2267&tid=15259>
2009-04-18 Yann Hodique <yann.hodique@gmail.com> (tiny change)
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index 53caf69e1c..23e61ff787 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -22762,7 +22762,7 @@
Automatically handle .xz suffix (XZ-compressed files), too.
* jka-cmpr-hook.el (jka-compr-compression-info-list): Add xz.
- XZ is the successor to LZMA: <http://tukaani.org/xz/>
+ XZ is the successor to LZMA: <https://tukaani.org/xz/>
2009-06-22 Dmitry Dzhus <dima@sphinx.net.ru>
Nick Roberts <nickrob@snap.net.nz>
diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17
index cebafe18aa..df731fe9ed 100644
--- a/lisp/ChangeLog.17
+++ b/lisp/ChangeLog.17
@@ -14039,7 +14039,7 @@
* epa-file.el (epa-file-write-region): Encode the region according
to `buffer-file-format'. Problem reported at:
- <http://sourceforge.jp/ticket/browse.php?group_id=2267&tid=32917>.
+ <https://sourceforge.jp/ticket/browse.php?group_id=2267&tid=32917>.
2014-01-14 Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 256017f6c5..338814fdda 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -430,6 +430,12 @@ compile-always:
find $(lisp) -name '*.elc' $(FIND_DELETE)
$(MAKE) compile
+.PHONY: trampolines
+trampolines: compile
+ifeq ($(HAVE_NATIVE_COMP),yes)
+ $(emacs) -l comp -f comp-compile-all-trampolines
+endif
+
.PHONY: backup-compiled-files compile-after-backup
# Backup compiled Lisp files in elc.tar.gz. If that file already
diff --git a/lisp/ansi-osc.el b/lisp/ansi-osc.el
index 34154998cd..499c9dce73 100644
--- a/lisp/ansi-osc.el
+++ b/lisp/ansi-osc.el
@@ -125,13 +125,11 @@ and `shell-dirtrack-mode'."
;; Hyperlink handling (OSC 8)
-(defvar ansi-osc-hyperlink-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\r" 'browse-url-button-open)
- (define-key map [mouse-2] 'browse-url-button-open)
- (define-key map [follow-link] 'mouse-face)
- map)
- "Keymap used by OSC 8 hyperlink buttons.")
+(defvar-keymap ansi-osc-hyperlink-map
+ :doc "Keymap used by OSC 8 hyperlink buttons."
+ "C-c RET" #'browse-url-button-open
+ "<mouse-2>" #'browse-url-button-open
+ "<follow-link>" 'mouse-face)
(define-button-type 'ansi-osc-hyperlink
'keymap ansi-osc-hyperlink-map
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 580f6b3ced..51d939151c 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -168,7 +168,7 @@ If this contains a %s, that will be replaced by the
matching rule."
(".dir-locals.el"
nil
- ";;; Directory Local Variables\n"
+ ";;; Directory Local Variables -*- no-byte-compile: t; -*-\n"
";;; For more information see (info \"(emacs) Directory Variables\")\n\n"
"(("
'(setq v1 (let (modes)
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index 0564cf6d04..5b0df013a3 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -47,7 +47,7 @@
;; The original pulse code was written for semantic tag highlighting.
;; It has been extracted, and adapted for general purpose pulsing.
;;
-;; Pulse is a part of CEDET. http://cedet.sf.net
+;; Pulse is a part of CEDET. https://cedet.sourceforge.net
(require 'color)
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index 7cb6768f7e..4efc283520 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -128,11 +128,9 @@ If nil, errors are still displayed, but informative
messages are not."
"Provide a mechanism for semantic tag management.
Argument START, END, and LENGTH specify the bounds of the change."
(setq semantic-unmatched-syntax-cache-check t)
- (let ((inhibit-point-motion-hooks t)
- )
- (save-match-data
- (run-hook-with-args 'semantic-change-functions start end length)
- )))
+ (save-match-data
+ (run-hook-with-args 'semantic-change-functions start end length)
+ ))
(defun semantic-changes-in-region (start end &optional buffer)
"Find change overlays which exist in whole or in part between START and END.
diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el
index 2fc79d01a7..67ee82c73e 100644
--- a/lisp/cedet/srecode/fields.el
+++ b/lisp/cedet/srecode/fields.el
@@ -334,9 +334,7 @@ START and END are the bounds of the change.
PRE-LEN is used in the after mode for the length of the changed text."
(when (and after (not undo-in-progress))
(let* ((field (overlay-get ol 'srecode))
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- )
+ (inhibit-modification-hooks t))
;; Sometimes a field is deleted, but we might still get a stray
;; event. Let's just ignore those events.
(when (slot-boundp field 'overlay)
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el
index db17b7f23f..f8cfe2a733 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -125,9 +125,7 @@ has set everything up already."
;; I tried `combine-after-change-calls', but it did not have
;; the effect I wanted.
(let ((start (point)))
- (let ((inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- )
+ (let ((inhibit-modification-hooks t))
(srecode--insert-into-buffer template dictionary)
)
;; Now call those after change functions.
diff --git a/lisp/comint.el b/lisp/comint.el
index b1f3ad8259..07ced8d321 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -2147,29 +2147,33 @@ Make backspaces delete the previous character."
(goto-char (process-mark process))
(set-marker comint-last-output-start (point))
+ ;; Before we call `comint--mark-as-output' later,
+ ;; redisplay can be called. We mark the inserted text as
+ ;; output early, to prevent redisplay from fontifying it
+ ;; as input in case of `comint-fontify-input-mode'.
+ (put-text-property 0 (length string) 'field 'output string)
+
;; insert-before-markers is a bad thing. XXX
;; Luckily we don't have to use it any more, we use
;; window-point-insertion-type instead.
- (make-local-variable 'jit-lock-mode)
- (let ((jit-lock-mode nil))
- (insert string)
+ (insert string)
- ;; Advance process-mark
- (set-marker (process-mark process) (point))
+ ;; Advance process-mark
+ (set-marker (process-mark process) (point))
- (unless comint-inhibit-carriage-motion
+ (unless comint-inhibit-carriage-motion
;; Interpret any carriage motion characters (newline, backspace)
(comint-carriage-motion comint-last-output-start (point)))
- ;; Run these hooks with point where the user had it.
- (goto-char saved-point)
- (run-hook-with-args 'comint-output-filter-functions string)
- (set-marker saved-point (point))
+ ;; Run these hooks with point where the user had it.
+ (goto-char saved-point)
+ (run-hook-with-args 'comint-output-filter-functions string)
+ (set-marker saved-point (point))
- (goto-char (process-mark process)) ; In case a filter moved it.
+ (goto-char (process-mark process)) ; In case a filter moved it.
- (unless comint-use-prompt-regexp
- (comint--mark-as-output comint-last-output-start (point))))
+ (unless comint-use-prompt-regexp
+ (comint--mark-as-output comint-last-output-start (point)))
;; Highlight the prompt, where we define `prompt' to mean
;; the most recent output that doesn't end with a newline.
diff --git a/lisp/custom.el b/lisp/custom.el
index 604b1a3ff4..0d3e2e5d0c 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1152,9 +1152,11 @@ list, in which A occurs before B if B was defined with a
;; (provide-theme 'THEME)
-(defmacro deftheme (theme &optional doc)
+(defmacro deftheme (theme &optional doc &rest properties)
"Declare THEME to be a Custom theme.
The optional argument DOC is a doc string describing the theme.
+PROPERTIES are interpreted as a property list that will be stored
+in the `theme-properties' property for THEME.
Any theme `foo' should be defined in a file called `foo-theme.el';
see `custom-make-theme-feature' for more information."
@@ -1164,18 +1166,25 @@ see `custom-make-theme-feature' for more information."
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
- (list 'custom-declare-theme (list 'quote theme) (list 'quote feature)
doc)))
+ (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc
+ (cons 'list properties))))
-(defun custom-declare-theme (theme feature &optional doc)
+(defun custom-declare-theme (theme feature &optional doc properties)
"Like `deftheme', but THEME is evaluated as a normal argument.
-FEATURE is the feature this theme provides. Normally, this is a symbol
-created from THEME by `custom-make-theme-feature'."
+FEATURE is the feature this theme provides. Normally, this is a
+symbol created from THEME by `custom-make-theme-feature'. The
+optional argument DOC may contain the documentation for THEME.
+The optional argument PROPERTIES may contain a property list of
+attributes associated with THEME."
(unless (custom-theme-name-valid-p theme)
(error "Custom theme cannot be named %S" theme))
(unless (memq theme custom-known-themes)
(push theme custom-known-themes))
(put theme 'theme-feature feature)
- (when doc (put theme 'theme-documentation doc)))
+ (when doc
+ (put theme 'theme-documentation doc))
+ (when properties
+ (put theme 'theme-properties properties)))
(defun custom-make-theme-feature (theme)
"Given a symbol THEME, create a new symbol by appending \"-theme\".
@@ -1372,6 +1381,58 @@ Return t if THEME was successfully loaded, nil
otherwise."
(enable-theme theme))
t)
+(defun theme-list-variants (theme &rest list)
+ "Return a list of theme variants for THEME.
+By default this will use all known custom themes (see
+`custom-available-themes') to check for variants. This can be
+restricted if the optional argument LIST containing a list of
+theme symbols to consider."
+ (let* ((properties (get theme 'theme-properties))
+ (family (plist-get properties :family)))
+ (seq-filter
+ (lambda (variant)
+ (and (eq (plist-get (get variant 'theme-properties) :family)
+ family)
+ (not (eq variant theme))))
+ (or list (custom-available-themes)))))
+
+(defun theme-choose-variant (&optional no-confirm no-enable)
+ "Switch from the current theme to one of its variants.
+The current theme will be disabled before variant is enabled. If
+the current theme has only one variant, switch to that variant
+without prompting, otherwise prompt for the variant to select.
+See `load-theme' for the meaning of NO-CONFIRM and NO-ENABLE."
+ (interactive)
+ (let ((active-color-schemes
+ (seq-filter
+ (lambda (theme)
+ ;; FIXME: As most themes currently do not have a `:kind'
+ ;; tag, it is assumed that a theme is a color scheme by
+ ;; default. This should be reconsidered in the future.
+ (memq (plist-get (get theme 'theme-properties) :kind)
+ '(color-scheme nil)))
+ custom-enabled-themes)))
+ (cond
+ ((length= active-color-schemes 0)
+ (user-error "No theme is active, cannot toggle"))
+ ((length> active-color-schemes 1)
+ (user-error "More than one theme active, cannot unambiguously toggle")))
+ (let* ((theme (car active-color-schemes))
+ (family (plist-get (get theme 'theme-properties) :family)))
+ (unless family
+ (error "Theme `%s' does not have any known variants" theme))
+ (let* ((variants (theme-list-variants theme))
+ (choice (cond
+ ((null variants)
+ (error "`%s' has no variants" theme))
+ ((length= variants 1)
+ (car variants))
+ ((intern (completing-read "Load custom theme: "
variants))))))
+ (disable-theme theme)
+ (load-theme choice no-confirm no-enable)))))
+
+(defalias 'toggle-theme #'theme-choose-variant)
+
(defun custom-theme-load-confirm (hash)
"Query the user about loading a Custom theme that may not be safe.
The theme should be in the current buffer. If the user agrees,
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
index 215425f136..e909da3c20 100644
--- a/lisp/dabbrev.el
+++ b/lisp/dabbrev.el
@@ -985,9 +985,6 @@ Leaves point at the location of the start of the expansion."
"\\(" dabbrev--abbrev-char-regexp "\\)"))
(pattern2 (concat (regexp-quote abbrev)
"\\(\\(" dabbrev--abbrev-char-regexp "\\)+\\)"))
- ;; This makes it possible to find matches in minibuffer prompts
- ;; even when they are "inviolable".
- (inhibit-point-motion-hooks t)
found-string result)
;; Limited search.
(save-restriction
diff --git a/lisp/dired.el b/lisp/dired.el
index 96b580d576..85a7131570 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2956,7 +2956,7 @@ unchanged."
(or dir (setq dir default-directory))
;; This case comes into play if default-directory is set to
;; use ~.
- (if (and (> (length dir) 0) (= (aref dir 0) ?~))
+ (if (string-match-p "\\(\\`\\|:\\)~" dir)
(setq dir (expand-file-name dir)))
(if (string-match (concat "^" (regexp-quote dir)) file)
(substring file (match-end 0))
diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el
index 6ff67d46d2..54d60c84d4 100644
--- a/lisp/ecomplete.el
+++ b/lisp/ecomplete.el
@@ -70,9 +70,9 @@
:type '(symbol :tag "Coding system"))
(defcustom ecomplete-sort-predicate #'ecomplete-decay
- "Predicate to use when sorting matched.
-The predicate is called with two parameters that represent the
-completion. Each parameter is a list where the first element is
+ "Predicate to use when sorting matched ecomplete candidates.
+The predicate is called with two arguments that represent the
+completion. Each argument is a list where the first element is
the times the completion has been used, the second is the
timestamp of the most recent usage, and the third item is the
string that was matched."
@@ -86,6 +86,11 @@ string that was matched."
:type 'boolean
:version "29.1")
+(defcustom ecomplete-filter-regexp nil
+ "Regular expression of addresses that should not be stored by ecomplete."
+ :type 'regexp
+ :version "29.1")
+
;;; Internal variables.
(defvar ecomplete-database nil)
@@ -104,20 +109,22 @@ string that was matched."
By default, the longest version of TEXT will be preserved, but if
FORCE is non-nil, use TEXT exactly as is."
(unless ecomplete-database (ecomplete-setup))
- (let ((elems (assq type ecomplete-database))
- (now (time-convert nil 'integer))
- entry)
- (unless elems
- (push (setq elems (list type)) ecomplete-database))
- (if (setq entry (assoc key (cdr elems)))
- (pcase-let ((`(,_key ,count ,_time ,oldtext) entry))
- (setcdr entry (list (1+ count) now
- ;; Preserve the "more complete" text.
- (if (or force
- (>= (length text) (length oldtext)))
- text
- oldtext))))
- (nconc elems (list (list key 1 now text))))))
+ (unless (and ecomplete-filter-regexp
+ (string-match-p ecomplete-filter-regexp key))
+ (let ((elems (assq type ecomplete-database))
+ (now (time-convert nil 'integer))
+ entry)
+ (unless elems
+ (push (setq elems (list type)) ecomplete-database))
+ (if (setq entry (assoc key (cdr elems)))
+ (pcase-let ((`(,_key ,count ,_time ,oldtext) entry))
+ (setcdr entry (list (1+ count) now
+ ;; Preserve the "more complete" text.
+ (if (or force
+ (>= (length text) (length oldtext)))
+ text
+ oldtext))))
+ (nconc elems (list (list key 1 now text)))))))
(defun ecomplete--remove-item (type key)
"Remove the element of TYPE and KEY from the ecomplete database."
@@ -289,7 +296,7 @@ non-nil and there is only a single completion option
available."
nil t)))
(defun ecomplete-edit ()
- "Prompt for an item and allow editing it."
+ "Prompt for an ecomplete item and allow editing it."
(interactive)
(let* ((type (ecomplete--prompt-type))
(data (cdr (assq type ecomplete-database)))
@@ -305,7 +312,8 @@ non-nil and there is only a single completion option
available."
(ecomplete-save)))
(defun ecomplete-remove ()
- "Remove entries matching a regexp from the ecomplete database."
+ "Remove from the ecomplete database the entries matching a regexp.
+Prompt for the regexp to match the database entries to be removed."
(interactive)
(let* ((type (ecomplete--prompt-type))
(data (cdr (assq type ecomplete-database)))
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index 47bc3a4524..4bf61abe54 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -31,6 +31,7 @@
;;; Code:
+(require 'cl-lib)
(eval-when-compile (require 'subr-x)) ;For `named-let'.
(defmacro benchmark-elapse (&rest forms)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 0ecac3d52a..82d3c5309f 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -163,7 +163,9 @@
(let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
(setq bindat-idx (+ bindat-idx len))
(if (stringp s) s
- (apply #'unibyte-string s))))
+ ;; FIXME: There should be a more efficient way to do this.
+ ;; Should `apply' accept vectors in addition to lists?
+ (apply #'unibyte-string (append s nil)))))
(defun bindat--unpack-strz (&optional len)
(let ((i 0) s)
@@ -172,7 +174,7 @@
(setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
(setq bindat-idx (+ bindat-idx (or len (1+ i))))
(if (stringp s) s
- (apply #'unibyte-string s))))
+ (apply #'unibyte-string (append s nil)))))
(defun bindat--unpack-bits (len)
(let ((bits nil) (bnum (1- (* 8 len))) j m)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 9db84c31b8..a33808ab92 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -481,6 +481,11 @@ convention was modified."
(puthash (indirect-function function) signature
advertised-signature-table))
+(defun get-advertised-calling-convention (function)
+ "Get the advertised SIGNATURE of FUNCTION.
+Return t if there isn't any."
+ (gethash function advertised-signature-table t))
+
(defun make-obsolete (obsolete-name current-name when)
"Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
OBSOLETE-NAME should be a function name or macro name (a symbol).
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index f0e72a6e20..8213fa3a43 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -129,6 +129,7 @@
;; us from emitting warnings when compiling files which use cl-lib without
;; requiring it! (bug#30635)
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
;; The feature of compiling in a specific target Emacs version
;; has been turned off because compile time options are a bad idea.
@@ -1185,27 +1186,22 @@ message buffer `default-directory'."
(defun byte-compile--first-symbol-with-pos (form)
"Return the first symbol with position in form, or nil if none.
Order is by depth-first search."
- (cond
- ((symbol-with-pos-p form) form)
- ((consp form)
- (or (byte-compile--first-symbol-with-pos (car form))
- (let ((sym nil))
- (setq form (cdr form))
- (while (and (consp form)
- (not (setq sym (byte-compile--first-symbol-with-pos
- (car form)))))
- (setq form (cdr form)))
- (or sym
- (and form (byte-compile--first-symbol-with-pos form))))))
- ((or (vectorp form) (recordp form))
- (let ((len (length form))
- (i 0)
- (sym nil))
- (while (and (< i len)
- (not (setq sym (byte-compile--first-symbol-with-pos
- (aref form i)))))
- (setq i (1+ i)))
- sym))))
+ (named-let loop ((form form)
+ (depth 10)) ;Arbitrary limit.
+ (cond
+ ((<= depth 0) nil) ;Avoid cycles (bug#58601).
+ ((symbol-with-pos-p form) form)
+ ((consp form)
+ (or (loop (car form) (1- depth))
+ (loop (cdr form) (1- depth))))
+ ((or (vectorp form) (recordp form))
+ (let ((len (length form))
+ (i 0)
+ (sym nil))
+ (while (and (< i len)
+ (not (setq sym (loop (aref form i) (1- depth)))))
+ (setq i (1+ i)))
+ sym)))))
(defun byte-compile--warning-source-offset ()
"Return a source offset from `byte-compile-form-stack' or nil if none."
@@ -1405,11 +1401,11 @@ when printing the error message."
(and (not macro-p)
(compiled-function-p (symbol-function fn)))))
(setq fn (symbol-function fn)))
- (let ((advertised (gethash (if (and (symbolp fn) (fboundp fn))
- ;; Could be a subr.
- (symbol-function fn)
- fn)
- advertised-signature-table t)))
+ (let ((advertised (get-advertised-calling-convention
+ (if (and (symbolp fn) (fboundp fn))
+ ;; Could be a subr.
+ (symbol-function fn)
+ fn))))
(cond
((listp advertised)
(if macro-p
@@ -1469,9 +1465,11 @@ when printing the error message."
(defun byte-compile-arglist-signature-string (signature)
(cond ((null (cdr signature))
- (format "%d+" (car signature)))
+ (format "%d or more" (car signature)))
((= (car signature) (cdr signature))
(format "%d" (car signature)))
+ ((= (1+ (car signature)) (cdr signature))
+ (format "%d or %d" (car signature) (cdr signature)))
(t (format "%d-%d" (car signature) (cdr signature)))))
(defun byte-compile-function-warn (f nargs def)
@@ -2322,9 +2320,15 @@ With argument ARG, insert value in current buffer after
the form."
(setq case-fold-search nil))
(displaying-byte-compile-warnings
(with-current-buffer inbuffer
- (and byte-compile-current-file
- (byte-compile-insert-header byte-compile-current-file
- byte-compile--outbuffer))
+ (when byte-compile-current-file
+ (byte-compile-insert-header byte-compile-current-file
+ byte-compile--outbuffer)
+ ;; Instruct native-comp to ignore this file.
+ (when (bound-and-true-p no-native-compile)
+ (with-current-buffer byte-compile--outbuffer
+ (insert
+ "(when (boundp 'comp--no-native-compile)
+ (puthash load-file-name t comp--no-native-compile))\n\n"))))
(goto-char (point-min))
;; Should we always do this? When calling multiple files, it
;; would be useful to delay this warning until all have been
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 7c7f027d77..66b214554e 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -615,12 +615,12 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
,(funcall setter
`(cl--set-getf ,getter ,k ,val))
,val)))))))))
- (let ((val-tail (cdr-safe (plist-member plist tag))))
+ (let ((val-tail (cdr (plist-member plist tag))))
(if val-tail (car val-tail) def)))
;;;###autoload
(defun cl--set-getf (plist tag val)
- (let ((val-tail (cdr-safe (plist-member plist tag))))
+ (let ((val-tail (cdr (plist-member plist tag))))
(if val-tail (progn (setcar val-tail val) plist)
(cl-list* tag val plist))))
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index b3ade3b894..7b6d43e572 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -650,13 +650,17 @@ The set of acceptable TYPEs (also called
\"specializers\") is defined
(cl--generic-name generic)
qualifiers specializers))
current-load-list :test #'equal)
- (let (;; Prevent `defalias' from recording this as the definition site of
+ (let ((old-adv-cc (get-advertised-calling-convention
+ (symbol-function sym)))
+ ;; Prevent `defalias' from recording this as the definition site of
;; the generic function.
current-load-list
;; BEWARE! Don't purify this function definition, since that leads
;; to memory corruption if the hash-tables it holds are modified
;; (the GC doesn't trace those pointers).
(purify-flag nil))
+ (when (listp old-adv-cc)
+ (set-advertised-calling-convention gfun old-adv-cc nil))
;; But do use `defalias', so that it interacts properly with nadvice,
;; e.g. for tracing/debug-on-entry.
(defalias sym gfun)))))
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 6656b7e57c..5a05fe4854 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -687,6 +687,9 @@ Useful to hook into pass checkers.")
'native-compiler-error)
+(defvar comp-no-spawn nil
+ "Non-nil don't spawn native compilation processes.")
+
;; Moved early to avoid circularity when comp.el is loaded and
;; `macroexpand' needs to be advised (bug#47049).
;;;###autoload
@@ -696,12 +699,9 @@ Useful to hook into pass checkers.")
(memq subr-name native-comp-never-optimize-functions)
(gethash subr-name comp-installed-trampolines-h))
(cl-assert (subr-primitive-p (symbol-function subr-name)))
- (comp--install-trampoline
- subr-name
- (or (comp-trampoline-search subr-name)
- (comp-trampoline-compile subr-name)
- ;; Should never happen.
- (cl-assert nil)))))
+ (when-let ((trampoline (or (comp-trampoline-search subr-name)
+ (comp-trampoline-compile subr-name))))
+ (comp--install-trampoline subr-name trampoline))))
(cl-defstruct (comp-vec (:copier nil))
@@ -3689,7 +3689,8 @@ Prepare every function for final compilation and drive
the C back-end."
(print-circle t)
(print-escape-multibyte t)
(expr `((require 'comp)
- (setf native-comp-verbose ,native-comp-verbose
+ (setf comp-no-spawn t
+ native-comp-verbose ,native-comp-verbose
comp-libgccjit-reproducer ,comp-libgccjit-reproducer
comp-ctxt ,comp-ctxt
native-comp-eln-load-path
',native-comp-eln-load-path
@@ -3927,6 +3928,7 @@ processes from `comp-async-compilations'"
"Start compiling files from `comp-files-queue' asynchronously.
When compilation is finished, run `native-comp-async-all-done-hook' and
display a message."
+ (cl-assert (null comp-no-spawn))
(if (or comp-files-queue
(> (comp-async-runnings) 0))
(unless (>= (comp-async-runnings) (comp-effective-async-max-jobs))
@@ -3945,8 +3947,9 @@ display a message."
(file-newer-than-file-p
source-file (comp-el-to-eln-filename source-file))))
do (let* ((expr `((require 'comp)
- (setq comp-async-compilation t)
- (setq warning-fill-column most-positive-fixnum)
+ (setq comp-async-compilation t
+ comp-no-spawn t
+ warning-fill-column most-positive-fixnum)
,(let ((set (list 'setq)))
(dolist (var '(comp-file-preloaded-p
native-compile-target-directory
@@ -4046,72 +4049,73 @@ the deferred compilation mechanism."
(stringp function-or-file))
(signal 'native-compiler-error
(list "Not a function symbol or file" function-or-file)))
- (catch 'no-native-compile
- (let* ((print-symbols-bare t)
- (data function-or-file)
- (comp-native-compiling t)
- (byte-native-qualities nil)
- (symbols-with-pos-enabled t)
- ;; Have byte compiler signal an error when compilation fails.
- (byte-compile-debug t)
- (comp-ctxt (make-comp-ctxt :output output
- :with-late-load with-late-load)))
- (comp-log "\n \n" 1)
- (unwind-protect
- (progn
- (condition-case err
- (cl-loop
- with report = nil
- for t0 = (current-time)
- for pass in comp-passes
- unless (memq pass comp-disabled-passes)
- do
- (comp-log (format "(%s) Running pass %s:\n"
- function-or-file pass)
- 2)
- (setf data (funcall pass data))
- (push (cons pass (float-time (time-since t0))) report)
- (cl-loop for f in (alist-get pass comp-post-pass-hooks)
- do (funcall f data))
- finally
- (when comp-log-time-report
- (comp-log (format "Done compiling %s" data) 0)
- (cl-loop for (pass . time) in (reverse report)
- do (comp-log (format "Pass %s took: %fs."
- pass time) 0))))
- (native-compiler-skip)
- (t
- (let ((err-val (cdr err)))
- ;; If we are doing an async native compilation print the
- ;; error in the correct format so is parsable and abort.
- (if (and comp-async-compilation
- (not (eq (car err) 'native-compiler-error)))
- (progn
- (message (if err-val
- "%s: Error: %s %s"
- "%s: Error %s")
- function-or-file
- (get (car err) 'error-message)
- (car-safe err-val))
- (kill-emacs -1))
- ;; Otherwise re-signal it adding the compilation input.
- (signal (car err) (if (consp err-val)
- (cons function-or-file err-val)
- (list function-or-file err-val)))))))
- (if (stringp function-or-file)
- data
- ;; So we return the compiled function.
- (native-elisp-load data)))
- ;; We may have created a temporary file when we're being
- ;; called with something other than a file as the argument.
- ;; Delete it.
- (when (and (not (stringp function-or-file))
- (not output)
- comp-ctxt
- (comp-ctxt-output comp-ctxt)
- (file-exists-p (comp-ctxt-output comp-ctxt)))
- (message "Deleting %s" (comp-ctxt-output comp-ctxt))
- (delete-file (comp-ctxt-output comp-ctxt)))))))
+ (when (or (null comp-no-spawn) comp-async-compilation)
+ (catch 'no-native-compile
+ (let* ((print-symbols-bare t)
+ (data function-or-file)
+ (comp-native-compiling t)
+ (byte-native-qualities nil)
+ (symbols-with-pos-enabled t)
+ ;; Have byte compiler signal an error when compilation fails.
+ (byte-compile-debug t)
+ (comp-ctxt (make-comp-ctxt :output output
+ :with-late-load with-late-load)))
+ (comp-log "\n \n" 1)
+ (unwind-protect
+ (progn
+ (condition-case err
+ (cl-loop
+ with report = nil
+ for t0 = (current-time)
+ for pass in comp-passes
+ unless (memq pass comp-disabled-passes)
+ do
+ (comp-log (format "(%s) Running pass %s:\n"
+ function-or-file pass)
+ 2)
+ (setf data (funcall pass data))
+ (push (cons pass (float-time (time-since t0))) report)
+ (cl-loop for f in (alist-get pass comp-post-pass-hooks)
+ do (funcall f data))
+ finally
+ (when comp-log-time-report
+ (comp-log (format "Done compiling %s" data) 0)
+ (cl-loop for (pass . time) in (reverse report)
+ do (comp-log (format "Pass %s took: %fs."
+ pass time) 0))))
+ (native-compiler-skip)
+ (t
+ (let ((err-val (cdr err)))
+ ;; If we are doing an async native compilation print the
+ ;; error in the correct format so is parsable and abort.
+ (if (and comp-async-compilation
+ (not (eq (car err) 'native-compiler-error)))
+ (progn
+ (message (if err-val
+ "%s: Error: %s %s"
+ "%s: Error %s")
+ function-or-file
+ (get (car err) 'error-message)
+ (car-safe err-val))
+ (kill-emacs -1))
+ ;; Otherwise re-signal it adding the compilation input.
+ (signal (car err) (if (consp err-val)
+ (cons function-or-file err-val)
+ (list function-or-file err-val)))))))
+ (if (stringp function-or-file)
+ data
+ ;; So we return the compiled function.
+ (native-elisp-load data)))
+ ;; We may have created a temporary file when we're being
+ ;; called with something other than a file as the argument.
+ ;; Delete it.
+ (when (and (not (stringp function-or-file))
+ (not output)
+ comp-ctxt
+ (comp-ctxt-output comp-ctxt)
+ (file-exists-p (comp-ctxt-output comp-ctxt)))
+ (message "Deleting %s" (comp-ctxt-output comp-ctxt))
+ (delete-file (comp-ctxt-output comp-ctxt))))))))
(defun native-compile-async-skip-p (file load selector)
"Return non-nil if FILE's compilation should be skipped.
@@ -4119,6 +4123,7 @@ the deferred compilation mechanism."
LOAD and SELECTOR work as described in `native--compile-async'."
;; Make sure we are not already compiling `file' (bug#40838).
(or (gethash file comp-async-compilations)
+ (gethash (file-name-with-extension file "elc") comp--no-native-compile)
(cond
((null selector) nil)
((functionp selector) (not (funcall selector file)))
@@ -4166,7 +4171,8 @@ bytecode definition was not changed in the meantime)."
(error "LOAD must be nil, t or 'late"))
(unless (listp files)
(setf files (list files)))
- (let (file-list)
+ (let ((added-something nil)
+ file-list)
(dolist (file-or-dir files)
(cond ((file-directory-p file-or-dir)
(dolist (file (if recursively
@@ -4194,16 +4200,31 @@ bytecode definition was not changed in the meantime)."
(make-directory out-dir t))
(if (file-writable-p out-filename)
(setf comp-files-queue
- (append comp-files-queue `((,file . ,load))))
+ (append comp-files-queue `((,file . ,load)))
+ added-something t)
(display-warning 'comp
(format "No write access for %s skipping."
out-filename)))))))
- (when (zerop (comp-async-runnings))
+ ;; Perhaps nothing passed `native-compile-async-skip-p'?
+ (when (and added-something
+ ;; Don't start if there's one already running.
+ (zerop (comp-async-runnings)))
(comp-run-async-workers))))
;;; Compiler entry points.
+(defun comp-compile-all-trampolines ()
+ "Pre-compile AOT all trampolines."
+ (let ((comp-running-batch-compilation t)
+ ;; We want to target only the 'native-lisp' directory.
+ (native-compile-target-directory
+ (car (last native-comp-eln-load-path))))
+ (mapatoms (lambda (f)
+ (when (subr-primitive-p (symbol-function f))
+ (message "Compiling trampoline for: %s" f)
+ (comp-trampoline-compile f))))))
+
;;;###autoload
(defun comp-lookup-eln (filename)
"Given a Lisp source FILENAME return the corresponding .eln file if found.
@@ -4223,14 +4244,13 @@ Search happens in `native-comp-eln-load-path'."
(defun native-compile (function-or-file &optional output)
"Compile FUNCTION-OR-FILE into native code.
This is the synchronous entry-point for the Emacs Lisp native
-compiler.
-FUNCTION-OR-FILE is a function symbol, a form, or the filename of
-an Emacs Lisp source file.
-If OUTPUT is non-nil, use it as the filename for the compiled
-object.
-If FUNCTION-OR-FILE is a filename, return the filename of the
-compiled object. If FUNCTION-OR-FILE is a function symbol or a
-form, return the compiled function."
+compiler. FUNCTION-OR-FILE is a function symbol, a form, or the
+filename of an Emacs Lisp source file. If OUTPUT is non-nil, use
+it as the filename for the compiled object. If FUNCTION-OR-FILE
+is a filename, if the compilation was successful return the
+filename of the compiled object. If FUNCTION-OR-FILE is a
+function symbol or a form, if the compilation was successful
+return the compiled function."
(comp--native-compile function-or-file nil output))
;;;###autoload
@@ -4317,13 +4337,15 @@ of (commands) to run simultaneously."
;; `invocation-directory'.
(setq dir (expand-file-name dir invocation-directory))
(when (file-exists-p dir)
- (dolist (subdir (directory-files dir t))
+ (dolist (subdir (seq-filter
+ (lambda (f) (not (string-match (rx "/." (? ".") eos)
f)))
+ (directory-files dir t)))
(when (and (file-directory-p subdir)
(file-writable-p subdir)
(not (equal (file-name-nondirectory
(directory-file-name subdir))
comp-native-version-dir)))
- (message "Deleting %s..." subdir)
+ (message "Deleting `%s'..." subdir)
;; We're being overly cautious here -- there shouldn't be
;; anything but .eln files in these directories.
(dolist (eln (directory-files subdir t "\\.eln\\(\\.tmp\\)?\\'"))
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 6fd89a690d..e1801c45b7 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -55,21 +55,24 @@
:group 'extensions)
(defcustom eldoc-idle-delay 0.50
- "Number of seconds of idle time to wait before printing.
+ "Number of seconds of idle time to wait before displaying documentation.
If user input arrives before this interval of time has elapsed after the
-last input, no documentation will be printed.
+last input event, no documentation will be displayed.
-If this variable is set to 0, no idle time is required."
+If this variable is set to 0, display the documentation without any delay."
:type 'number)
(defcustom eldoc-print-after-edit nil
- "If non-nil, eldoc info is only shown when editing.
+ "If non-nil, eldoc info is only shown after editing commands.
Changing the value requires toggling `eldoc-mode'."
:type 'boolean)
(defcustom eldoc-echo-area-display-truncation-message t
"If non-nil, provide verbose help when a message has been truncated.
-If nil, truncated messages will just have \"...\" appended."
+When this is non-nil, and the documentation string was truncated to
+fit in the echo-area, the documentation will be followed by an
+explanation of how to display the full documentation text.
+If nil, truncated messages will just have \"...\" to indicate truncation."
:type 'boolean
:version "28.1")
@@ -93,22 +96,24 @@ Note that this variable has no effect, unless
(defcustom eldoc-echo-area-use-multiline-p 'truncate-sym-name-if-fit
"Allow long ElDoc doc strings to resize echo area display.
-If value is t, never attempt to truncate messages, even if the
-echo area must be resized to fit.
+If the value is t, never attempt to truncate messages, even if the
+echo area must be resized to fit. In that case, Emacs will resize
+the mini-window up to the limit set by `max-mini-window-height'.
If the value is a positive number, it is used to calculate a
-number of logical lines of documentation that ElDoc is allowed to
-put in the echo area. If a positive integer, the number is used
-directly, while a float specifies the number of lines as a
-proportion of the echo area frame's height.
+number of screen lines of documentation that ElDoc is allowed to
+put in the echo area. A positive integer specifies the maximum
+number of lines directly, while a floating-point number specifies
+the number of screen lines as a fraction of the echo area frame's
+height.
-If value is the symbol `truncate-sym-name-if-fit', the part of
+If the value is the symbol `truncate-sym-name-if-fit', the part of
the doc string that represents a symbol's name may be truncated
if it will enable the rest of the doc string to fit on a single
line, without resizing the echo area.
-If value is nil, a doc string is always truncated to fit in a
-single line of display in the echo area.
+If the value is nil, a doc string is always truncated to fit in a
+single screen line of echo-area display.
Any resizing of the echo area additionally respects
`max-mini-window-height'."
@@ -121,12 +126,12 @@ Any resizing of the echo area additionally respects
line" truncate-sym-name-if-fit)))
(defcustom eldoc-echo-area-prefer-doc-buffer nil
- "Prefer ElDoc's documentation buffer if it is showing in some frame.
+ "Prefer ElDoc's documentation buffer if it is displayed in some window.
If this variable's value is t, ElDoc will skip showing
documentation in the echo area if the dedicated documentation
-buffer (given by `eldoc-doc-buffer') is being displayed in some
-window. If the value is the symbol `maybe', then the echo area
-is only skipped if the documentation doesn't fit there."
+buffer (displayed by `eldoc-doc-buffer') is already displayed in
+some window. If the value is the symbol `maybe', then the echo area
+is only skipped if the documentation needs to be truncated there."
:type 'boolean)
(defface eldoc-highlight-function-argument
@@ -287,8 +292,10 @@ reflect the change."
(put 'eldoc-mode-line-string 'risky-local-variable t)
(defun eldoc-minibuffer-message (format-string &rest args)
- "Display messages in the mode-line when in the minibuffer.
-Otherwise work like `message'."
+ "Display message specified by FORMAT-STRING and ARGS on the mode-line as
needed.
+This function displays the message produced by formatting ARGS
+with FORMAT-STRING on the mode line when the current buffer is a minibuffer.
+Otherwise, it displays the message like `message' would."
(if (minibufferp)
(progn
(add-hook 'minibuffer-exit-hook
@@ -632,8 +639,8 @@ If INTERACTIVE is t, also display the buffer."
(when interactive (eldoc-doc-buffer t)))
(defun eldoc-documentation-default ()
- "Show first doc string for item at point.
-Default value for `eldoc-documentation-strategy'."
+ "Show the first non-nil documentation string for item at point.
+This is the default value for `eldoc-documentation-strategy'."
(run-hook-with-args-until-success 'eldoc-documentation-functions
(eldoc--make-callback :patient)))
@@ -651,18 +658,18 @@ else wait for all doc strings."
t)
(defun eldoc-documentation-compose ()
- "Show multiple doc strings at once after waiting for all.
-Meant as a value for `eldoc-documentation-strategy'."
+ "Show multiple documentation strings together after waiting for all of them.
+This is meant to be used as a value for `eldoc-documentation-strategy'."
(eldoc--documentation-compose-1 nil))
(defun eldoc-documentation-compose-eagerly ()
- "Show multiple doc strings at once as soon as possible.
-Meant as a value for `eldoc-documentation-strategy'."
+ "Show multiple documentation strings one by one as soon as possible.
+This is meant to be used as a value for `eldoc-documentation-strategy'."
(eldoc--documentation-compose-1 t))
(defun eldoc-documentation-enthusiast ()
- "Show most important doc string produced so far.
-Meant as a value for `eldoc-documentation-strategy'."
+ "Show most important documentation string produced so far.
+This is meant to be used as a value for `eldoc-documentation-strategy'."
(run-hook-wrapped 'eldoc-documentation-functions
(lambda (f)
(let* ((callback (eldoc--make-callback :enthusiast))
@@ -692,40 +699,42 @@ Meant as a value for `eldoc-documentation-strategy'."
(eldoc--documentation-strategy-defcustom eldoc-documentation-strategy
eldoc-documentation-function
#'eldoc-documentation-default
- "How to collect and organize results of `eldoc-documentation-functions'.
-
-This variable controls how `eldoc-documentation-functions', which
-specifies the sources of documentation, is queried and how its
-results are organized before being displayed to the user. The
-following values are allowed:
-
-- `eldoc-documentation-default': calls functions in the special
- hook in order until one is found that produces a doc string
- value. Display only that value;
-
-- `eldoc-documentation-compose': calls all functions in the
- special hook and displays all of the resulting doc strings
- together. Wait for all strings to be ready, and preserve their
- relative order as specified by the order of functions in the hook;
-
-- `eldoc-documentation-compose-eagerly': calls all functions in
- the special hook and displays as many of the resulting doc
- strings as possible, as soon as possible. Preserves the
- relative order of doc strings;
-
-- `eldoc-documentation-enthusiast': calls all functions in the
- special hook and displays only the most important resulting
- docstring one at any given time. A function appearing first in
- the special hook is considered more important.
-
-This variable can also be set to a function of no args that
-returns something other than a string or nil and allows for some
+ "How to collect and display results of `eldoc-documentation-functions'.
+
+This variable controls how to call the functions in the special hook
+`eldoc-documentation-functions', and how to organize their results
+for display to the user. The functions in `eldoc-documentation-functions'
+are the source of documentation, and act as back-end for ElDoc.
+
+The following values are supported:
+
+- `eldoc-documentation-default': Call functions in the special
+ hook in order, until one of them returns a non-nil string
+ value. Display only that string.
+
+- `eldoc-documentation-compose': Call all the functions in the
+ special hook and display all of the resulting strings together,
+ after all of the functions were called, and in the order of the
+ functions in the hook.
+
+- `eldoc-documentation-compose-eagerly': Call all the functions in
+ the special hook, and display each non-nil string as soon as it
+ is returned by a function, before calling the next function.
+
+- `eldoc-documentation-enthusiast': Call all the functions in the
+ special hook, and display only the most important resulting
+ string at any given time. A function appearing first in
+ the special hook is considered more important than those which
+ appear after it.
+
+This variable can also be set to a function of no arguments that
+returns something other than a string or nil, and allows for some
or all of the special hook `eldoc-documentation-functions' to be
run. In that case, the strategy function should follow that
-other variable's protocol closely and endeavor to display the
-resulting doc strings itself.
+other variable's protocol closely and display the resulting doc
+strings itself.
-For backward compatibility to the \"old\" protocol, this variable
+For backward compatibility with the \"old\" protocol, this variable
can also be set to a function that returns nil or a doc string,
depending whether or not there is documentation to display at
all."
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index a96fa19a3f..11251d7a96 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -445,16 +445,17 @@ The return value is the last VAL in the list.
,v))))))))))
(gv-define-expander plist-get
- (lambda (do plist prop)
+ (lambda (do plist prop &optional predicate)
(macroexp-let2 macroexp-copyable-p key prop
(gv-letplace (getter setter) plist
- (macroexp-let2 nil p `(cdr (plist-member ,getter ,key))
+ (macroexp-let2 nil p `(cdr (plist-member ,getter ,key ,predicate))
(funcall do
`(car ,p)
(lambda (val)
`(if ,p
(setcar ,p ,val)
- ,(funcall setter `(cons ,key (cons ,val
,getter)))))))))))
+ ,(funcall setter
+ `(cons ,key (cons ,val ,getter)))))))))))
;;; Some occasionally handy extensions.
diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el
index a08ac7463c..86c4483030 100644
--- a/lisp/emacs-lisp/icons.el
+++ b/lisp/emacs-lisp/icons.el
@@ -196,18 +196,21 @@ present if the icon is represented by an image."
(image-supported-file-p file)
(propertize
" " 'display
- (if-let ((height (plist-get keywords :height)))
- (create-image file
- nil nil
- :height (if (eq height 'line)
+ (let ((props
+ (append
+ (if-let ((height (plist-get keywords :height)))
+ (list :height (if (eq height 'line)
(window-default-line-height)
- height)
- :scale 1
- :rotation (or (plist-get keywords :rotation) 0)
- :ascent (if (plist-member keywords :ascent)
- (plist-get keywords :ascent)
- 'center))
- (create-image file))))))
+ height)))
+ '(:scale 1)
+ (if-let ((rotation (plist-get keywords :rotation)))
+ (list :rotation rotation))
+ (if-let ((margin (plist-get keywords :margin)))
+ (list :margin margin))
+ (list :ascent (if (plist-member keywords :ascent)
+ (plist-get keywords :ascent)
+ 'center)))))
+ (apply 'create-image file nil nil props))))))
(cl-defmethod icons--create ((_type (eql 'emoji)) icon _keywords)
(when-let ((font (and (display-multi-font-p)
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index 964d23c770..ecc5f7e47b 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -283,6 +283,12 @@ expression, in which case we want to handle forms
differently."
,@(when-let ((safe (plist-get props :safe)))
`((put ',varname 'safe-local-variable ,safe))))))
+ ;; Extract theme properties.
+ ((eq car 'deftheme)
+ (let* ((name (car-safe (cdr-safe form)))
+ (props (nthcdr 3 form)))
+ `(put ',name 'theme-properties (list ,@props))))
+
((eq car 'defgroup)
;; In Emacs this is normally handled separately by cus-dep.el, but for
;; third party packages, it can be convenient to explicitly autoload
@@ -730,7 +736,14 @@ rules for built-in packages and excluded files."
;; updated.
(file-newer-than-file-p
(expand-file-name "emacs-lisp/loaddefs-gen.el" lisp-directory)
- output-file))))
+ output-file)))
+ (let ((lisp-mode-autoload-regexp
+ "^;;;###\\(\\(noexist\\)-\\)?\\(theme-autoload\\)"))
+ (loaddefs-generate
+ (expand-file-name "../etc/themes/" lisp-directory)
+ (expand-file-name "theme-loaddefs.el" lisp-directory))))
+
+;;;###autoload (load "theme-loaddefs.el" t)
(provide 'loaddefs-gen)
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 8c67d7c7a2..8e3b698d37 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -5,7 +5,7 @@
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions, lisp
-;; Version: 3.2.1
+;; Version: 3.3.1
;; Package-Requires: ((emacs "26"))
;; This file is part of GNU Emacs.
@@ -80,48 +80,82 @@ MAP can be an alist, plist, hash-table, or array."
`(pcase-let ((,(map--make-pcase-patterns keys) ,map))
,@body))
-(eval-when-compile
- (defmacro map--dispatch (map-var &rest args)
- "Evaluate one of the forms specified by ARGS based on the type of MAP-VAR.
-
-The following keyword types are meaningful: `:list',
-`:hash-table' and `:array'.
-
-An error is thrown if MAP-VAR is neither a list, hash-table nor array.
-
-Returns the result of evaluating the form associated with MAP-VAR's type."
- (declare (debug t) (indent 1))
- `(cond ((listp ,map-var) ,(plist-get args :list))
- ((hash-table-p ,map-var) ,(plist-get args :hash-table))
- ((arrayp ,map-var) ,(plist-get args :array))
- (t (error "Unsupported map type `%S': %S"
- (type-of ,map-var) ,map-var)))))
-
(define-error 'map-not-inplace "Cannot modify map in-place")
(defsubst map--plist-p (list)
+ "Return non-nil if LIST is the start of a nonempty plist map."
(and (consp list) (atom (car list))))
+(defconst map--plist-has-predicate
+ (condition-case nil
+ (with-no-warnings (plist-get () nil #'eq) t)
+ (wrong-number-of-arguments))
+ "Non-nil means `plist-get' & co. accept a predicate in Emacs 29+.
+Note that support for this predicate in map.el is patchy and
+deprecated.")
+
+(defun map--plist-member-1 (plist prop &optional predicate)
+ "Compatibility shim for the PREDICATE argument of `plist-member'.
+Assumes non-nil PLIST satisfies `map--plist-p'."
+ (if (or (memq predicate '(nil eq)) (null plist))
+ (plist-member plist prop)
+ (let ((tail plist) found)
+ (while (and (not (setq found (funcall predicate (car tail) prop)))
+ (consp (setq tail (cdr tail)))
+ (consp (setq tail (cdr tail)))))
+ (and tail (not found)
+ (signal 'wrong-type-argument `(plistp ,plist)))
+ tail)))
+
+(defalias 'map--plist-member
+ (if map--plist-has-predicate #'plist-member #'map--plist-member-1)
+ "Compatibility shim for `plist-member' in Emacs 29+.
+\n(fn PLIST PROP &optional PREDICATE)")
+
+(defun map--plist-put-1 (plist prop val &optional predicate)
+ "Compatibility shim for the PREDICATE argument of `plist-put'.
+Assumes non-nil PLIST satisfies `map--plist-p'."
+ (if (or (memq predicate '(nil eq)) (null plist))
+ (plist-put plist prop val)
+ (let ((tail plist) prev found)
+ (while (and (consp (cdr tail))
+ (not (setq found (funcall predicate (car tail) prop)))
+ (consp (setq prev tail tail (cddr tail)))))
+ (cond (found (setcar (cdr tail) val))
+ (tail (signal 'wrong-type-argument `(plistp ,plist)))
+ (prev (setcdr (cdr prev) (cons prop (cons val (cddr prev)))))
+ ((setq plist (cons prop (cons val plist)))))
+ plist)))
+
+(defalias 'map--plist-put
+ (if map--plist-has-predicate #'plist-put #'map--plist-put-1)
+ "Compatibility shim for `plist-put' in Emacs 29+.
+\n(fn PLIST PROP VAL &optional PREDICATE)")
+
(cl-defgeneric map-elt (map key &optional default testfn)
"Look up KEY in MAP and return its associated value.
If KEY is not found, return DEFAULT which defaults to nil.
TESTFN is the function to use for comparing keys. It is
deprecated because its default and valid values depend on the MAP
-argument. Generally, alist keys are compared with `equal', plist
-keys with `eq', and hash-table keys with the hash-table's test
+argument, and it was never consistently supported by the map.el
+API. Generally, alist keys are compared with `equal', plist keys
+with `eq', and hash-table keys with the hash-table's test
function.
In the base definition, MAP can be an alist, plist, hash-table,
or array."
(declare
+ ;; `testfn' is deprecated.
+ (advertised-calling-convention (map key &optional default) "27.1")
(gv-expander
(lambda (do)
(gv-letplace (mgetter msetter) `(gv-delay-error ,map)
(macroexp-let2* nil
;; Eval them once and for all in the right order.
((key key) (default default) (testfn testfn))
- (funcall do `(map-elt ,mgetter ,key ,default)
+ (funcall do
+ `(map-elt ,mgetter ,key ,default ,@(and testfn `(,testfn)))
(lambda (v)
(macroexp-let2 nil v v
`(condition-case nil
@@ -132,19 +166,21 @@ or array."
,(funcall msetter
`(map-insert ,mgetter ,key ,v))
;; Always return the value.
- ,v)))))))))
- ;; `testfn' is deprecated.
- (advertised-calling-convention (map key &optional default) "27.1"))
- ;; Can't use `cl-defmethod' with `advertised-calling-convention'.
- (map--dispatch map
- :list (if (map--plist-p map)
- (let ((res (plist-member map key)))
- (if res (cadr res) default))
- (alist-get key map default nil (or testfn #'equal)))
- :hash-table (gethash key map default)
- :array (if (map-contains-key map key)
- (aref map key)
- default)))
+ ,v)))))))))))
+
+(cl-defmethod map-elt ((map list) key &optional default testfn)
+ (if (map--plist-p map)
+ (let ((res (map--plist-member map key testfn)))
+ (if res (cadr res) default))
+ (alist-get key map default nil (or testfn #'equal))))
+
+(cl-defmethod map-elt ((map hash-table) key &optional default _testfn)
+ (gethash key map default))
+
+(cl-defmethod map-elt ((map array) key &optional default _testfn)
+ (if (map-contains-key map key)
+ (aref map key)
+ default))
(defmacro map-put (map key value &optional testfn)
"Associate KEY with VALUE in MAP and return VALUE.
@@ -154,8 +190,12 @@ When MAP is an alist, test equality with TESTFN if non-nil,
otherwise use `equal'.
MAP can be an alist, plist, hash-table, or array."
- (declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead"
"27.1"))
- `(setf (map-elt ,map ,key nil ,testfn) ,value))
+ (declare
+ (obsolete "use `map-put!' or `(setf (map-elt ...) ...)' instead." "27.1"))
+ (if testfn
+ `(with-no-warnings
+ (setf (map-elt ,map ,key nil ,testfn) ,value))
+ `(setf (map-elt ,map ,key) ,value)))
(defun map--plist-delete (map key)
(let ((tail map) last)
@@ -338,15 +378,16 @@ The default implementation delegates to `map-length'."
"Return non-nil if and only if MAP contains KEY.
TESTFN is deprecated. Its default depends on MAP.
The default implementation delegates to `map-some'."
+ (declare (advertised-calling-convention (map key) "27.1"))
(unless testfn (setq testfn #'equal))
(map-some (lambda (k _v) (funcall testfn key k)) map))
(cl-defmethod map-contains-key ((map list) key &optional testfn)
"Return non-nil if MAP contains KEY.
If MAP is an alist, TESTFN defaults to `equal'.
-If MAP is a plist, `plist-member' is used instead."
+If MAP is a plist, TESTFN defaults to `eq'."
(if (map--plist-p map)
- (plist-member map key)
+ (map--plist-member map key testfn)
(let ((v '(nil)))
(not (eq v (alist-get key map v nil (or testfn #'equal)))))))
@@ -459,24 +500,30 @@ This operates by modifying MAP in place.
If it cannot do that, it signals a `map-not-inplace' error.
To insert an element without modifying MAP, use `map-insert'."
;; `testfn' only exists for backward compatibility with `map-put'!
- (declare (advertised-calling-convention (map key value) "27.1"))
- ;; Can't use `cl-defmethod' with `advertised-calling-convention'.
- (map--dispatch
- map
- :list
- (progn
- (if (map--plist-p map)
- (plist-put map key value)
- (let ((oldmap map))
- (setf (alist-get key map key nil (or testfn #'equal)) value)
- (unless (eq oldmap map)
- (signal 'map-not-inplace (list oldmap)))))
- ;; Always return the value.
- value)
- :hash-table (puthash key value map)
- ;; FIXME: If `key' is too large, should we signal `map-not-inplace'
- ;; and let `map-insert' grow the array?
- :array (aset map key value)))
+ (declare (advertised-calling-convention (map key value) "27.1")))
+
+(cl-defmethod map-put! ((map list) key value &optional testfn)
+ (if (map--plist-p map)
+ (map--plist-put map key value testfn)
+ (let ((oldmap map))
+ (setf (alist-get key map key nil (or testfn #'equal)) value)
+ (unless (eq oldmap map)
+ (signal 'map-not-inplace (list oldmap)))))
+ ;; Always return the value.
+ value)
+
+(cl-defmethod map-put! ((map hash-table) key value &optional _testfn)
+ (puthash key value map))
+
+(cl-defmethod map-put! ((map array) key value &optional _testfn)
+ ;; FIXME: If `key' is too large, should we signal `map-not-inplace'
+ ;; and let `map-insert' grow the array?
+ (aset map key value))
+
+;; There shouldn't be old source code referring to `map--put', yet we do
+;; need to keep it for backward compatibility with .elc files where the
+;; expansion of `setf' may call this function.
+(define-obsolete-function-alias 'map--put #'map-put! "27.1")
(cl-defgeneric map-insert (map key value)
"Return a new map like MAP except that it associates KEY with VALUE.
@@ -493,11 +540,6 @@ The default implementation defaults to `map-copy' and
`map-put!'."
(cons key (cons value map))
(cons (cons key value) map)))
-;; There shouldn't be old source code referring to `map--put', yet we do
-;; need to keep it for backward compatibility with .elc files where the
-;; expansion of `setf' may call this function.
-(define-obsolete-function-alias 'map--put #'map-put! "27.1")
-
(cl-defmethod map-apply (function (map list))
(if (map--plist-p map)
(cl-call-next-method)
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
index 56b1ea6ed4..968a80b59e 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -262,12 +262,7 @@ by counted more than once."
(cl-struct-slot-info struct-type)))))
(defun memory-report--format (bytes)
- (setq bytes (/ bytes 1024.0))
- (let ((units '("KiB" "MiB" "GiB" "TiB")))
- (while (>= bytes 1024)
- (setq bytes (/ bytes 1024.0))
- (setq units (cdr units)))
- (format "%6.1f %s" bytes (car units))))
+ (format "%10s" (file-size-human-readable bytes 'iec " ")))
(defun memory-report--gc-elem (elems type)
(* (nth 1 (assq type elems))
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 812e1eb0ff..d619142d64 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -346,21 +346,28 @@ default directory."
(defcustom package-check-signature 'allow-unsigned
"Non-nil means to check package signatures when installing.
-More specifically the value can be:
-- nil: package signatures are ignored.
-- `allow-unsigned': install a package even if it is unsigned, but
- if it is signed, we have the key for it, and OpenGPG is
- installed, verify the signature.
-- t: accept a package only if it comes with at least one verified signature.
-- `all': same as t, except when the package has several signatures,
- in which case we verify all the signatures.
This also applies to the \"archive-contents\" file that lists the
-contents of the archive."
+contents of the archive.
+
+The value can be one of:
+
+ t Accept a package only if it comes with at least
+ one verified signature.
+
+ `all' Same as t, but verify all signatures if there
+ are more than one.
+
+ `allow-unsigned' Install a package even if it is unsigned,
+ but verify the signature if possible (that
+ is, if it is signed, we have the key for it,
+ and GnuPG is installed).
+
+ nil Package signatures are ignored."
:type '(choice (const :value nil :tag "Never")
(const :value allow-unsigned :tag "Allow unsigned")
(const :value t :tag "Check always")
- (const :value all :tag "Check all signatures"))
+ (const :value all :tag "Check always (all
signatures)"))
:risky t
:version "27.1")
@@ -923,7 +930,7 @@ untar into a directory named DIR; otherwise, signal an
error."
(or (string-match regexp name)
;; Tarballs created by some utilities don't list
;; directories with a trailing slash (Bug#13136).
- (and (string-equal dir name)
+ (and (string-equal (expand-file-name dir) name)
(eq (tar-header-link-type tar-data) 5))
(error "Package does not untar cleanly into directory %s/" dir)))))
(tar-untar-buffer))
@@ -1185,8 +1192,12 @@ Return the pkg-desc, with desc-kind set to KIND."
"Find package information for a tar file.
The return result is a `package-desc'."
(cl-assert (derived-mode-p 'tar-mode))
- (let* ((dir-name (file-name-directory
- (tar-header-name (car tar-parse-info))))
+ (let* ((dir-name (named-let loop
+ ((filename (tar-header-name (car tar-parse-info))))
+ (let ((dirname (file-name-directory filename)))
+ ;; The first file can be in a subdir: look for the top.
+ (if dirname (loop (directory-file-name dirname))
+ (file-name-as-directory filename)))))
(desc-file (package--description-file dir-name))
(tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
(unless tar-desc
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 4cfd658e10..dbac03432c 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -897,6 +897,8 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
:eval (seq-drop-while #'numberp '(1 2 c d 5)))
(seq-filter
:eval (seq-filter #'numberp '(a b 3 4 f 6)))
+ (seq-keep
+ :eval (seq-keep #'cl-digit-char-p '(?6 ?a ?7)))
(seq-remove
:eval (seq-remove #'numberp '(1 2 c d 5)))
(seq-remove-at-position
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index 9bdf90bf1d..de8503a1cb 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -353,6 +353,11 @@ This also updates the displayed table."
(let* ((cache (vtable--cache table))
(inhibit-read-only t)
(keymap (get-text-property (point) 'keymap))
+ (ellipsis (if (vtable-ellipsis table)
+ (propertize (truncate-string-ellipsis)
+ 'face (vtable-face table))
+ ""))
+ (ellipsis-width (string-pixel-width ellipsis))
(elem (and after-object
(assq after-object (car cache))))
(line (cons object (vtable--compute-cached-line table object))))
@@ -370,7 +375,8 @@ This also updates the displayed table."
;; FIXME: We have to adjust colors in lines below this if we
;; have :row-colors.
(vtable--insert-line table line 0
- (nth 1 cache) (vtable--spacer table))
+ (nth 1 cache) (vtable--spacer table)
+ ellipsis ellipsis-width)
(add-text-properties start (point) (list 'keymap keymap
'vtable table)))
;; We may have inserted a non-numerical value into a previously
@@ -516,7 +522,8 @@ This also updates the displayed table."
(if (> (nth 1 elem) (elt widths index))
(concat
(vtable--limit-string
- pre-computed (- (elt widths index) ellipsis-width))
+ pre-computed (- (elt widths index)
+ (or ellipsis-width 0)))
ellipsis)
pre-computed))
;; Recompute widths.
@@ -524,7 +531,8 @@ This also updates the displayed table."
(if (> (string-pixel-width value) (elt widths index))
(concat
(vtable--limit-string
- value (- (elt widths index) ellipsis-width))
+ value (- (elt widths index)
+ (or ellipsis-width 0)))
ellipsis)
value))))
(start (point))
diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1
index 0ea7ef09aa..8fc9785430 100644
--- a/lisp/erc/ChangeLog.1
+++ b/lisp/erc/ChangeLog.1
@@ -3779,7 +3779,7 @@
doesn't appear).
* NEWS: Added the information from
- http://emacswiki.org/cgi-bin/wiki/ErcCvsFeatures and the newer
+ https://emacswiki.org/cgi-bin/wiki/ErcCvsFeatures and the newer
changes which weren't yet documented on that page.
2005-01-06 Hoan Ton-That <hoan@ton-that.org>
@@ -8298,7 +8298,7 @@
it doesn't move point to end-of-buffer in non-ERC buffers. Fixed
erc-kill-buffer-function so it doesn't run the erc-kill-server-hook
hooks if the
server connection is closed. Fixed bug 658552, which is described in
detail at
-
http://sourceforge.net/tracker/index.php?func=detail&aid=658552&group_id=30118&atid=398125
+
https://sourceforge.net/tracker/index.php?func=detail&aid=658552&group_id=30118&atid=398125
2002-12-26 Alex Schroeder <alex@gnu.org>
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index bccf0e6f1f..445595e2da 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -248,7 +248,6 @@ specified by `erc-button-alist'."
(save-excursion
(with-syntax-table erc-button-syntax-table
(let ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
(inhibit-field-text-motion t)
(alist erc-button-alist)
regexp)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 20f22c896f..db39e341b2 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2749,8 +2749,7 @@ current session. `active' means the current active buffer
buffer is used. `erc-display-line-1' is used to display STRING.
If STRING is nil, the function does nothing."
- (let ((inhibit-point-motion-hooks t)
- new-bufs)
+ (let (new-bufs)
(dolist (buf (cond
((bufferp buffer) (list buffer))
((listp buffer) buffer)
@@ -6962,6 +6961,8 @@ shortened server name instead."
(defvar tabbar--local-hlf)
+;; FIXME when 29.1 is cut and `format-spec' is added to ELPA Compat,
+;; remove the function invocations from the spec form below.
(defun erc-update-mode-line-buffer (buffer)
"Update the mode line in a single ERC buffer BUFFER."
(with-current-buffer buffer
@@ -7326,7 +7327,7 @@ See also `format-spec'."
(error "No format spec for message %s" msg))
(when (functionp entry)
(setq entry (apply entry args)))
- (format-spec entry (apply #'format-spec-make args))))
+ (format-spec entry (apply #'format-spec-make args) 'ignore)))
;;; Various hook functions
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index e0bcd8b099..06ddda1424 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -90,8 +90,7 @@ This includes when running `eshell-command'."
"Execute a series of Eshell commands in FILE, passing ARGS.
Comments begin with `#'."
(let ((orig (point))
- (here (point-max))
- (inhibit-point-motion-hooks t))
+ (here (point-max)))
(goto-char (point-max))
(with-silent-modifications
;; FIXME: Why not use a temporary buffer and avoid this
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index 6768cee4c3..c52ce31899 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -197,8 +197,7 @@ The options are `begin', `after' or `end'."
(defun eshell-smart-scroll-window (wind _start)
"Scroll the given Eshell window WIND accordingly."
(unless eshell-currently-handling-window
- (let ((inhibit-point-motion-hooks t)
- (eshell-currently-handling-window t))
+ (let ((eshell-currently-handling-window t))
(with-selected-window wind
(eshell-smart-redisplay)))))
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 40b83010f9..4b5e4dd53e 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -372,12 +372,10 @@ Remove the DIRECTORY(ies), if they are empty.")
(setq attr (eshell-file-attributes (car files)))
(file-attribute-inode-number attr-target)
(file-attribute-inode-number attr)
- (equal (file-attribute-inode-number attr-target)
- (file-attribute-inode-number attr))
(file-attribute-device-number attr-target)
(file-attribute-device-number attr)
- (equal (file-attribute-device-number attr-target)
- (file-attribute-device-number attr)))
+ (equal (file-attribute-file-identifier attr-target)
+ (file-attribute-file-identifier attr)))
(eshell-error (format-message "%s: `%s' and `%s' are the same file\n"
command (car files) target)))
(t
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index 576d32b8c5..f87cc2f20a 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -285,8 +285,7 @@ Point is left at the end of the arguments."
(save-restriction
(goto-char beg)
(narrow-to-region beg end)
- (let ((inhibit-point-motion-hooks t)
- (args (list t))
+ (let ((args (list t))
delim)
(with-silent-modifications
(remove-text-properties (point-min) (point-max)
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 413336e3eb..4a41bbe8fa 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -261,9 +261,9 @@ the command."
(defcustom eshell-subcommand-bindings
'((eshell-in-subcommand-p t)
(eshell-in-pipeline-p nil)
- (default-directory default-directory)
- (process-environment (eshell-copy-environment)))
+ (default-directory default-directory))
"A list of `let' bindings for subcommand environments."
+ :version "29.1" ; removed `process-environment'
:type 'sexp
:risky t)
@@ -372,8 +372,7 @@ The value returned is the last form in BODY."
;; Since parsing relies partly on buffer-local state
;; (e.g. that of `eshell-parse-argument-hook'), we need to
;; perform the parsing in the Eshell buffer.
- (let ((begin (point)) end
- (inhibit-point-motion-hooks t))
+ (let ((begin (point)) end)
(with-silent-modifications
(insert reg)
(setq end (point))
@@ -1275,8 +1274,9 @@ be finished later after the completion of an asynchronous
subprocess."
name)
(eshell-search-path name)))))
(if (not program)
- (eshell-error (format "which: no %s in (%s)\n"
- name (getenv "PATH")))
+ (eshell-error (format "which: no %s in (%s)\n"
+ name (string-join (eshell-get-path t)
+ (path-separator))))
(eshell-printn program)))))
(put 'eshell/which 'eshell-no-numeric-conversions t)
diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el
index 98902fc6f2..d513d750d9 100644
--- a/lisp/eshell/esh-ext.el
+++ b/lisp/eshell/esh-ext.el
@@ -77,7 +77,7 @@ but Eshell will be able to understand
(let ((list (eshell-get-path))
suffixes n1 n2 file)
(while list
- (setq n1 (concat (car list) name))
+ (setq n1 (file-name-concat (car list) name))
(setq suffixes eshell-binary-suffixes)
(while suffixes
(setq n2 (concat n1 (car suffixes)))
@@ -239,17 +239,16 @@ causing the user to wonder if anything's really going
on..."
(?h "help" nil nil "display this usage message")
:usage "[-b] PATH
Adds the given PATH to $PATH.")
- (if args
- (progn
- (setq eshell-path-env (getenv "PATH")
- args (mapconcat #'identity args path-separator)
- eshell-path-env
- (if prepend
- (concat args path-separator eshell-path-env)
- (concat eshell-path-env path-separator args)))
- (setenv "PATH" eshell-path-env))
- (dolist (dir (parse-colon-path (getenv "PATH")))
- (eshell-printn dir)))))
+ (let ((path (eshell-get-path t)))
+ (if args
+ (progn
+ (setq path (if prepend
+ (append args path)
+ (append path args)))
+ (eshell-set-path path)
+ (string-join path (path-separator)))
+ (dolist (dir path)
+ (eshell-printn dir))))))
(put 'eshell/addpath 'eshell-no-numeric-conversions t)
(put 'eshell/addpath 'eshell-filename-arguments t)
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index 8f11e6f04a..92523fd99e 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -598,7 +598,6 @@ newline."
;; Note that the input string does not include its terminal newline.
(let ((proc-running-p (and (eshell-head-process)
(not queue-p)))
- (inhibit-point-motion-hooks t)
(inhibit-modification-hooks t))
(unless (and proc-running-p
(not (eq (process-status
@@ -687,7 +686,6 @@ newline."
This is done after all necessary filtering has been done."
(let ((oprocbuf (if process (process-buffer process)
(current-buffer)))
- (inhibit-point-motion-hooks t)
(inhibit-modification-hooks t))
(when (and string oprocbuf (buffer-name oprocbuf))
(with-current-buffer oprocbuf
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 7e005a0fc1..bb928fc5fb 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -277,7 +277,23 @@ Used only on systems which do not support async
subprocesses.")
eshell-delete-exited-processes
delete-exited-processes))
(process-environment (eshell-environment-variables))
+ (coding-system-for-read coding-system-for-read)
+ (coding-system-for-write coding-system-for-write)
proc stderr-proc decoding encoding changed)
+ ;; MS-Windows needs special setting of encoding/decoding, because
+ ;; (a) non-ASCII text in command-line arguments needs to be
+ ;; encoded in the system's codepage; and (b) because many Windows
+ ;; programs will always interpret any non-ASCII input as encoded
+ ;; in the system codepage.
+ (when (eq system-type 'windows-nt)
+ (or coding-system-for-read ; Honor manual decoding settings
+ (setq coding-system-for-read
+ (coding-system-change-eol-conversion locale-coding-system
+ 'dos)))
+ (or coding-system-for-write ; Honor manual encoding settings
+ (setq coding-system-for-write
+ (coding-system-change-eol-conversion locale-coding-system
+ 'unix))))
(cond
((fboundp 'make-process)
(unless (equal (car (aref eshell-current-handles eshell-output-handle))
@@ -325,7 +341,7 @@ Used only on systems which do not support async
subprocesses.")
(setq decoding (coding-system-change-eol-conversion decoding 'dos)
changed t))
;; Even if `make-process' left the coding system for encoding
- ;; data sent from the process undecided, we had better use the
+ ;; data sent to the process undecided, we had better use the
;; same one as what we use for decoding. But, we should
;; suppress EOL conversion.
(if (and decoding (not encoding))
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 9258ca5e40..f47373c115 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -249,17 +249,60 @@ trailing newlines removed. Otherwise, this behaves as
follows:
It might be different from \(getenv \"PATH\"), when
`default-directory' points to a remote host.")
-(defun eshell-get-path ()
+(make-obsolete-variable 'eshell-path-env 'eshell-get-path "29.1")
+
+(defvar-local eshell-path-env-list nil)
+
+(connection-local-set-profile-variables
+ 'eshell-connection-default-profile
+ '((eshell-path-env-list . nil)))
+
+(connection-local-set-profiles
+ '(:application eshell)
+ 'eshell-connection-default-profile)
+
+(defun eshell-get-path (&optional literal-p)
"Return $PATH as a list.
-Add the current directory on MS-Windows."
- (eshell-parse-colon-path
- (if (eshell-under-windows-p)
- (concat "." path-separator eshell-path-env)
- eshell-path-env)))
+If LITERAL-P is nil, return each directory of the path as a full,
+possibly-remote file name; on MS-Windows, add the current
+directory as the first directory in the path as well.
+
+If LITERAL-P is non-nil, return the local part of each directory,
+as the $PATH was actually specified."
+ (with-connection-local-application-variables 'eshell
+ (let ((remote (file-remote-p default-directory))
+ (path
+ (or eshell-path-env-list
+ ;; If not already cached, get the path from
+ ;; `exec-path', removing the last element, which is
+ ;; `exec-directory'.
+ (setq-connection-local eshell-path-env-list
+ (butlast (exec-path))))))
+ (when (and (not literal-p)
+ (not remote)
+ (eshell-under-windows-p))
+ (push "." path))
+ (if (and remote (not literal-p))
+ (mapcar (lambda (x) (file-name-concat remote x)) path)
+ path))))
+
+(defun eshell-set-path (path)
+ "Set the Eshell $PATH to PATH.
+PATH can be either a list of directories or a string of
+directories separated by `path-separator'."
+ (with-connection-local-application-variables 'eshell
+ (setq-connection-local
+ eshell-path-env-list
+ (if (listp path)
+ path
+ ;; Don't use `parse-colon-path' here, since we don't want
+ ;; the additonal translations it does on each element.
+ (split-string path (path-separator))))))
(defun eshell-parse-colon-path (path-env)
"Split string with `parse-colon-path'.
Prepend remote identification of `default-directory', if any."
+ (declare (obsolete nil "29.1"))
(let ((remote (file-remote-p default-directory)))
(if remote
(mapcar
@@ -412,7 +455,7 @@ list."
;; runs while point is in the minibuffer and the users attempt
;; to use completion. Don't ask me.
(condition-case nil
- (sit-for 0 0)
+ (sit-for 0)
(error nil)))
(defun eshell-read-passwd-file (file)
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 36e59cd5a4..57ea42f493 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -113,7 +113,7 @@
(require 'pcomplete)
(require 'ring)
-(defconst eshell-inside-emacs (format "%s,eshell" emacs-version)
+(defvar-local eshell-inside-emacs (format "%s,eshell" emacs-version)
"Value for the `INSIDE_EMACS' environment variable.")
(defgroup eshell-var nil
@@ -156,14 +156,21 @@ if they are quoted with a backslash."
("LINES" ,(lambda () (window-body-height nil 'remap)) t t)
("INSIDE_EMACS" eshell-inside-emacs t)
- ;; for eshell-cmd.el
+ ;; for esh-ext.el
+ ("PATH" (,(lambda () (string-join (eshell-get-path t) (path-separator)))
+ . ,(lambda (_ value)
+ (eshell-set-path value)
+ value))
+ t t)
+
+ ;; for esh-cmd.el
("_" ,(lambda (indices quoted)
(if (not indices)
(car (last eshell-last-arguments))
(eshell-apply-indices eshell-last-arguments
indices quoted))))
- ("?" eshell-last-command-status)
- ("$" eshell-last-command-result)
+ ("?" (eshell-last-command-status . nil))
+ ("$" (eshell-last-command-result . nil))
;; for em-alias.el and em-script.el
("0" eshell-command-name)
@@ -176,7 +183,7 @@ if they are quoted with a backslash."
("7" ,(lambda () (nth 6 eshell-command-arguments)) nil t)
("8" ,(lambda () (nth 7 eshell-command-arguments)) nil t)
("9" ,(lambda () (nth 8 eshell-command-arguments)) nil t)
- ("*" eshell-command-arguments))
+ ("*" (eshell-command-arguments . nil)))
"This list provides aliasing for variable references.
Each member is of the following form:
@@ -186,6 +193,11 @@ NAME defines the name of the variable, VALUE is a Lisp
value used to
compute the string value that will be returned when the variable is
accessed via the syntax `$NAME'.
+If VALUE is a cons (GET . SET), then variable references to NAME
+will use GET to get the value, and SET to set it. GET and SET
+can be one of the forms described below. If SET is nil, the
+variable is read-only.
+
If VALUE is a function, its behavior depends on the value of
SIMPLE-FUNCTION. If SIMPLE-FUNCTION is nil, call VALUE with two
arguments: the list of the indices that were used in the reference,
@@ -193,23 +205,30 @@ and either t or nil depending on whether or not the
variable was
quoted with double quotes. For example, if `NAME' were aliased
to a function, a reference of `$NAME[10][20]' would result in that
function being called with the arguments `((\"10\") (\"20\"))' and
-nil.
-If SIMPLE-FUNCTION is non-nil, call the function with no arguments
-and then pass its return value to `eshell-apply-indices'.
+nil. If SIMPLE-FUNCTION is non-nil, call the function with no
+arguments and then pass its return value to `eshell-apply-indices'.
+
+When VALUE is a function, it's read-only by default. To make it
+writeable, use the (GET . SET) form described above. If SET is a
+function, it takes two arguments: a list of indices (currently
+always nil, but reserved for future enhancement), and the new
+value to set.
-If VALUE is a string, return the value for the variable with that
-name in the current environment. If no variable with that name exists
-in the environment, but if a symbol with that same name exists and has
-a value bound to it, return that symbol's value instead. You can
-prefer symbol values over environment values by setting the value
-of `eshell-prefer-lisp-variables' to t.
+If VALUE is a string, get/set the value for the variable with
+that name in the current environment. When getting the value, if
+no variable with that name exists in the environment, but if a
+symbol with that same name exists and has a value bound to it,
+return that symbol's value instead. You can prefer symbol values
+over environment values by setting the value of
+`eshell-prefer-lisp-variables' to t.
-If VALUE is a symbol, return the value bound to it.
+If VALUE is a symbol, get/set the value bound to it.
If VALUE has any other type, signal an error.
Additionally, if COPY-TO-ENVIRONMENT is non-nil, the alias should be
copied (a.k.a. \"exported\") to the environment of created subprocesses."
+ :version "29.1"
:type '(repeat (list string sexp
(choice (const :tag "Copy to environment" t)
(const :tag "Use only in Eshell" nil))
@@ -234,6 +253,12 @@ copied (a.k.a. \"exported\") to the environment of created
subprocesses."
;; changing a variable will affect all of Emacs.
(unless eshell-modify-global-environment
(setq-local process-environment (eshell-copy-environment)))
+ (setq-local eshell-subcommand-bindings
+ (append
+ '((process-environment (eshell-copy-environment))
+ (eshell-variable-aliases-list eshell-variable-aliases-list)
+ (eshell-path-env-list eshell-path-env-list))
+ eshell-subcommand-bindings))
(setq-local eshell-special-chars-inside-quoting
(append eshell-special-chars-inside-quoting '(?$)))
@@ -282,9 +307,9 @@ copied (a.k.a. \"exported\") to the environment of created
subprocesses."
(while (string-match setvar command)
(nconc
l (list
- (list 'setenv (match-string 1 command)
- (match-string 2 command)
- (= (length (match-string 2 command)) 0))))
+ (list 'eshell-set-variable
+ (match-string 1 command)
+ (match-string 2 command))))
(setq command (eshell-stringify (car args))
args (cdr args)))
(cdr l))
@@ -302,6 +327,11 @@ This function is explicit for adding to
`eshell-parse-argument-hook'."
(defun eshell/define (var-alias definition)
"Define a VAR-ALIAS using DEFINITION."
+ ;; FIXME: This function doesn't work (it produces variable aliases
+ ;; in a form not recognized by other parts of the code), and likely
+ ;; hasn't worked since before its introduction into Emacs. It
+ ;; should either be removed or fixed up.
+ (declare (obsolete nil "29.1"))
(if (not definition)
(setq eshell-variable-aliases-list
(delq (assoc var-alias eshell-variable-aliases-list)
@@ -323,12 +353,11 @@ This function is explicit for adding to
`eshell-parse-argument-hook'."
(defun eshell/export (&rest sets)
"This alias allows the `export' command to act as bash users expect."
- (while sets
- (if (and (stringp (car sets))
- (string-match "^\\([^=]+\\)=\\(.*\\)" (car sets)))
- (setenv (match-string 1 (car sets))
- (match-string 2 (car sets))))
- (setq sets (cdr sets))))
+ (dolist (set sets)
+ (when (and (stringp set)
+ (string-match "^\\([^=]+\\)=\\(.*\\)" set))
+ (eshell-set-variable (match-string 1 set)
+ (match-string 2 set)))))
(defun pcomplete/eshell-mode/export ()
"Completion function for Eshell's `export'."
@@ -338,16 +367,28 @@ This function is explicit for adding to
`eshell-parse-argument-hook'."
(eshell-envvar-names)))))
(defun eshell/unset (&rest args)
- "Unset an environment variable."
- (while args
- (if (stringp (car args))
- (setenv (car args) nil t))
- (setq args (cdr args))))
+ "Unset one or more variables.
+This is equivalent to calling `eshell/set' for all of ARGS with
+the values of nil for each."
+ (dolist (arg args)
+ (eshell-set-variable arg nil)))
(defun pcomplete/eshell-mode/unset ()
"Completion function for Eshell's `unset'."
(while (pcomplete-here (eshell-envvar-names))))
+(defun eshell/set (&rest args)
+ "Allow command-ish use of `set'."
+ (let (last-value)
+ (while args
+ (setq last-value (eshell-set-variable (car args) (cadr args))
+ args (cddr args)))
+ last-value))
+
+(defun pcomplete/eshell-mode/set ()
+ "Completion function for Eshell's `set'."
+ (while (pcomplete-here (eshell-envvar-names))))
+
(defun eshell/setq (&rest args)
"Allow command-ish use of `setq'."
(let (last-value)
@@ -561,18 +602,21 @@ INDICES is a list of index-lists (see
`eshell-parse-indices').
If QUOTED is non-nil, this was invoked inside double-quotes."
(if-let ((alias (assoc name eshell-variable-aliases-list)))
(let ((target (nth 1 alias)))
+ (when (and (not (functionp target))
+ (consp target))
+ (setq target (car target)))
(cond
((functionp target)
(if (nth 3 alias)
(eshell-apply-indices (funcall target) indices quoted)
- (condition-case nil
- (funcall target indices quoted)
- (wrong-number-of-arguments
- (display-warning
- :warning (concat "Function for `eshell-variable-aliases-list' "
- "entry should accept two arguments: INDICES "
- "and QUOTED.'"))
- (funcall target indices)))))
+ (let ((max-arity (cdr (func-arity target))))
+ (if (or (eq max-arity 'many) (>= max-arity 2))
+ (funcall target indices quoted)
+ (display-warning
+ :warning (concat "Function for `eshell-variable-aliases-list'
"
+ "entry should accept two arguments: INDICES "
+ "and QUOTED.'"))
+ (funcall target indices)))))
((symbolp target)
(eshell-apply-indices (symbol-value target) indices quoted))
(t
@@ -589,6 +633,44 @@ If QUOTED is non-nil, this was invoked inside
double-quotes."
(getenv name)))
indices quoted)))
+(defun eshell-set-variable (name value)
+ "Set the variable named NAME to VALUE.
+NAME can be a string (in which case it refers to an environment
+variable or variable alias) or a symbol (in which case it refers
+to a Lisp variable)."
+ (if-let ((alias (assoc name eshell-variable-aliases-list)))
+ (let ((target (nth 1 alias)))
+ (cond
+ ((functionp target)
+ (setq target nil))
+ ((consp target)
+ (setq target (cdr target))))
+ (cond
+ ((functionp target)
+ (funcall target nil value))
+ ((null target)
+ (unless eshell-in-subcommand-p
+ (error "Variable `%s' is not settable" (eshell-stringify name)))
+ (push `(,name ,(lambda () value) t t)
+ eshell-variable-aliases-list)
+ value)
+ ;; Since getting a variable alias with a string target and
+ ;; `eshell-prefer-lisp-variables' non-nil gets the
+ ;; corresponding Lisp variable, make sure setting does the
+ ;; same.
+ ((and eshell-prefer-lisp-variables
+ (stringp target))
+ (eshell-set-variable (intern target) value))
+ (t
+ (eshell-set-variable target value))))
+ (cond
+ ((stringp name)
+ (setenv name value))
+ ((symbolp name)
+ (set name value))
+ (t
+ (error "Unknown variable `%s'" (eshell-stringify name))))))
+
(defun eshell-apply-indices (value indices &optional quoted)
"Apply to VALUE all of the given INDICES, returning the sub-result.
The format of INDICES is:
diff --git a/lisp/files-x.el b/lisp/files-x.el
index da1e44e250..7199db3e44 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -489,7 +489,9 @@ from the MODE alist ignoring the input argument VALUE."
dir-locals-directory-cache))
;; Insert modified alist of directory-local variables.
- (insert ";;; Directory Local Variables\n")
+ ;; When changing this, also update the ".dir-locals.el" file for
+ ;; Emacs itself, as well as the template in autoinsert.el.
+ (insert ";;; Directory Local Variables -*- no-byte-compile: t
-*-\n")
(insert ";;; For more information see (info \"(emacs) Directory
Variables\")\n\n")
(princ (dir-locals-to-string
(sort variables
@@ -618,16 +620,25 @@ PROFILES is a list of connection profiles (symbols)."
:group 'tramp
:version "29.1")
+(defvar connection-local-criteria nil
+ "The current connection-local criteria, or nil.
+This is set while executing the body of
+`with-connection-local-variables'.")
+
+(defvar connection-local-profile-name-for-setq nil
+ "The current connection-local profile name, or nil.
+This is the name of the profile to use when setting variables via
+`setq-connection-local'. Its value is derived from
+`connection-local-criteria' and is set while executing the body
+of `with-connection-local-variables'.")
+
(defsubst connection-local-normalize-criteria (criteria)
"Normalize plist CRITERIA according to properties.
Return a reordered plist."
- (apply
- #'append
- (mapcar
- (lambda (property)
- (when (and (plist-member criteria property) (plist-get criteria
property))
- (list property (plist-get criteria property))))
- '(:application :protocol :user :machine))))
+ (mapcan (lambda (property)
+ (let ((value (plist-get criteria property)))
+ (and value (list property value))))
+ '(:application :protocol :user :machine)))
(defsubst connection-local-get-profiles (criteria)
"Return the connection profiles list for CRITERIA.
@@ -694,6 +705,23 @@ in order."
(customize-set-variable
'connection-local-profile-alist connection-local-profile-alist))
+;;;###autoload
+(defun connection-local-update-profile-variables (profile variables)
+ "Update the variable settings for PROFILE in-place.
+VARIABLES is a list that declares connection-local variables for
+the connection profile. An element in VARIABLES is an alist
+whose elements are of the form (VAR . VALUE).
+
+Unlike `connection-local-set-profile-variables' (which see), this
+function preserves the values of any existing variable
+definitions that aren't listed in VARIABLES."
+ (when-let ((existing-variables
+ (nreverse (connection-local-get-profile-variables profile))))
+ (dolist (var variables)
+ (setf (alist-get (car var) existing-variables) (cdr var)))
+ (setq variables (nreverse existing-variables)))
+ (connection-local-set-profile-variables profile variables))
+
(defun hack-connection-local-variables (criteria)
"Read connection-local variables according to CRITERIA.
Store the connection-local variables in buffer local
@@ -736,6 +764,15 @@ If APPLICATION is nil,
`connection-local-default-application' is used."
:user ,(file-remote-p default-directory 'user)
:machine ,(file-remote-p default-directory 'host))))
+(defun connection-local-profile-name-for-criteria (criteria)
+ "Get a connection-local profile name based on CRITERIA."
+ (when criteria
+ (let (print-level print-length)
+ (intern (concat
+ "autogenerated-connection-local-profile/"
+ (prin1-to-string
+ (connection-local-normalize-criteria criteria)))))))
+
;;;###autoload
(defmacro with-connection-local-variables (&rest body)
"Apply connection-local variables according to `default-directory'.
@@ -743,16 +780,28 @@ Execute BODY, and unwind connection-local variables."
(declare (debug t))
`(with-connection-local-variables-1 (lambda () ,@body)))
+;;;###autoload
+(defmacro with-connection-local-application-variables (application &rest body)
+ "Apply connection-local variables for APPLICATION in `default-directory'.
+Execute BODY, and unwind connection-local variables."
+ (declare (debug t) (indent 1))
+ `(let ((connection-local-default-application ,application))
+ (with-connection-local-variables-1 (lambda () ,@body))))
+
;;;###autoload
(defun with-connection-local-variables-1 (body-fun)
"Apply connection-local variables according to `default-directory'.
Call BODY-FUN with no args, and then unwind connection-local variables."
(if (file-remote-p default-directory)
- (let ((enable-connection-local-variables t)
- (old-buffer-local-variables (buffer-local-variables))
- connection-local-variables-alist)
- (hack-connection-local-variables-apply
- (connection-local-criteria-for-default-directory))
+ (let* ((enable-connection-local-variables t)
+ (connection-local-criteria
+ (connection-local-criteria-for-default-directory))
+ (connection-local-profile-name-for-setq
+ (connection-local-profile-name-for-criteria
+ connection-local-criteria))
+ (old-buffer-local-variables (buffer-local-variables))
+ connection-local-variables-alist)
+ (hack-connection-local-variables-apply connection-local-criteria)
(unwind-protect
(funcall body-fun)
;; Cleanup.
@@ -764,6 +813,49 @@ Call BODY-FUN with no args, and then unwind
connection-local variables."
;; No connection-local variables to apply.
(funcall body-fun)))
+;;;###autoload
+(defmacro setq-connection-local (&rest pairs)
+ "Set each VARIABLE connection-locally to VALUE.
+
+When `connection-local-profile-name-for-setq' is set, assign each
+variable's value on that connection profile, and set that profile
+for `connection-local-criteria'. You can use this in combination
+with `with-connection-local-variables', as in
+
+ (with-connection-local-variables
+ (setq-connection-local VARIABLE VALUE))
+
+If there's no connection-local profile to use, just set the
+variables normally, as with `setq'.
+
+The variables are literal symbols and should not be quoted. The
+second VALUE is not computed until after the first VARIABLE is
+set, and so on; each VALUE can use the new value of variables set
+earlier in the `setq-connection-local'. The return value of the
+`setq-connection-local' form is the value of the last VALUE.
+
+\(fn [VARIABLE VALUE]...)"
+ (declare (debug setq))
+ (unless (zerop (mod (length pairs) 2))
+ (error "PAIRS must have an even number of variable/value members"))
+ (let ((set-expr nil)
+ (profile-vars nil))
+ (while pairs
+ (unless (symbolp (car pairs))
+ (error "Attempting to set a non-symbol: %s" (car pairs)))
+ (push `(set ',(car pairs) ,(cadr pairs)) set-expr)
+ (push `(cons ',(car pairs) ,(car pairs)) profile-vars)
+ (setq pairs (cddr pairs)))
+ `(prog1
+ ,(macroexp-progn (nreverse set-expr))
+ (when connection-local-profile-name-for-setq
+ (connection-local-update-profile-variables
+ connection-local-profile-name-for-setq
+ (list ,@(nreverse profile-vars)))
+ (connection-local-set-profiles
+ connection-local-criteria
+ connection-local-profile-name-for-setq)))))
+
;;;###autoload
(defun path-separator ()
"The connection-local value of `path-separator'."
diff --git a/lisp/files.el b/lisp/files.el
index 43c5d7d1da..3fa0f2f3b8 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -208,9 +208,10 @@ if the file has changed on disk and you have not edited
the buffer."
:group 'find-file)
(defvar-local buffer-file-number nil
- "The device number and file number of the file visited in the current buffer.
-The value is a list of the form (FILENUM DEVNUM).
-This pair of numbers uniquely identifies the file.
+ "The inode number and the device of the file visited in the current buffer.
+The value is a list of the form (INODENUM DEVICE), where DEVICE can be
+either a single number or a cons cell of two numbers.
+This tuple of numbers uniquely identifies the file.
If the buffer is visiting a new file, the value is nil.")
(put 'buffer-file-number 'permanent-local t)
@@ -2163,7 +2164,7 @@ If there is no such live buffer, return nil."
(setq list (cdr list)))
found)
(let* ((attributes (file-attributes truename))
- (number (nthcdr 10 attributes))
+ (number (file-attribute-file-identifier attributes))
(list (buffer-list)) found)
(and buffer-file-numbers-unique
(car-safe number) ;Make sure the inode is not just nil.
@@ -2366,7 +2367,7 @@ the various files."
(let* ((buf (get-file-buffer filename))
(truename (abbreviate-file-name (file-truename filename)))
(attributes (file-attributes truename))
- (number (nthcdr 10 attributes))
+ (number (file-attribute-file-identifier attributes))
;; Find any buffer for a file that has same truename.
(other (and (not buf)
(find-buffer-visiting
@@ -4744,7 +4745,7 @@ the old visited file has been renamed to the new name
FILENAME."
(setq buffer-file-name truename))))
(setq buffer-file-number
(if filename
- (nthcdr 10 (file-attributes buffer-file-name))
+ (file-attribute-file-identifier (file-attributes
buffer-file-name))
nil))
;; write-file-functions is normally used for things like ftp-find-file
;; that visit things that are not local files as if they were files.
@@ -5733,7 +5734,8 @@ Before and after saving the buffer, this function runs
(setq save-buffer-coding-system last-coding-system-used)
(setq buffer-file-coding-system last-coding-system-used))
(setq buffer-file-number
- (nthcdr 10 (file-attributes buffer-file-name)))
+ (file-attribute-file-identifier
+ (file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
(progn
@@ -6344,9 +6346,10 @@ If FILE1 or FILE2 does not exist, the return value is
unspecified."
(equal f1-attr f2-attr))))))
(defun file-in-directory-p (file dir)
- "Return non-nil if FILE is in DIR or a subdirectory of DIR.
-A directory is considered to be \"in\" itself.
-Return nil if DIR is not an existing directory."
+ "Return non-nil if DIR is a parent directory of FILE.
+Value is non-nil if FILE is inside DIR or inside a subdirectory of DIR.
+A directory is considered to be a \"parent\" of itself.
+DIR must be an existing directory, otherwise the function returns nil."
(let ((handler (or (find-file-name-handler file 'file-in-directory-p)
(find-file-name-handler dir 'file-in-directory-p))))
(if handler
@@ -8657,19 +8660,26 @@ It is a nonnegative integer."
(defsubst file-attribute-device-number (attributes)
"The file system device number in ATTRIBUTES returned by `file-attributes'.
-It is an integer."
+It is an integer or a cons cell of integers."
(nth 11 attributes))
+(defsubst file-attribute-file-identifier (attributes)
+ "The inode and device numbers in ATTRIBUTES returned by `file-attributes'.
+The value is a list of the form (INODENUM DEVICE), where DEVICE could be
+either a single number or a cons cell of two numbers.
+This tuple of numbers uniquely identifies the file."
+ (nthcdr 10 attributes))
+
(defun file-attribute-collect (attributes &rest attr-names)
"Return a sublist of ATTRIBUTES returned by `file-attributes'.
ATTR-NAMES are symbols with the selected attribute names.
Valid attribute names are: type, link-number, user-id, group-id,
access-time, modification-time, status-change-time, size, modes,
-inode-number and device-number."
+inode-number, device-number and file-number."
(let ((all '(type link-number user-id group-id access-time
modification-time status-change-time
- size modes inode-number device-number))
+ size modes inode-number device-number file-number))
result)
(while attr-names
(let ((attr (pop attr-names)))
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index b6f4150964..d132de3a32 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -633,16 +633,6 @@ Major/minor modes can set this variable if they know which
option applies.")
;; Font Lock mode.
-(eval-when-compile
- ;;
- ;; We use this to preserve or protect things when modifying text properties.
- (defmacro save-buffer-state (&rest body)
- "Bind variables according to VARLIST and eval BODY restoring buffer state."
- (declare (indent 0) (debug t))
- `(let ((inhibit-point-motion-hooks t))
- (with-silent-modifications
- ,@body))))
-
(defvar-local font-lock-set-defaults nil) ; Whether we have set up defaults.
(defun font-lock-specified-p (mode)
@@ -1002,7 +992,7 @@ This works by calling `font-lock-fontify-region-function'."
(defun font-lock-unfontify-region (beg end)
"Unfontify the text between BEG and END.
This works by calling `font-lock-unfontify-region-function'."
- (save-buffer-state
+ (with-silent-modifications
(funcall font-lock-unfontify-region-function beg end)))
(defvar font-lock-flush-function #'font-lock-after-change-function
@@ -1152,7 +1142,7 @@ Put first the functions more likely to cause a change and
cheaper to compute.")
"Fontify the text between BEG and END.
If LOUDLY is non-nil, print status messages while fontifying.
This function is the default `font-lock-fontify-region-function'."
- (save-buffer-state
+ (with-silent-modifications
;; Use the fontification syntax table, if any.
(with-syntax-table (or font-lock-syntax-table (syntax-table))
;; Extend the region to fontify so that it starts and ends at
@@ -1211,8 +1201,7 @@ This function is the default
`font-lock-unfontify-region-function'."
;; Called when any modification is made to buffer text.
(defun font-lock-after-change-function (beg end &optional old-len)
(save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-quit t)
+ (let ((inhibit-quit t)
(region (if font-lock-extend-after-change-region-function
(funcall font-lock-extend-after-change-region-function
beg end old-len))))
@@ -1307,8 +1296,7 @@ no ARG is given and `font-lock-mark-block-function' is
nil.
If `font-lock-mark-block-function' non-nil and no ARG is given, it is used to
delimit the region to fontify."
(interactive "P")
- (let ((inhibit-point-motion-hooks t)
- deactivate-mark)
+ (let (deactivate-mark)
;; Make sure we have the right `font-lock-keywords' etc.
(if (not font-lock-mode) (font-lock-set-defaults))
(save-mark-and-excursion
diff --git a/lisp/format.el b/lisp/format.el
index 2c368b8f9c..5cd2d4bfb4 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -440,10 +440,9 @@ a list (ABSOLUTE-FILE-NAME SIZE)."
(file-name-nondirectory file)))))
(list file fmt)))
(let (value size old-undo)
- ;; Record only one undo entry for the insertion. Inhibit point-motion and
- ;; modification hooks as with `insert-file-contents'.
- (let ((inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t))
+ ;; Record only one undo entry for the insertion.
+ ;; Inhibit modification hooks as with `insert-file-contents'.
+ (let ((inhibit-modification-hooks t))
;; Don't bind `buffer-undo-list' to t here to assert that
;; `insert-file-contents' may record whether the buffer was unmodified
;; before.
diff --git a/lisp/forms.el b/lisp/forms.el
index fdc44b5214..b97fdbe04c 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -1928,8 +1928,7 @@ after writing out the data."
(let ((i 0)
(here (point))
there
- (cnt 0)
- (inhibit-point-motion-hooks t))
+ (cnt 0))
(if (zerop arg)
(setq cnt 1)
@@ -1955,8 +1954,7 @@ after writing out the data."
(let ((i (length forms--markers))
(here (point))
there
- (cnt 0)
- (inhibit-point-motion-hooks t))
+ (cnt 0))
(if (zerop arg)
(setq cnt 1)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index fbcf801313..3bea1a4c1d 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1765,7 +1765,6 @@ Initialized from `text-mode-syntax-table'.")
`(with-current-buffer gnus-article-buffer
(save-restriction
(let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t)
(case-fold-search t))
(article-narrow-to-head)
,@forms))))
@@ -1852,7 +1851,6 @@ Initialized from `text-mode-syntax-table'.")
(let ((inhibit-read-only t)
(case-fold-search t)
(max (1+ (length gnus-sorted-header-list)))
- (inhibit-point-motion-hooks t)
(cur (current-buffer))
ignored visible beg)
(save-excursion
@@ -1919,8 +1917,7 @@ always hide."
(not gnus-show-all-headers))
(save-excursion
(save-restriction
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t))
+ (let ((inhibit-read-only t))
(article-narrow-to-head)
(dolist (elem gnus-boring-article-headers)
(goto-char (point-min))
@@ -2567,8 +2564,7 @@ fill width."
"Decode all MIME-encoded words in the article."
(interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
- (let ((inhibit-point-motion-hooks t)
- (mail-parse-charset gnus-newsgroup-charset)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(with-current-buffer gnus-summary-buffer
gnus-newsgroup-ignored-charsets)))
@@ -2578,7 +2574,7 @@ fill width."
"Decode charset-encoded text in the article.
If PROMPT (the prefix), prompt for a coding system to use."
(interactive "P" gnus-article-mode)
- (let ((inhibit-point-motion-hooks t) (case-fold-search t)
+ (let ((case-fold-search t)
(inhibit-read-only t)
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
@@ -2620,8 +2616,7 @@ If PROMPT (the prefix), prompt for a coding system to
use."
(defun article-decode-encoded-words ()
"Remove encoded-word encoding from headers."
- (let ((inhibit-point-motion-hooks t)
- (mail-parse-charset gnus-newsgroup-charset)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(save-excursion (condition-case nil
(set-buffer gnus-summary-buffer)
@@ -2668,8 +2663,7 @@ If PROMPT (the prefix), prompt for a coding system to
use."
(defun article-decode-group-name ()
"Decode group names in Newsgroups, Followup-To and Xref headers."
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t)
+ (let ((inhibit-read-only t)
(method (gnus-find-method-for-group gnus-newsgroup-name))
regexp)
(when (and (or gnus-group-name-charset-method-alist
@@ -2699,8 +2693,7 @@ The following headers are decoded: From:, To:, Cc:,
Reply-To:,
Mail-Reply-To: and Mail-Followup-To:."
(when gnus-use-idna
(save-restriction
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
(article-narrow-to-head)
(goto-char (point-min))
(while (re-search-forward "@[^ \t\n\r,>]*\\(xn--[-A-Za-z0-9.]*\\)[
\t\n\r,>]" nil t)
@@ -3171,8 +3164,7 @@ images if any to the browser, and deletes them when
exiting the group
"Remove list identifiers from the Subject header.
The `gnus-list-identifiers' variable specifies what to do."
(interactive nil gnus-article-mode)
- (let ((inhibit-point-motion-hooks t)
- (regexp (gnus-group-get-list-identifiers gnus-newsgroup-name))
+ (let ((regexp (gnus-group-get-list-identifiers gnus-newsgroup-name))
(inhibit-read-only t))
(when regexp
(save-excursion
@@ -3221,34 +3213,32 @@ always hide."
(interactive nil gnus-article-mode)
(save-excursion
(save-restriction
- (let ((inhibit-point-motion-hooks t))
- (when (gnus-parameter-banner gnus-newsgroup-name)
- (article-really-strip-banner
- (gnus-parameter-banner gnus-newsgroup-name)))
- (when gnus-article-address-banner-alist
- ;; Note that the From header is decoded here, so it is
- ;; required that the *-extract-address-components function
- ;; supports non-ASCII text.
- (let ((from (save-restriction
- (widen)
- (article-narrow-to-head)
- (mail-fetch-field "from"))))
- (when (and from
- (setq from
- (cadr (funcall gnus-extract-address-components
- from))))
- (catch 'found
- (dolist (pair gnus-article-address-banner-alist)
- (when (string-match (car pair) from)
- (throw 'found
- (article-really-strip-banner (cdr pair)))))))))))))
+ (when (gnus-parameter-banner gnus-newsgroup-name)
+ (article-really-strip-banner
+ (gnus-parameter-banner gnus-newsgroup-name)))
+ (when gnus-article-address-banner-alist
+ ;; Note that the From header is decoded here, so it is
+ ;; required that the *-extract-address-components function
+ ;; supports non-ASCII text.
+ (let ((from (save-restriction
+ (widen)
+ (article-narrow-to-head)
+ (mail-fetch-field "from"))))
+ (when (and from
+ (setq from
+ (cadr (funcall gnus-extract-address-components
+ from))))
+ (catch 'found
+ (dolist (pair gnus-article-address-banner-alist)
+ (when (string-match (car pair) from)
+ (throw 'found
+ (article-really-strip-banner (cdr pair))))))))))))
(defun article-really-strip-banner (banner)
"Strip the banner specified by the argument."
(save-excursion
(save-restriction
- (let ((inhibit-point-motion-hooks t)
- (gnus-signature-limit nil)
+ (let ((gnus-signature-limit nil)
(inhibit-read-only t))
(article-goto-body)
(cond
@@ -3307,8 +3297,7 @@ always hide."
"Remove all blank lines from the beginning of the article."
(interactive nil gnus-article-mode)
(save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
(when (article-goto-body)
(while (and (not (eobp))
(looking-at "[ \t]*$"))
@@ -3349,8 +3338,7 @@ Point is left at the beginning of the narrowed-to region."
"Replace consecutive blank lines with one empty line."
(interactive nil gnus-article-mode)
(save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
;; First make all blank lines empty.
(article-goto-body)
(while (re-search-forward "^[ \t]+$" nil t)
@@ -3368,8 +3356,7 @@ Point is left at the beginning of the narrowed-to region."
"Remove all white space from the beginning of the lines in the article."
(interactive nil gnus-article-mode)
(save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
(article-goto-body)
(while (re-search-forward "^[ \t]+" nil t)
(replace-match "" t t)))))
@@ -3378,8 +3365,7 @@ Point is left at the beginning of the narrowed-to region."
"Remove all white space from the end of the lines in the article."
(interactive nil gnus-article-mode)
(save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
(article-goto-body)
(while (re-search-forward "[ \t]+$" nil t)
(replace-match "" t t)))))
@@ -3395,37 +3381,35 @@ Point is left at the beginning of the narrowed-to
region."
"Strip all blank lines."
(interactive nil gnus-article-mode)
(save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
(article-goto-body)
(while (re-search-forward "^[ \t]*\n" nil t)
(replace-match "" t t)))))
(defun gnus-article-narrow-to-signature ()
"Narrow to the signature; return t if a signature is found, else nil."
- (let ((inhibit-point-motion-hooks t))
- (when (gnus-article-search-signature)
- (forward-line 1)
- ;; Check whether we have some limits to what we consider
- ;; to be a signature.
- (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
- (list gnus-signature-limit)))
- limit limited)
- (while (setq limit (pop limits))
- (if (or (and (integerp limit)
- (< (- (point-max) (point)) limit))
- (and (floatp limit)
- (< (count-lines (point) (point-max)) limit))
- (and (functionp limit)
- (funcall limit))
- (and (stringp limit)
- (not (re-search-forward limit nil t))))
- () ; This limit did not succeed.
- (setq limited t
- limits nil)))
- (unless limited
- (narrow-to-region (point) (point-max))
- t)))))
+ (when (gnus-article-search-signature)
+ (forward-line 1)
+ ;; Check whether we have some limits to what we consider
+ ;; to be a signature.
+ (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
+ (list gnus-signature-limit)))
+ limit limited)
+ (while (setq limit (pop limits))
+ (if (or (and (integerp limit)
+ (< (- (point-max) (point)) limit))
+ (and (floatp limit)
+ (< (count-lines (point) (point-max)) limit))
+ (and (functionp limit)
+ (funcall limit))
+ (and (stringp limit)
+ (not (re-search-forward limit nil t))))
+ () ; This limit did not succeed.
+ (setq limited t
+ limits nil)))
+ (unless limited
+ (narrow-to-region (point) (point-max))
+ t))))
(defun gnus-article-search-signature ()
"Search the current buffer for the signature separator.
@@ -3485,8 +3469,7 @@ means show, 0 means toggle."
(defun gnus-article-show-hidden-text (type &optional _dummy)
"Show all hidden text of type TYPE.
Originally it is hide instead of DUMMY."
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t))
+ (let ((inhibit-read-only t))
(gnus-remove-text-properties-when
'article-type type
(point-min) (point-max)
@@ -3528,7 +3511,6 @@ possible values."
(interactive (list 'ut t) gnus-article-mode)
(let* ((case-fold-search t)
(inhibit-read-only t)
- (inhibit-point-motion-hooks t)
(visible-date (mail-fetch-field "Date"))
pos date bface eface)
(save-excursion
@@ -4351,8 +4333,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(insert-buffer-substring gnus-original-article-buffer)
(setq items (split-string sig))
(message-narrow-to-head)
- (let ((inhibit-point-motion-hooks t)
- (case-fold-search t))
+ (let ((case-fold-search t))
;; Don't verify multiple headers.
(setq headers (mapconcat (lambda (header)
(concat header ": "
@@ -6811,16 +6792,15 @@ not have a face in `gnus-article-boring-faces'."
(boundp 'gnus-article-boring-faces)
(symbol-value 'gnus-article-boring-faces))
(save-excursion
- (let ((inhibit-point-motion-hooks t))
- (catch 'only-boring
- (while (re-search-forward "\\b\\w\\w" nil t)
- (forward-char -1)
- (when (not (seq-intersection
- (gnus-faces-at (point))
- (symbol-value 'gnus-article-boring-faces)
- #'eq))
- (throw 'only-boring nil)))
- (throw 'only-boring t))))))
+ (catch 'only-boring
+ (while (re-search-forward "\\b\\w\\w" nil t)
+ (forward-char -1)
+ (when (not (seq-intersection
+ (gnus-faces-at (point))
+ (symbol-value 'gnus-article-boring-faces)
+ #'eq))
+ (throw 'only-boring nil)))
+ (throw 'only-boring t)))))
(defun gnus-article-refer-article ()
"Read article specified by message-id around point."
@@ -8112,18 +8092,17 @@ It does this by highlighting everything after
`gnus-signature-separator' using the face `gnus-signature'."
(interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
- (let ((inhibit-point-motion-hooks t))
- (save-restriction
- (when (and gnus-signature-face
- (gnus-article-narrow-to-signature))
- (overlay-put (make-overlay (point-min) (point-max) nil t)
- 'face gnus-signature-face)
- (widen)
- (gnus-article-search-signature)
- (let ((start (match-beginning 0))
- (end (set-marker (make-marker) (1+ (match-end 0)))))
- (gnus-article-add-button start (1- end) 'gnus-signature-toggle
- end)))))))
+ (save-restriction
+ (when (and gnus-signature-face
+ (gnus-article-narrow-to-signature))
+ (overlay-put (make-overlay (point-min) (point-max) nil t)
+ 'face gnus-signature-face)
+ (widen)
+ (gnus-article-search-signature)
+ (let ((start (match-beginning 0))
+ (end (set-marker (make-marker) (1+ (match-end 0)))))
+ (gnus-article-add-button start (1- end) 'gnus-signature-toggle
+ end))))))
(defun gnus-button-in-region-p (b e prop)
"Say whether PROP exists in the region."
@@ -8135,8 +8114,7 @@ It does this by highlighting everything after
specified by `gnus-button-alist'."
(interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
- (let ((inhibit-point-motion-hooks t)
- (case-fold-search t)
+ (let ((case-fold-search t)
(alist gnus-button-alist)
beg entry regexp)
;; We skip the headers.
@@ -8292,19 +8270,18 @@ url is put as the `gnus-button-url' overlay property on
the button."
(defun gnus-signature-toggle (end)
(gnus-with-article-buffer
- (let ((inhibit-point-motion-hooks t))
- (if (text-property-any end (point-max) 'article-type 'signature)
- (progn
- (gnus-delete-wash-type 'signature)
- (gnus-remove-text-properties-when
- 'article-type 'signature end (point-max)
- (cons 'article-type (cons 'signature
- gnus-hidden-properties))))
- (gnus-add-wash-type 'signature)
- (gnus-add-text-properties-when
- 'article-type nil end (point-max)
- (cons 'article-type (cons 'signature
- gnus-hidden-properties)))))
+ (if (text-property-any end (point-max) 'article-type 'signature)
+ (progn
+ (gnus-delete-wash-type 'signature)
+ (gnus-remove-text-properties-when
+ 'article-type 'signature end (point-max)
+ (cons 'article-type (cons 'signature
+ gnus-hidden-properties))))
+ (gnus-add-wash-type 'signature)
+ (gnus-add-text-properties-when
+ 'article-type nil end (point-max)
+ (cons 'article-type (cons 'signature
+ gnus-hidden-properties))))
(let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
(gnus-set-mode-line 'article))))
@@ -8313,8 +8290,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
(save-excursion
(let* ((marker (car marker-and-entry))
(entry (cadr marker-and-entry))
- (regexp (car entry))
- (inhibit-point-motion-hooks t))
+ (regexp (car entry)))
(goto-char marker)
;; This is obviously true, or something bad is happening :)
;; But we need it to have the match-data
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index b4d7661d74..e344b071bf 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -341,7 +341,6 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
(let ((buffer-read-only nil)
(alist gnus-cite-prefix-alist)
(faces gnus-cite-face-list)
- (inhibit-point-motion-hooks t)
face entry prefix skip numbers number face-alist)
;; Loop through citation prefixes.
(while alist
@@ -462,7 +461,6 @@ text (i.e., computer code and the like) will not be folded."
(interactive "P" gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(let ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
(marks (gnus-dissect-cited-text))
(adaptive-fill-mode nil)
(fill-column (if width (prefix-numeric-value width) fill-column)))
@@ -536,7 +534,6 @@ always hide."
(with-current-buffer gnus-article-buffer
(let ((buffer-read-only nil)
marks
- (inhibit-point-motion-hooks t)
(props (nconc (list 'article-type 'cite)
gnus-hidden-properties))
(point (point-min))
@@ -613,7 +610,6 @@ means show, nil means toggle."
(start (cadr args))
(hidden
(text-property-any beg (1- end) 'article-type 'cite))
- (inhibit-point-motion-hooks t)
buffer-read-only)
(when (or (null arg)
(zerop arg)
@@ -673,7 +669,6 @@ See also the documentation for
`gnus-article-highlight-citation'."
(let ((start (point))
(atts gnus-cite-attribution-alist)
(buffer-read-only nil)
- (inhibit-point-motion-hooks t)
(hidden 0)
total)
(goto-char (point-max))
@@ -731,13 +726,12 @@ See also the documentation for
`gnus-article-highlight-citation'."
(defun gnus-cite-parse-wrapper ()
;; Wrap chopped gnus-cite-parse.
(article-goto-body)
- (let ((inhibit-point-motion-hooks t))
- (save-excursion
- (gnus-cite-parse-attributions))
- (save-excursion
- (gnus-cite-parse))
- (save-excursion
- (gnus-cite-connect-attributions))))
+ (save-excursion
+ (gnus-cite-parse-attributions))
+ (save-excursion
+ (gnus-cite-parse))
+ (save-excursion
+ (gnus-cite-connect-attributions)))
(defun gnus-cite-parse ()
;; Parse and connect citation prefixes and attribution lines.
@@ -1020,8 +1014,7 @@ See also the documentation for
`gnus-article-highlight-citation'."
(defun gnus-cite-add-face (number prefix face)
;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
(when face
- (let ((inhibit-point-motion-hooks t)
- from to overlay)
+ (let (from to overlay)
(goto-char (point-min))
(when (zerop (forward-line (1- number)))
(forward-char (length prefix))
@@ -1041,7 +1034,6 @@ See also the documentation for
`gnus-article-highlight-citation'."
(gnus-cite-parse-maybe nil t)
(let ((buffer-read-only nil)
(numbers (cdr (assoc prefix gnus-cite-prefix-alist)))
- (inhibit-point-motion-hooks t)
number)
(while numbers
(setq number (car numbers)
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index d64e000d70..93b18f9555 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -87,7 +87,6 @@ callback for `gravatar-retrieve'."
(let ((real-name (car address))
(mail-address (cadr address))
(mark (point-marker))
- (inhibit-point-motion-hooks t)
(case-fold-search t))
(save-restriction
(article-narrow-to-head)
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 35103e9c4f..e69f0857e7 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -2651,6 +2651,7 @@ If EXCLUDE-GROUP, do not go to that group."
(and best-point (gnus-group-group-name))))
;; Is there something like an after-point-motion-hook?
+;; FIXME: There's `cursor-sensor-mode's `cursor-sensor-functions' property.
;; (inhibit-point-motion-hooks?). Is there a tool-bar-update function?
;; (defun gnus-group-menu-bar-update ()
diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el
index 9872f7b994..da1afb672a 100644
--- a/lisp/gnus/gnus-rfc1843.el
+++ b/lisp/gnus/gnus-rfc1843.el
@@ -40,8 +40,7 @@
(save-excursion
(save-restriction
(message-narrow-to-head)
- (let* ((inhibit-point-motion-hooks t)
- (case-fold-search t)
+ (let* ((case-fold-search t)
(ct (message-fetch-field "Content-Type" t))
(ctl (and ct (mail-header-parse-content-type ct))))
(if (and ctl (not (string-search "/" (car ctl))))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 107ad8fd4a..18ba55a439 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9856,7 +9856,6 @@ If ARG is a negative number, hide the unwanted header
lines."
(widen)
(article-narrow-to-head)
(let* ((inhibit-read-only t)
- (inhibit-point-motion-hooks t)
(hidden (if (numberp arg)
(>= arg 0)
(or
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index fe556b155a..95c9539593 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -166,9 +166,8 @@ is slower."
(require 'message)
(save-excursion
(save-restriction
- (let ((inhibit-point-motion-hooks t))
- (nnheader-narrow-to-headers)
- (message-fetch-field field)))))
+ (nnheader-narrow-to-headers)
+ (message-fetch-field field))))
(defun gnus-fetch-original-field (field)
"Fetch FIELD from the original version of the current article."
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index beccef6f5f..a714e31876 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -2172,8 +2172,7 @@ If FIRST is non-nil, only the first value is returned.
The buffer is expected to be narrowed to just the header of the message;
see `message-narrow-to-headers-or-head'."
- (let* ((inhibit-point-motion-hooks t)
- (value (mail-fetch-field header nil (not first))))
+ (let* ((value (mail-fetch-field header nil (not first))))
(when value
(while (string-match "\n[\t ]+" value)
(setq value (replace-match " " t t value)))
@@ -4362,10 +4361,10 @@ arguments. If METHOD is nil in this case, the return
value of
the function will be inserted instead.
If the buffer already has a\"X-Message-SMTP-Method\" header,
it is left unchanged."
- :type '(alist :key-type '(choice
- (string :tag "From Address")
- (function :tag "Predicate"))
- :value-type 'string)
+ :type '(alist :key-type (choice
+ (string :tag "From Address")
+ (function :tag "Predicate"))
+ :value-type string)
:version "29.1"
:group 'message-sending)
@@ -5193,10 +5192,7 @@ command evaluates `message-send-mail-hook' just before
sending a message."
(defun message-canlock-generate ()
"Return a string that is non-trivial to guess.
Do not use this for anything important, it is cryptographically weak."
- (sha1 (concat (message-unique-id)
- (format "%x%x%x" (random) (random) (random))
- (prin1-to-string (recent-keys))
- (prin1-to-string (garbage-collect)))))
+ (secure-hash 'sha1 'iv-auto 128))
(defvar canlock-password)
(defvar canlock-password-for-verify)
@@ -7309,7 +7305,6 @@ specified by FUNCTIONS, if non-nil, or by the variable
(let ((cur (current-buffer))
from subject date
references message-id follow-to
- (inhibit-point-motion-hooks t)
(message-this-is-mail t)
gnus-warning)
(save-restriction
@@ -7370,7 +7365,6 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
(let ((cur (current-buffer))
from subject date reply-to mrt mct
references message-id follow-to
- (inhibit-point-motion-hooks t)
(message-this-is-news t)
followup-to distribution newsgroups gnus-warning posted-to)
(save-restriction
@@ -8609,7 +8603,6 @@ From headers in the original article."
(let ((regexps (if (stringp message-hidden-headers)
(list message-hidden-headers)
message-hidden-headers))
- (inhibit-point-motion-hooks t)
(inhibit-modification-hooks t)
end-of-headers)
(when regexps
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 8646998deb..8d31470634 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -194,7 +194,7 @@ This can be either \"inline\" or \"attachment\".")
nil)
(verbatim-marks
;; slrn-style verbatim marks, see
- ;;
http://slrn.sourceforge.net/docs/slrn-manual-6.html#process_verbatim_marks
+ ;;
https://slrn.sourceforge.net/docs/slrn-manual-6.html#process_verbatim_marks
"^#v\\+"
"^#v\\-$"
,(lambda () (mm-uu-verbatim-marks-extract 0 0))
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index cdff7c9acc..378ada6247 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -23,7 +23,7 @@
;;; Commentary:
-;; For Outlook mail boxes format, see http://mbx2mbox.sourceforge.net/
+;; For Outlook mail boxes format, see https://mbx2mbox.sourceforge.net/
;;; Code:
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index eef895ae88..e29f763dab 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -669,7 +669,7 @@ the C sources, too."
"Insert usage at point and return docstring. With highlighting."
(if (keymapp function)
doc ; If definition is a keymap, skip arglist note.
- (let* ((advertised (gethash real-def advertised-signature-table t))
+ (let* ((advertised (get-advertised-calling-convention real-def))
(arglist (if (listp advertised)
advertised (help-function-arglist real-def)))
(usage (help-split-fundoc doc function)))
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 91c2a80400..cf024afe25 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -147,16 +147,16 @@ and then returns."
(while (or (memq char (append help-event-list
(cons help-char '( ?? ?\C-v ?\s
?\177 ?\M-v ?\S-\s
deletechar
backspace vertical-scroll-bar
- next prior
up down))))
+ home end
next prior up down))))
(eq (car-safe char) 'switch-frame)
(equal key "\M-v"))
(condition-case nil
(cond
((eq (car-safe char) 'switch-frame)
(handle-switch-frame char))
- ((memq char '(?\C-v ?\s next))
+ ((memq char '(?\C-v ?\s next end))
(scroll-up))
- ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar
backspace prior))
+ ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar
backspace prior home))
(equal key "\M-v"))
(scroll-down))
((memq char '(down))
@@ -210,7 +210,11 @@ and then returns."
(unless (eq new-frame (selected-frame))
(iconify-frame new-frame))
(setq new-frame nil)))
- (ding)))))
+ (unless (equal (key-description key) "C-g")
+ (message (substitute-command-keys
+ (format "No help command is bound to `\\`%s''"
+ (key-description key))))
+ (ding))))))
(when config
(set-window-configuration config))
(when new-frame
diff --git a/lisp/help.el b/lisp/help.el
index b4b9120da3..d48b866938 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -112,7 +112,7 @@ buffer.")
(define-key map "v" 'describe-variable)
(define-key map "w" 'where-is)
(define-key map "x" 'describe-command)
- (define-key map "q" 'help-quit)
+ (define-key map "q" 'help-quit-or-quick)
map)
"Keymap for characters following the Help key.")
@@ -125,11 +125,146 @@ buffer.")
(defvar help-button-cache nil)
+
+(defvar help-quick-sections
+ '(("File"
+ (save-buffers-kill-terminal . "exit")
+ (find-file . "find")
+ (write-file . "write")
+ (save-buffer . "save")
+ (save-some-buffers . "all"))
+ ("Buffer"
+ (kill-buffer . "kill")
+ (list-buffers . "list")
+ (switch-to-buffer . "switch")
+ (goto-line . "goto line")
+ (read-only-mode . "read only"))
+ ("Window"
+ (delete-window . "only other")
+ (delete-other-windows . "only this")
+ (split-window-below . "split vert.")
+ (split-window-right . "split horiz.")
+ (other-window . "other window"))
+ ("Mark & Kill"
+ (set-mark-command . "mark")
+ (kill-line . "kill line")
+ (kill-ring-save . "kill region")
+ (yank . "yank")
+ (exchange-point-and-mark . "swap"))
+ ("Projects"
+ (project-switch-project . "switch")
+ (project-find-file . "find file")
+ (project-find-regexp . "search")
+ (project-query-replace-regexp . "search & replace")
+ (project-compile . "compile"))
+ ("Misc."
+ (undo . "undo")
+ (isearch-forward . "search")
+ (isearch-backward . "reverse search")
+ (query-replace . "search & replace")
+ (fill-paragraph . "reformat"))))
+
+(declare-function prop-match-value "text-property-search" (match))
+
+;; Inspired by a mg fork (https://github.com/troglobit/mg)
+(defun help-quick ()
+ "Display a quick-help buffer."
+ (interactive)
+ (with-current-buffer (get-buffer-create "*Quick Help*")
+ (let ((inhibit-read-only t) (padding 2) blocks)
+
+ ;; Go through every section and prepare a text-rectangle to be
+ ;; inserted later.
+ (dolist (section help-quick-sections)
+ (let ((max-key-len 0) (max-cmd-len 0) keys)
+ (dolist (ent (reverse (cdr section)))
+ (catch 'skip
+ (let* ((bind (where-is-internal (car ent) nil t))
+ (key (if bind
+ (propertize
+ (key-description bind)
+ 'face 'help-key-binding)
+ (throw 'skip nil))))
+ (setq max-cmd-len (max (length (cdr ent)) max-cmd-len)
+ max-key-len (max (length key) max-key-len))
+ (push (list key (cdr ent) (car ent)) keys))))
+ (when keys
+ (let ((fmt (format "%%-%ds %%-%ds%s" max-key-len max-cmd-len
+ (make-string padding ?\s)))
+ (width (+ max-key-len 1 max-cmd-len padding)))
+ (push `(,width
+ ,(propertize
+ (concat
+ (car section)
+ (make-string (- width (length (car section))) ?\s))
+ 'face 'bold)
+ ,@(mapcar (lambda (ent)
+ (format fmt
+ (propertize
+ (car ent)
+ 'quick-help-cmd
+ (caddr ent))
+ (cadr ent)))
+ keys))
+ blocks)))))
+
+ ;; Insert each rectangle in order until they don't fit into the
+ ;; frame any more, in which case the next sections are inserted
+ ;; in a new "line".
+ (erase-buffer)
+ (dolist (block (nreverse blocks))
+ (when (> (+ (car block) (current-column)) (frame-width))
+ (goto-char (point-max))
+ (newline 2))
+ (save-excursion
+ (insert-rectangle (cdr block)))
+ (end-of-line))
+ (delete-trailing-whitespace)
+
+ (save-excursion
+ (goto-char (point-min))
+ (while-let ((match (text-property-search-forward 'quick-help-cmd)))
+ (make-text-button (prop-match-beginning match)
+ (prop-match-end match)
+ 'mouse-face 'highlight
+ 'button t
+ 'keymap button-map
+ 'action #'describe-symbol
+ 'button-data (prop-match-value match)))))
+
+ (help-mode)
+
+ ;; Display the buffer at the bottom of the frame...
+ (with-selected-window (display-buffer-at-bottom (current-buffer) '())
+ ;; ... mark it as dedicated to prevent focus from being stolen
+ (set-window-dedicated-p (selected-window) t)
+ ;; ... and shrink it immediately.
+ (fit-window-to-buffer))
+ (message
+ (substitute-command-keys "Toggle the quick help buffer using
\\[help-quit-or-quick]."))))
+
+(defalias 'cheat-sheet #'help-quick)
+
(defun help-quit ()
"Just exit from the Help command's command loop."
(interactive)
nil)
+(defun help-quit-or-quick ()
+ "Call `help-quit' or `help-quick' depending on the context."
+ (interactive)
+ (cond
+ (help-buffer-under-preparation
+ ;; FIXME: There should be a better way to detect if we are in the
+ ;; help command loop.
+ (help-quit))
+ ((and-let* ((window (get-buffer-window "*Quick Help*")))
+ (quit-window t window)
+ ;; Clear the message we may have gotten from `C-h' and then
+ ;; waiting before hitting `q'.
+ (message "")))
+ ((help-quick))))
+
(defvar help-return-method nil
"What to do to \"exit\" the help buffer.
This is a list
@@ -279,6 +414,7 @@ Do not call this in the scope of `with-help-window'."
("describe-package" "Describe a specific Emacs package")
""
("help-with-tutorial" "Start the Emacs tutorial")
+ ("help-quick-or-quit" "Display the quick help buffer.")
("view-echo-area-messages"
"Show recent messages (from echo area)")
("view-lossage" ,(format "Show last %d input keystrokes (lossage)"
@@ -608,7 +744,8 @@ or a buffer name."
(setq-local outline-heading-end-regexp ":\n")
(setq-local outline-level (lambda () 1))
(setq-local outline-minor-mode-cycle t
- outline-minor-mode-highlight t)
+ outline-minor-mode-highlight t
+ outline-minor-mode-use-buttons 'insert)
(outline-minor-mode 1)
(save-excursion
(goto-char (point-min))
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index 693c94eea8..87bea1017f 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -156,7 +156,8 @@ line about point in the selected window only."
:group 'hl-line
;; If the global mode is switched on, then `M-x hl-line-mode' should
;; switch the mode off in this buffer.
- (when global-hl-line-mode
+ (when (and global-hl-line-mode
+ (eq arg 'toggle))
(setq hl-line-mode nil)
(setq-local global-hl-line-mode nil)
(global-hl-line-unhighlight))
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index b1fdbd2c4a..34092b1417 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1539,33 +1539,13 @@ See also `hfy-html-enkludge-buffer'."
(if (get-text-property (match-beginning 0) 'hfy-quoteme)
(replace-match (hfy-html-quote (match-string 1))) )) ))
-;; Borrowed from font-lock.el
-(defmacro hfy-save-buffer-state (varlist &rest body)
- "Bind variables according to VARLIST and eval BODY restoring buffer state.
-Do not record undo information during evaluation of BODY."
- (declare (indent 1) (debug let))
- (let ((modified (make-symbol "modified")))
- `(let* ,(append varlist
- `((,modified (buffer-modified-p))
- (buffer-undo-list t)
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- deactivate-mark
- buffer-file-name
- buffer-file-truename))
- (progn
- ,@body)
- (unless ,modified
- (restore-buffer-modified-p nil)))))
-
(defun hfy-mark-trailing-whitespace ()
"Tag trailing whitespace with a hfy property if it is currently highlighted."
(when show-trailing-whitespace
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
- (hfy-save-buffer-state nil
+ (with-silent-modifications
(while (re-search-forward "[ \t]+$" nil t)
(put-text-property (match-beginning 0) (match-end 0)
'hfy-show-trailing-whitespace t)))))))
@@ -1573,7 +1553,7 @@ Do not record undo information during evaluation of BODY."
(defun hfy-unmark-trailing-whitespace ()
"Undo the effect of `hfy-mark-trailing-whitespace'."
(when show-trailing-whitespace
- (hfy-save-buffer-state nil
+ (with-silent-modifications
(remove-text-properties (point-min) (point-max)
'(hfy-show-trailing-whitespace nil)))))
diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el
index e23b65d616..f083477ddf 100644
--- a/lisp/image/wallpaper.el
+++ b/lisp/image/wallpaper.el
@@ -26,7 +26,8 @@
;; desktop background.
;;
;; On GNU/Linux and other Unix-like systems, it uses an external
-;; command to set the desktop background.
+;; command to set the desktop background. This should work seamlessly
+;; on both X and Wayland.
;;
;; Finding an external command to use is obviously a bit tricky to get
;; right, as there is no lack of platforms, window managers, desktop
@@ -94,9 +95,11 @@ the image file to set the wallpaper to.")
(args (if (or (listp args-raw) (symbolp args-raw))
args-raw
(string-split args-raw)))
- (predicate (plist-get rest-plist :predicate))))
+ (predicate (plist-get rest-plist :predicate))
+ (init-action (plist-get rest-plist :init-action))
+ (detach (plist-get rest-plist :detach))))
(:copier wallpaper-setter-copy))
- "Structure containing a command to set the wallpaper.
+ "Structure containing a method to set the wallpaper.
NAME is a description of the setter (e.g. the name of the Desktop
Environment).
@@ -106,15 +109,41 @@ COMMAND is the executable to run to set the wallpaper.
ARGS is the default list of command line arguments for COMMAND.
PREDICATE is a function that will be called without any arguments
-and returns non-nil if this setter should be used."
+and returns non-nil if this setter should be used.
+
+INIT-ACTION is a function that will be called without any
+arguments before trying to set the wallpaper.
+
+DETACH, if non-nil, means that the wallpaper process should
+continue running even after exiting Emacs."
name
command
args
- (predicate #'always))
+ (predicate #'always)
+ init-action
+ detach)
;;;###autoload
(put 'wallpaper-setter-create 'lisp-indent-function 1)
+(defun wallpaper--init-action-kill (process-name)
+ "Return kill function for `init-action' of a `wallpaper-setter' structure.
+The returned function kills any process named PROCESS-NAME owned
+by the current effective user id."
+ (lambda ()
+ (when-let ((procs
+ (seq-filter (lambda (p) (let-alist p
+ (and (= .euid (user-uid))
+ (equal .comm process-name))))
+ (mapcar (lambda (pid)
+ (cons (cons 'pid pid)
+ (process-attributes pid)))
+ (list-system-processes)))))
+ (dolist (proc procs)
+ (let-alist proc
+ (when (y-or-n-p (format "Kill \"%s\" process with PID %d?" .comm
.pid))
+ (signal-process .pid 'TERM)))))))
+
(defmacro wallpaper--default-methods-create (&rest items)
"Helper macro for defining `wallpaper--default-setters'."
(cons 'list
@@ -198,12 +227,16 @@ and returns non-nil if this setter should be used."
"swaybg" "-o * -i %f -m fill"
:predicate (lambda ()
(and (getenv "WAYLAND_DISPLAY")
- (getenv "SWAYSOCK"))))
+ (getenv "SWAYSOCK")))
+ :init-action (wallpaper--init-action-kill "swaybg")
+ :detach t)
("wbg"
"wbg" "%f"
:predicate (lambda ()
- (getenv "WAYLAND_DISPLAY")))
+ (getenv "WAYLAND_DISPLAY"))
+ :init-action (wallpaper--init-action-kill "wbg")
+ :detach t)
;; X general.
("GraphicsMagick"
@@ -257,7 +290,8 @@ order in which they appear.")
(defun wallpaper--find-setter ()
(when (wallpaper--use-default-set-function-p)
- (or wallpaper--current-setter
+ (or (and (wallpaper-setter-p wallpaper--current-setter)
+ wallpaper--current-setter)
(setq wallpaper--current-setter
(catch 'found
(dolist (setter wallpaper--default-setters)
@@ -440,9 +474,10 @@ FILE is the image file name."
(format-spec
format
`((?f . ,(expand-file-name file))
- (?F . ,(mapconcat #'url-hexify-string
- (file-name-split file)
- "/"))
+ (?F . ,(lambda ()
+ (mapconcat #'url-hexify-string
+ (file-name-split file)
+ "/")))
(?h . ,(lambda ()
(wallpaper--get-height-or-width
"height"
@@ -454,22 +489,25 @@ FILE is the image file name."
#'display-pixel-width
wallpaper-default-width)))
;; screen number
- (?S . ,(let ((display (frame-parameter (selected-frame) 'display)))
- (if (and display
- (string-match (rx ":" (+ (in "0-9")) "."
- (group (+ (in "0-9"))) eos)
- display))
- (match-string 1 display)
- "0")))
+ (?S . ,(lambda ()
+ (let ((display (frame-parameter (selected-frame) 'display)))
+ (if (and display
+ (string-match (rx ":" (+ (in "0-9")) "."
+ (group (+ (in "0-9"))) eos)
+ display))
+ (match-string 1 display)
+ "0"))))
;; monitor name
(?M . ,#'wallpaper--x-monitor-name)
;; workspace
- (?W . ,(or (and (fboundp 'x-window-property)
- (display-graphic-p)
- (number-to-string
- (or (x-window-property "_NET_CURRENT_DESKTOP" nil
"CARDINAL" 0 nil t)
- (x-window-property "WIN_WORKSPACE" nil "CARDINAL" 0
nil t))))
- "0")))))
+ (?W . ,(lambda ()
+ (or (and (fboundp 'x-window-property)
+ (display-graphic-p)
+ (number-to-string
+ (or (x-window-property "_NET_CURRENT_DESKTOP" nil
"CARDINAL" 0 nil t)
+ (x-window-property "WIN_WORKSPACE" nil "CARDINAL"
0 nil t)
+ 0)))
+ "0"))))))
(defun wallpaper-default-set-function (file)
"Set the wallpaper to FILE using a command.
@@ -482,28 +520,36 @@ This is the default function for
`wallpaper-set-function'."
(real-args (mapcar (lambda (arg) (wallpaper--format-arg arg file))
args))
(bufname (format " *wallpaper-%s*" (random)))
- (process
- (and wallpaper-command
- (apply #'start-process "set-wallpaper" bufname
- wallpaper-command real-args))))
- (unless wallpaper-command
- (error "Couldn't find a suitable command for setting the wallpaper"))
+ (setter (and (wallpaper-setter-p wallpaper--current-setter)
+ (equal (wallpaper-setter-command
wallpaper--current-setter)
+ wallpaper-command)
+ wallpaper--current-setter))
+ (init-action (and setter (wallpaper-setter-init-action setter)))
+ (detach (and setter (wallpaper-setter-detach setter)))
+ process)
+ (when init-action
+ (funcall init-action))
(wallpaper-debug "Using command: \"%s %s\""
- wallpaper-command (string-join real-args " "))
- (setf (process-sentinel process)
- (lambda (process status)
- (unwind-protect
- (if (and (eq (process-status process) 'exit)
- (zerop (process-exit-status process)))
- (message "Desktop wallpaper changed to %s"
- (abbreviate-file-name file))
- (message "command \"%s %s\": %S"
- (string-join (process-command process) " ")
- (string-replace "\n" "" status)
- (with-current-buffer (process-buffer process)
- (string-clean-whitespace (buffer-string)))))
- (ignore-errors
- (kill-buffer (process-buffer process))))))
+ wallpaper-command (string-join real-args " "))
+ (if detach
+ (apply #'call-process wallpaper-command nil 0 nil real-args)
+ (setq process
+ (apply #'start-process "set-wallpaper" bufname
+ wallpaper-command real-args))
+ (setf (process-sentinel process)
+ (lambda (process status)
+ (unwind-protect
+ (if (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (message "Desktop wallpaper changed to %s"
+ (abbreviate-file-name file))
+ (message "command \"%s %s\": %S"
+ (string-join (process-command process) " ")
+ (string-replace "\n" "" status)
+ (with-current-buffer (process-buffer process)
+ (string-clean-whitespace (buffer-string)))))
+ (ignore-errors
+ (kill-buffer (process-buffer process)))))))
process))
;;;###autoload
diff --git a/lisp/info-look.el b/lisp/info-look.el
index ce0a08dcbe..2eec6f49f5 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -1051,6 +1051,7 @@ Return nil if there is nothing appropriate in the buffer
near point."
("eieio" "Function Index")
("gnutls" "(emacs-gnutls)Variable Index" "(emacs-gnutls)Function Index")
("mm" "(emacs-mime)Index")
+ ("eglot" "Index")
("epa" "Variable Index" "Function Index")
("ert" "Index")
("eshell" "Function and Variable Index")
diff --git a/lisp/info.el b/lisp/info.el
index 292bf93a6f..d74cbaaac0 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -763,6 +763,11 @@ See a list of available Info commands in `Info-mode'."
(read-file-name "Info file name: " nil nil t))
(if (numberp current-prefix-arg)
(format "*info*<%s>" current-prefix-arg))))
+ (when file-or-node
+ ;; Info node names don't contain newlines, so allow for easier use
+ ;; of names that might have been wrapped (in emails, etc.).
+ (setq file-or-node
+ (string-replace "\n" " " file-or-node)))
(info-setup file-or-node
(pop-to-buffer-same-window (or buffer "*info*"))))
@@ -2476,7 +2481,6 @@ Table of contents is created from the tree structure of
menus."
(sections '(("Top" "Top")))
nodes subfiles)
(while (or main-file subfiles)
- ;; (or main-file (message "Searching subfile %s..." (car subfiles)))
(erase-buffer)
(info-insert-file-contents (or main-file (car subfiles)))
(goto-char (point-min))
@@ -2535,7 +2539,6 @@ Table of contents is created from the tree structure of
menus."
(setq subfiles (nreverse subfiles)
main-file nil))
(setq subfiles (cdr subfiles))))
- (message "")
(nreverse nodes))))
(defun Info-toc-nodes (filename)
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 6e44b85e6c..93fedb8c1a 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -152,7 +152,7 @@
'((latin ?A ?Z ?a ?z #x00C0 #x0100 #x0180 #x1e00)
(phonetic #x250 #x283)
(greek #x3A9)
- (coptic #x3E2)
+ (coptic #x3E2 #x2C80 #x2CAE)
(cyrillic #x42F)
(armenian #x531)
(hebrew #x5D0)
@@ -779,6 +779,7 @@
lepcha
symbol
braille
+ coptic
yi
syloti-nagri
rejang
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 3e840b014f..bc3697deb0 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -3649,8 +3649,7 @@ Optional third argument, if t, means if fail just return
nil (no error).
(setq isearch-case-fold-search
(isearch-no-upper-case-p isearch-string isearch-regexp)))
(condition-case lossage
- (let ((inhibit-point-motion-hooks isearch-invisible)
- (inhibit-quit nil)
+ (let ((inhibit-quit nil)
(case-fold-search isearch-case-fold-search)
(search-invisible isearch-invisible)
(retry t))
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 6ef46ad60b..ed7a3dbba3 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -27,16 +27,6 @@
;;; Code:
-
-(eval-when-compile
- (defmacro with-buffer-prepared-for-jit-lock (&rest body)
- "Execute BODY in current buffer, overriding several variables.
-Preserves the `buffer-modified-p' state of the current buffer."
- (declare (debug t))
- `(let ((inhibit-point-motion-hooks t))
- (with-silent-modifications
- ,@body))))
-
;;; Customization.
(defgroup jit-lock nil
@@ -328,7 +318,7 @@ like `debug-on-error' and Edebug can be used."
(when (buffer-live-p buffer)
(with-current-buffer buffer
;; (message "Jit-Debug %s" (buffer-name))
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(let ((pos (point-min)))
(while
(progn
@@ -365,7 +355,7 @@ Only applies to the current buffer."
(defun jit-lock-refontify (&optional beg end)
"Force refontification of the region BEG..END (default whole buffer)."
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(save-restriction
(widen)
(put-text-property (or beg (point-min)) (or end (point-max))
@@ -392,7 +382,7 @@ is active."
(push (current-buffer) jit-lock-defer-buffers))
;; Mark the area as defer-fontified so that the redisplay engine
;; is happy and so that the idle timer can find the places to fontify.
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(put-text-property start
(next-single-property-change
start 'fontified nil
@@ -426,7 +416,7 @@ is active."
(defun jit-lock-fontify-now (&optional start end)
"Fontify current buffer from START to END.
Defaults to the whole buffer. END can be out of bounds."
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(save-excursion
(unless start (setq start (point-min)))
(setq end (if end (min end (point-max)) (point-max)))
@@ -502,7 +492,7 @@ Defaults to the whole buffer. END can be out of bounds."
This applies to the buffer associated with marker START."
(when (marker-buffer start)
(with-current-buffer (marker-buffer start)
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(when (> end (point-max))
(setq end (point-max) start (min start end)))
(when (< start (point-min))
@@ -616,7 +606,7 @@ non-nil in a repeated invocation of this function."
(when (buffer-live-p buffer)
(with-current-buffer buffer
;; (message "Jit-Defer %s" (buffer-name))
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(let ((pos (point-min)))
(while
(progn
@@ -664,7 +654,7 @@ non-nil in a repeated invocation of this function."
jit-lock-context-unfontify-pos
'jit-lock-defer-multiline)
(point-min))))
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
;; Force contextual refontification.
(remove-text-properties
jit-lock-context-unfontify-pos (point-max)
@@ -695,7 +685,7 @@ will take place when text is fontified stealthily."
(when (and jit-lock-mode (not memory-full))
(let ((jit-lock-start start)
(jit-lock-end end))
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(run-hook-with-args 'jit-lock-after-change-extend-region-functions
start end old-len)
;; Make sure we change at least one char (in case of deletions).
diff --git a/lisp/language/indonesian.el b/lisp/language/indonesian.el
index 699f819254..5afcd27759 100644
--- a/lisp/language/indonesian.el
+++ b/lisp/language/indonesian.el
@@ -34,7 +34,8 @@
(input-method . "balinese")
(sample-text . "Balinese (ᬅᬓ᭄ᬱᬭᬩᬮᬶ) ᬒᬁᬲ᭄ᬯᬲ᭄ᬢ᭄ᬬᬲ᭄ᬢᬸ")
(documentation . "\
-Balinese language and its script are supported in this language
environment.")))
+Balinese language and its script are supported in this language environment."))
+ '("Indonesian"))
(set-language-info-alist
"Javanese" '((charset unicode)
@@ -43,7 +44,8 @@ Balinese language and its script are supported in this
language environment.")))
(input-method . "javanese")
(sample-text . "Javanese (ꦲꦏ꧀ꦱꦫꦗꦮ) ꦲꦭꦺꦴ")
(documentation . "\
-Javanese language and its script are supported in this language
environment.")))
+Javanese language and its script are supported in this language environment."))
+ '("Indonesian"))
(set-language-info-alist
"Sundanese" '((charset unicode)
@@ -52,7 +54,8 @@ Javanese language and its script are supported in this
language environment.")))
(input-method . "sundanese")
(sample-text . "Sundanese (ᮃᮊ᮪ᮞᮛᮞᮥᮔ᮪ᮓ) ᮞᮙ᮪ᮕᮥᮛᮞᮥᮔ᮪")
(documentation . "\
-Sundanese language and its script are supported in this language
environment.")))
+Sundanese language and its script are supported in this language
environment."))
+ '("Indonesian"))
(set-language-info-alist
"Batak" '((charset unicode)
@@ -62,7 +65,8 @@ Sundanese language and its script are supported in this
language environment."))
(sample-text . "Batak (ᯘᯮᯒᯗ᯲ᯅᯗᯂ᯲) ᯂᯬᯒᯘ᯲ / ᯔᯧᯐᯬᯀᯱᯐᯬᯀᯱ")
(documentation . "\
Languages that use the Batak script, such as Karo, Toba, Pakpak, Mandailing
-and Simalungun, are supported in this language environment.")))
+and Simalungun, are supported in this language environment."))
+ '("Indonesian"))
(set-language-info-alist
"Rejang" '((charset unicode)
@@ -71,7 +75,8 @@ and Simalungun, are supported in this language
environment.")))
(input-method . "rejang")
(sample-text . "Rejang (ꥆꤰ꥓ꤼꤽ ꤽꥍꤺꥏ) ꤸꥉꥐꤺꥉꥂꥎ")
(documentation . "\
-Rejang language and its script are supported in this language environment.")))
+Rejang language and its script are supported in this language environment."))
+ '("Indonesian"))
(set-language-info-alist
"Makasar" '((charset unicode)
@@ -80,7 +85,8 @@ Rejang language and its script are supported in this language
environment.")))
(input-method . "makasar")
(sample-text . "Makasar (𑻪𑻢𑻪𑻢) 𑻦𑻤𑻵𑻱")
(documentation . "\
-Makassarese language and its script Makasar are supported in this language
environment.")))
+Makassarese language and its script Makasar are supported in this language
environment."))
+ '("Indonesian"))
(set-language-info-alist
"Buginese" '((charset unicode)
@@ -89,7 +95,8 @@ Makassarese language and its script Makasar are supported in
this language envir
(input-method . "lontara")
(sample-text . "Buginese (ᨒᨚᨈᨑ) ᨖᨒᨚ")
(documentation . "\
-Buginese language and its script Lontara are supported in this language
environment.")))
+Buginese language and its script Lontara are supported in this language
environment."))
+ '("Indonesian"))
;; Balinese composition rules
(let ((consonant "[\x1B13-\x1B33\x1B45-\x1B4B]")
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index 4a2e7838fc..c34017d9b3 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -228,7 +228,8 @@ thin (i.e. 1-dot width) space."
(sample-text . "Hanifi Rohingya (𐴌𐴟𐴇𐴥𐴝𐴚𐴒𐴙𐴝 𐴇𐴝𐴕𐴞𐴉𐴞 𐴓𐴠𐴑𐴤𐴝)
𐴀𐴝𐴏𐴓𐴝𐴀𐴡𐴤𐴛𐴝𐴓𐴝𐴙𐴑𐴟𐴔")
(documentation . "\
Rohingya language and its script Hanifi Rohingya are supported
-in this language environment.")))
+in this language environment."))
+ '("Misc"))
;; Hanifi Rohingya composition rules
(set-char-table-range
@@ -251,7 +252,8 @@ in this language environment.")))
(sample-text . "Kharoṣṭhī (𐨑𐨪𐨆𐨛𐨁) 𐨣𐨨𐨲𐨪𐨆 𐨐𐨪𐨅𐨨𐨁")
(documentation . "\
Language environment for Gāndhārī, Sanskrit, and other languages
-using the Kharoṣṭhī script.")))
+using the Kharoṣṭhī script."))
+ '("Misc"))
(let ((consonant "[\U00010A00\U00010A10-\U00010A35]")
(vowel "[\U00010A01-\U00010A06]")
@@ -281,7 +283,8 @@ using the Kharoṣṭhī script.")))
(sample-text . "Adlam (𞤀𞤣𞤤𞤢𞤥) 𞤅𞤢𞤤𞤢𞥄𞤥")
(documentation . "\
Fulani language and its script Adlam are supported
-in this language environment.")))
+in this language environment."))
+ '("Misc"))
;; Adlam composition rules
(set-char-table-range
@@ -303,7 +306,8 @@ in this language environment.")))
(sample-text . "Mende Kikakui (𞠀𞠁𞠂) 𞠛𞠉")
(documentation . "\
Mende language and its script Kikakui are supported
-in this language environment.")))
+in this language environment."))
+ '("Misc"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Gothic
@@ -317,7 +321,23 @@ in this language environment.")))
(sample-text . "Gothic (𐌲𐌿𐍄𐌹𐍃𐌺𐌰) 𐌷𐌰𐌹𐌻𐍃 / 𐌷𐌰𐌹𐌻𐌰")
(documentation . "\
Ancient Gothic language using the Gothic script is supported in this
-language environment.")))
+language environment."))
+ '("Misc"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Coptic
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(set-language-info-alist
+ "Coptic" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "coptic")
+ (sample-text . "Coptic (ⲘⲉⲧⲢⲉⲙ̀ⲛⲭⲏⲙⲓ) Ⲛⲟⲩϥⲣⲓ")
+ (documentation . "\
+Coptic language using the Coptic script is supported in this
+language environment."))
+ '("Misc"))
(provide 'misc-lang)
diff --git a/lisp/language/philippine.el b/lisp/language/philippine.el
index e52ad6912c..ce619bdaa1 100644
--- a/lisp/language/philippine.el
+++ b/lisp/language/philippine.el
@@ -35,7 +35,8 @@
(sample-text . "Tagalog (ᜊᜌ᜔ᜊᜌᜒᜈ᜔) ᜃᜓᜋᜓᜐ᜔ᜆ")
(documentation . "\
Tagalog language using the Baybayin script is supported in
-this language environment.")))
+this language environment."))
+ '("Philippine"))
(set-language-info-alist
"Hanunoo" '((charset unicode)
@@ -44,7 +45,8 @@ this language environment.")))
(input-method . "hanunoo")
(sample-text . "Hanunoo (ᜱᜨᜳᜨᜳᜢ) ᜫᜬᜧ᜴ ᜣᜭᜯᜥ᜴ ᜰᜲᜭᜥ᜴")
(documentation . "\
-Philippine Language Hanunoo is supported in this language environment.")))
+Philippine Language Hanunoo is supported in this language environment."))
+ '("Philippine"))
(set-language-info-alist
"Buhid" '((charset unicode)
@@ -52,7 +54,8 @@ Philippine Language Hanunoo is supported in this language
environment.")))
(coding-priority utf-8)
(input-method . "buhid")
(documentation . "\
-Philippine Language Buhid is supported in this language environment.")))
+Philippine Language Buhid is supported in this language environment."))
+ '("Philippine"))
(set-language-info-alist
"Tagbanwa" '((charset unicode)
@@ -61,7 +64,8 @@ Philippine Language Buhid is supported in this language
environment.")))
(input-method . "tagbanwa")
(sample-text . "Tagbanwa (ᝦᝪᝯ) ᝫᝩᝬᝥ ᝣᝮᝧᝯ")
(documentation . "\
-Philippine Languages Tagbanwa are supported in this language environment.")))
+Philippine Languages Tagbanwa are supported in this language environment."))
+ '("Philippine"))
;; Tagalog composition rules
(let ((akshara "[\x1700-\x1711\x171F]")
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index c9502fbb21..b992846b0b 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -4702,14 +4702,13 @@ Search happens in `native-comp-eln-load-path'.
(autoload 'native-compile "comp" "\
Compile FUNCTION-OR-FILE into native code.
This is the synchronous entry-point for the Emacs Lisp native
-compiler.
-FUNCTION-OR-FILE is a function symbol, a form, or the filename of
-an Emacs Lisp source file.
-If OUTPUT is non-nil, use it as the filename for the compiled
-object.
-If FUNCTION-OR-FILE is a filename, return the filename of the
-compiled object. If FUNCTION-OR-FILE is a function symbol or a
-form, return the compiled function.
+compiler. FUNCTION-OR-FILE is a function symbol, a form, or the
+filename of an Emacs Lisp source file. If OUTPUT is non-nil, use
+it as the filename for the compiled object. If FUNCTION-OR-FILE
+is a filename, if the compilation was successful return the
+filename of the compiled object. If FUNCTION-OR-FILE is a
+function symbol or a form, if the compilation was successful
+return the compiled function.
(fn FUNCTION-OR-FILE &optional OUTPUT)")
(autoload 'batch-native-compile "comp" "\
@@ -4960,8 +4959,6 @@ evaluate `compilation-shell-minor-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
-\\{compilation-shell-minor-mode-map}
-
(fn &optional ARG)" t)
(autoload 'compilation-minor-mode "compile" "\
Toggle Compilation minor mode.
@@ -4985,8 +4982,6 @@ evaluate `compilation-minor-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
-\\{compilation-minor-mode-map}
-
(fn &optional ARG)" t)
(autoload 'compilation-next-error-function "compile" "\
Advance to the next error message and visit the file where the error was.
@@ -8371,7 +8366,7 @@ A second call of this function without changing point
inserts the next match.
A call with prefix PREFIX reads the symbol to insert from the minibuffer with
completion.
-(fn PREFIX)" t)
+(fn PREFIX)" '("P"))
(autoload 'ebrowse-tags-loop-continue "ebrowse" "\
Repeat last operation on files in tree.
FIRST-TIME non-nil means this is not a repetition, but the first time.
@@ -9920,7 +9915,7 @@ When present, ID should be an opaque object used to
identify the
connection unequivocally. This is rarely needed and not available
interactively.
-(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK
(erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME
(erc-compute-full-name)) ID)" t)
+(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK
(erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME
(erc-compute-full-name)) ID)" '((erc-select-read-args)))
(defalias 'erc-select #'erc)
(autoload 'erc-tls "erc" "\
ERC is a powerful, modular, and extensible IRC client.
@@ -9967,7 +9962,7 @@ symbol composed of letters from the Latin alphabet.)
This option is
generally unneeded, however. See info node `(erc) Connecting' for use
cases. Not available interactively.
-(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK
(erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME
(erc-compute-full-name)) CLIENT-CERTIFICATE ID)" t)
+(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK
(erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME
(erc-compute-full-name)) CLIENT-CERTIFICATE ID)" '((let ((erc-default-port
erc-default-port-tls)) (erc-select-read-args))))
(autoload 'erc-handle-irc-url "erc" "\
Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
If ERC is already connected to HOST:PORT, simply /join CHANNEL.
@@ -10183,9 +10178,7 @@ it has to be wrapped in `(eval (quote ...))'.
If NAME is already defined as a test and Emacs is running
in batch mode, an error is signalled.
-(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)]
BODY...)" nil t)
-(function-put 'ert-deftest 'doc-string-elt 3)
-(function-put 'ert-deftest 'lisp-indent-function 2)
+(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)]
BODY...)" nil 'macro)
(autoload 'ert-run-tests-batch "ert" "\
Run the tests specified by SELECTOR, printing results to the terminal.
@@ -11719,6 +11712,17 @@ variables are set in the server's process buffer
according to the
VARIABLES list of the connection profile. The list is processed
in order.
+(fn PROFILE VARIABLES)")
+(autoload 'connection-local-update-profile-variables "files-x" "\
+Update the variable settings for PROFILE in-place.
+VARIABLES is a list that declares connection-local variables for
+the connection profile. An element in VARIABLES is an alist
+whose elements are of the form (VAR . VALUE).
+
+Unlike `connection-local-set-profile-variables' (which see), this
+function preserves the values of any existing variable
+definitions that aren't listed in VARIABLES.
+
(fn PROFILE VARIABLES)")
(autoload 'hack-connection-local-variables-apply "files-x" "\
Apply connection-local variables identified by CRITERIA.
@@ -11731,11 +11735,38 @@ Apply connection-local variables according to
`default-directory'.
Execute BODY, and unwind connection-local variables.
(fn &rest BODY)" nil t)
+(autoload 'with-connection-local-application-variables "files-x" "\
+Apply connection-local variables for APPLICATION in `default-directory'.
+Execute BODY, and unwind connection-local variables.
+
+(fn APPLICATION &rest BODY)" nil t)
+(function-put 'with-connection-local-application-variables
'lisp-indent-function 1)
(autoload 'with-connection-local-variables-1 "files-x" "\
Apply connection-local variables according to `default-directory'.
Call BODY-FUN with no args, and then unwind connection-local variables.
(fn BODY-FUN)")
+(autoload 'setq-connection-local "files-x" "\
+Set each VARIABLE connection-locally to VALUE.
+
+When `connection-local-profile-name-for-setq' is set, assign each
+variable's value on that connection profile, and set that profile
+for `connection-local-criteria'. You can use this in combination
+with `with-connection-local-variables', as in
+
+ (with-connection-local-variables
+ (setq-connection-local VARIABLE VALUE))
+
+If there's no connection-local profile to use, just set the
+variables normally, as with `setq'.
+
+The variables are literal symbols and should not be quoted. The
+second VALUE is not computed until after the first VARIABLE is
+set, and so on; each VALUE can use the new value of variables set
+earlier in the `setq-connection-local'. The return value of the
+`setq-connection-local' form is the value of the last VALUE.
+
+(fn [VARIABLE VALUE]...)" nil t)
(autoload 'path-separator "files-x" "\
The connection-local value of `path-separator'.")
(autoload 'null-device "files-x" "\
@@ -12261,8 +12292,6 @@ evaluate `flymake-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
-\\{flymake-mode-map}
-
(fn &optional ARG)" t)
(autoload 'flymake-mode-on "flymake" "\
Turn Flymake mode on.")
@@ -15397,7 +15426,7 @@ it is disabled.
;;; Generated autoloads from progmodes/hideshow.el
-(defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil
nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1))
(java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil) (mhtml-mode
"{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil))) "\
+(defvar hs-special-modes-alist (mapcar #'purecopy '((c-mode "{" "}" "/[*/]"
nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)"
1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil)
(mhtml-mode "{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil))) "\
Alist for initializing the hideshow variables for different modes.
Each element has the form
(MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC
@@ -15888,8 +15917,7 @@ inlined into the compiled format versions. This means
that if you
change its definition, you should explicitly call
`ibuffer-recompile-formats'.
-(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil t)
-(function-put 'define-ibuffer-column 'lisp-indent-function 'defun)
+(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil 'macro)
(autoload 'define-ibuffer-sorter "ibuf-macs" "\
Define a method of sorting named NAME.
DOCUMENTATION is the documentation of the function, which will be called
@@ -15900,9 +15928,7 @@ For sorting, the forms in BODY will be evaluated with
`a' bound to one
buffer object, and `b' bound to another. BODY should return a non-nil
value if and only if `a' is \"less than\" `b'.
-(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil t)
-(function-put 'define-ibuffer-sorter 'lisp-indent-function 1)
-(function-put 'define-ibuffer-sorter 'doc-string-elt 2)
+(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil 'macro)
(autoload 'define-ibuffer-op "ibuf-macs" "\
Generate a function which operates on a buffer.
OP becomes the name of the function; if it doesn't begin with
@@ -15941,9 +15967,7 @@ BODY define the operation; they are forms to evaluate
per each
marked buffer. BODY is evaluated with `buf' bound to the
buffer object.
-(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING
ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" nil t)
-(function-put 'define-ibuffer-op 'lisp-indent-function 2)
-(function-put 'define-ibuffer-op 'doc-string-elt 3)
+(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING
ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" nil 'macro)
(autoload 'define-ibuffer-filter "ibuf-macs" "\
Define a filter named NAME.
DOCUMENTATION is the documentation of the function.
@@ -15958,9 +15982,7 @@ not a particular buffer should be displayed or not.
The forms in BODY
will be evaluated with BUF bound to the buffer object, and QUALIFIER
bound to the current value of the filter.
-(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil t)
-(function-put 'define-ibuffer-filter 'lisp-indent-function 2)
-(function-put 'define-ibuffer-filter 'doc-string-elt 2)
+(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil 'macro)
(register-definition-prefixes "ibuf-macs" '("ibuffer-"))
@@ -18726,6 +18748,7 @@ This scans for ;;;###autoload forms and related things.
The first element on the command line should be the (main)
loaddefs.el output file, and the rest are the directories to
use.")
+ (load "theme-loaddefs.el" t)
(register-definition-prefixes "loaddefs-gen" '("autoload-"
"generated-autoload-" "loaddefs-generate--" "no-update-autoloads"))
@@ -18847,6 +18870,8 @@ done. Otherwise, this function will use the current
buffer.
Major mode for browsing CVS log output.
(fn)" t)
+(autoload 'log-view-get-marked "log-view" "\
+Return the list of tags for the marked log entries.")
(register-definition-prefixes "log-view" '("log-view-"))
@@ -24534,7 +24559,7 @@ Open profile FILENAME.
;;; Generated autoloads from progmodes/project.el
-(push (purecopy '(project 0 8 1)) package--builtin-versions)
+(push (purecopy '(project 0 8 2)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -25596,8 +25621,6 @@ evaluate `rectangle-mark-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
-\\{rectangle-mark-mode-map}
-
(fn &optional ARG)" t)
(register-definition-prefixes "rect" '("apply-on-rectangle"
"clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope"
"rectangle-" "spaces-string" "string-rectangle-"))
@@ -25926,6 +25949,9 @@ The mode's hook is called both when the mode is enabled
and when
it is disabled.
(fn &optional ARG)" t)
+(autoload 'repeat-exit "repeat" "\
+Exit the repeating sequence.
+This function can be used to force exit of repetition while it's active." t)
(register-definition-prefixes "repeat" '("describe-repeat-maps" "repeat-"))
@@ -29436,6 +29462,8 @@ PROMPT will be inserted at the start of the buffer, but
won't be
included in the resulting string. If PROMPT is nil, no help text
will be inserted.
+Also see `read-string-from-buffer'.
+
(fn PROMPT STRING SUCCESS-CALLBACK &key ABORT-CALLBACK)")
(autoload 'read-string-from-buffer "string-edit" "\
Switch to a new buffer to edit STRING in a recursive edit.
@@ -29445,6 +29473,8 @@ PROMPT will be inserted at the start of the buffer, but
won't be
included in the resulting string. If nil, no prompt will be
inserted in the buffer.
+Also see `string-edit'.
+
(fn PROMPT STRING)")
(register-definition-prefixes "string-edit" '("string-edit-"))
@@ -32000,14 +32030,14 @@ Add archive file name handler to
`file-name-handler-alist'." (when (and tramp-ar
(register-definition-prefixes "tramp-compat" '("tramp-"))
-;;; Generated autoloads from net/tramp-crypt.el
+;;; Generated autoloads from net/tramp-container.el
-(register-definition-prefixes "tramp-crypt" '("tramp-crypt-"))
+(register-definition-prefixes "tramp-container" '("tramp-"))
-;;; Generated autoloads from net/tramp-docker.el
+;;; Generated autoloads from net/tramp-crypt.el
-(register-definition-prefixes "tramp-docker" '("tramp-docker-"))
+(register-definition-prefixes "tramp-crypt" '("tramp-crypt-"))
;;; Generated autoloads from net/tramp-ftp.el
@@ -32740,6 +32770,10 @@ if it had been inserted from a file named URL.
(fn URL &optional VISIT BEG END REPLACE)")
+(autoload 'url-insert-file-contents-literally "url-handlers" "\
+Insert the data retrieved from URL literally in the current buffer.
+
+(fn URL)")
(register-definition-prefixes "url-handlers" '("url-"))
@@ -33440,11 +33474,13 @@ Show the change log for BRANCH root in a window.
(autoload 'vc-log-incoming "vc" "\
Show log of changes that will be received with pull from REMOTE-LOCATION.
When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
+In some version control systems REMOTE-LOCATION can be a remote branch name.
(fn &optional REMOTE-LOCATION)" t)
(autoload 'vc-log-outgoing "vc" "\
Show log of changes that will be sent with a push operation to REMOTE-LOCATION.
When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
+In some version control systems REMOTE-LOCATION can be a remote branch name.
(fn &optional REMOTE-LOCATION)" t)
(autoload 'vc-log-search "vc" "\
@@ -33571,6 +33607,18 @@ log entries should be gathered.
Request editing the next VC shell command before execution.
This is a prefix command. It affects only a VC command executed
immediately after this one." t)
+(autoload 'vc-prepare-patch "vc" "\
+Compose an Email sending patches for REVISIONS to ADDRESSEE.
+If `vc-prepare-patches-separately' is nil, SUBJECT will be used
+as the default subject for the message (and it will be prompted
+for when called interactively). Otherwise a separate message
+will be composed for each revision, with SUBJECT derived from the
+invidividual commits.
+
+When invoked interactively in a Log View buffer with marked
+revisions, those revisions will be used.
+
+(fn ADDRESSEE SUBJECT REVISIONS)" t)
(register-definition-prefixes "vc" '("vc-" "with-vc-properties"))
@@ -34565,10 +34613,6 @@ Convert Vietnamese characters of the current buffer to
`VIQR' mnemonics." t)
;;; Generated autoloads from view.el
-(defvar view-remove-frame-by-deleting t "\
-Determine how View mode removes a frame no longer needed.
-If nil, make an icon of the frame. If non-nil, delete the frame.")
-(custom-autoload 'view-remove-frame-by-deleting "view" t)
(defvar-local view-mode nil "\
Non-nil if View mode is enabled.
Don't change this variable directly, you must change it by one of the
@@ -36122,7 +36166,13 @@ Extract file name from an yenc header.")
;;; Generated autoloads from play/zone.el
(autoload 'zone "zone" "\
-Zone out, completely." t)
+Zone out, completely.
+With a prefix argument the user is prompted for a program to run.
+When called from Lisp the optional argument PGM can be used to
+run a specific program. The program must be a member of
+`zone-programs'.
+
+(fn &optional PGM)" t)
(register-definition-prefixes "zone" '("zone-"))
;;; End of scraped data
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index 048e16e8d8..31a34bc1de 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -30,6 +30,8 @@
;;; Code:
+(require 'pcase)
+(require 'seq)
(require 'quail)
(require 'ind-util)
@@ -699,6 +701,165 @@ is."
"tamil-inscript-digits" "Tamil" "TmlISD"
"Tamil keyboard Inscript with Tamil digits support.")
+;; Tamil99 input method
+;;
+;; Tamil99 is a keyboard layout and input method that is specifically
+;; designed for the Tamil language. Vowels and vowel modifiers are
+;; input with your left hand, and consonants are input with your right
+;; hand. See https://en.wikipedia.org/wiki/Tamil_99
+;;
+;; தமிழ்99 உள்ளீட்டு முறை
+;;
+;; தமிழ்99 தமிழுக்கென்றே உருவாக்கப்பட்ட விசைப்பலகை அமைப்பும் உள்ளீட்டு முறையும்
+;; ஆகும். உயிர்களை இடக்கையுடனும் மெய்களை வலக்கையுடனும் தட்டச்சிடும்படி
+;; அமைக்கப்பட்டது.
https://ta.wikipedia.org/wiki/%E0%AE%A4%E0%AE%AE%E0%AE%BF%E0%AE%B4%E0%AF%8D_99
+;; காண்க.
+
+(quail-define-package
+ "tamil99" "Tamil" "தமிழ்99"
+ t "Tamil99 input method"
+ nil t t t t nil nil nil nil nil t)
+
+(defconst tamil99-vowels
+ '(("q" "ஆ")
+ ("w" "ஈ")
+ ("e" "ஊ")
+ ("r" "ஐ")
+ ("t" "ஏ")
+ ("a" "அ")
+ ("s" "இ")
+ ("d" "உ")
+ ("g" "எ")
+ ("z" "ஔ")
+ ("x" "ஓ")
+ ("c" "ஒ"))
+ "Mapping for vowels.")
+
+(defconst tamil99-vowel-modifiers
+ '(("q" "ா")
+ ("w" "ீ")
+ ("e" "ூ")
+ ("r" "ை")
+ ("t" "ே")
+ ("a" "")
+ ("s" "ி")
+ ("d" "ு")
+ ("g" "ெ")
+ ("z" "ௌ")
+ ("x" "ோ")
+ ("c" "ொ")
+ ("f" "்"))
+ "Mapping for vowel modifiers.")
+
+(defconst tamil99-hard-consonants
+ '(("h" "க")
+ ("[" "ச")
+ ("o" "ட")
+ ("l" "த")
+ ("j" "ப")
+ ("u" "ற"))
+ "Mapping for hard consonants (வல்லினம்).")
+
+(defconst tamil99-soft-consonants
+ '(("b" "ங")
+ ("]" "ஞ")
+ ("p" "ண")
+ (";" "ந")
+ ("k" "ம")
+ ("i" "ன"))
+ "Mapping for soft consonants (மெல்லினம்).")
+
+(defconst tamil99-medium-consonants
+ '(("'" "ய")
+ ("m" "ர")
+ ("n" "ல")
+ ("v" "வ")
+ ("/" "ழ")
+ ("y" "ள"))
+ "Mapping for medium consonants (இடையினம்).")
+
+(defconst tamil99-grantham-consonants
+ '(("Q" "ஸ")
+ ("W" "ஷ")
+ ("E" "ஜ")
+ ("R" "ஹ"))
+ "Mapping for grantham consonants (கிரந்தம்).")
+
+(defconst tamil99-consonants
+ (append tamil99-hard-consonants
+ tamil99-soft-consonants
+ tamil99-medium-consonants
+ tamil99-grantham-consonants)
+ "Mapping for all consonants.")
+
+(defconst tamil99-other
+ `(("T" ,(vector "க்ஷ"))
+ ("Y" ,(vector "ஶஂரீ"))
+ ("O" "[")
+ ("P" "]")
+ ("A" "௹")
+ ("S" "௺")
+ ("D" "௸")
+ ("F" "ஃ")
+ ("K" "\"")
+ ("L" ":")
+ (":" ";")
+ ("\"" "'")
+ ("Z" "௳")
+ ("X" "௴")
+ ("C" "௵")
+ ("V" "௶")
+ ("B" "௷")
+ ("M" "/"))
+ "Mapping for miscellaneous characters.")
+
+;; உயிர்
+;; vowel
+(mapc (pcase-lambda (`(,vowel-key ,vowel))
+ (quail-defrule vowel-key vowel))
+ tamil99-vowels)
+
+(mapc (pcase-lambda (`(,consonant-key ,consonant))
+ ;; அகர உயிர்மெய்
+ ;; consonant symbol (consonant combined with the first vowel அ)
+ (quail-defrule consonant-key consonant)
+ ;; மெய்யொற்று பின் அகர உயிர்மெய்
+ ;; pulli on double consonant
+ (quail-defrule (concat consonant-key consonant-key)
+ (vector (concat consonant "்" consonant)))
+ (mapc (pcase-lambda (`(,vowel-key ,vowel-modifier))
+ ;; உயிர்மெய்
+ ;; vowelised consonant
+ (quail-defrule (concat consonant-key vowel-key)
+ (vector (concat consonant vowel-modifier)))
+ ;; மெய்யொற்று பின் பிற உயிர்மெய்
+ ;; vowelised consonant after double consonant
+ (quail-defrule (concat consonant-key consonant-key vowel-key)
+ (vector (concat consonant "்" consonant
vowel-modifier))))
+ tamil99-vowel-modifiers))
+ tamil99-consonants)
+
+(seq-mapn (pcase-lambda (`(,soft-consonant-key ,soft-consonant)
+ `(,hard-consonant-key ,hard-consonant))
+ ;; மெல்லினம் பின் வல்லினம்
+ ;; hard consonant after soft consonant
+ (quail-defrule (concat soft-consonant-key hard-consonant-key)
+ (vector (concat soft-consonant "்" hard-consonant)))
+ (mapc (pcase-lambda (`(,vowel-key ,vowel-modifier))
+ ;; மெல்லின ஒற்றொட்டிய வல்லினம் பின் உயிர்மெய்
+ ;; vowelised consonant after soft-hard consonant pair
+ (quail-defrule (concat soft-consonant-key
hard-consonant-key vowel-key)
+ (vector (concat soft-consonant "்"
hard-consonant vowel-modifier))))
+ tamil99-vowel-modifiers))
+ tamil99-soft-consonants
+ tamil99-hard-consonants)
+
+;; பிற வரியுருக்கள்
+;; other characters
+(mapc (pcase-lambda (`(,key ,translation))
+ (quail-defrule key translation))
+ tamil99-other)
+
;; Probhat Input Method
(quail-define-package
"bengali-probhat" "Bengali" "BngPB" t
diff --git a/lisp/leim/quail/misc-lang.el b/lisp/leim/quail/misc-lang.el
index dad5cfc3e3..73287ee784 100644
--- a/lisp/leim/quail/misc-lang.el
+++ b/lisp/leim/quail/misc-lang.el
@@ -1558,5 +1558,122 @@
("n" ?𐌽)
("m" ?𐌼))
+(quail-define-package
+ "coptic" "Coptic" "Ⲁ" nil "Coptic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?𐋡)
+ ("`1" ?1)
+ ("`!" ?𐋠)
+ ("2" ?𐋢)
+ ("`2" ?2)
+ ("3" ?𐋣)
+ ("`3" ?3)
+ ("4" ?𐋤)
+ ("`4" ?4)
+ ("5" ?𐋥)
+ ("`5" ?5)
+ ("6" ?𐋦)
+ ("`6" ?6)
+ ("7" ?𐋧)
+ ("`7" ?7)
+ ("8" ?𐋨)
+ ("`8" ?8)
+ ("9" ?𐋩)
+ ("`9" ?9)
+ ("10" ?𐋪)
+ ("20" ?𐋫)
+ ("30" ?𐋬)
+ ("40" ?𐋭)
+ ("50" ?𐋮)
+ ("60" ?𐋯)
+ ("70" ?𐋰)
+ ("80" ?𐋱)
+ ("90" ?𐋲)
+ ("100" ?𐋳)
+ ("200" ?𐋴)
+ ("300" ?𐋵)
+ ("400" ?𐋶)
+ ("500" ?𐋷)
+ ("600" ?𐋸)
+ ("700" ?𐋹)
+ ("800" ?𐋺)
+ ("900" ?𐋻)
+ ("1/2" ?⳽)
+
+ ("q" ?ⲑ)
+ ("Q" ?Ⲑ)
+ ("w" ?ⲱ)
+ ("W" ?Ⲱ)
+ ("e" ?ⲉ)
+ ("E" ?Ⲉ)
+ ("r" ?ⲣ)
+ ("R" ?Ⲣ)
+ ("t" ?ⲧ)
+ ("T" ?Ⲧ)
+ ("ti" ?ϯ)
+ ("Ti" ?Ϯ)
+ ("y" ?ⲏ)
+ ("Y" ?Ⲏ)
+ ("u" ?ⲩ)
+ ("U" ?Ⲩ)
+ ("i" ?ⲓ)
+ ("I" ?Ⲓ)
+ ("o" ?ⲟ)
+ ("O" ?Ⲟ)
+ ("p" ?ⲡ)
+ ("P" ?Ⲡ)
+ ("ps" ?ⲯ)
+ ("Ps" ?Ⲯ)
+ ("a" ?ⲁ)
+ ("A" ?Ⲁ)
+ ("s" ?ⲥ)
+ ("S" ?Ⲥ)
+ ("`s" ?ⲋ)
+ ("`S" ?Ⲋ)
+ ("sh" ?ϣ)
+ ("Sh" ?Ϣ)
+ ("d" ?ⲇ)
+ ("D" ?Ⲇ)
+ ("f" ?ⲫ)
+ ("F" ?Ⲫ)
+ ("g" ?ⲅ)
+ ("G" ?Ⲅ)
+ ("h" ?ϩ)
+ ("H" ?Ϩ)
+ ("j" ?ϫ)
+ ("J" ?Ϫ)
+ ("k" ?ⲕ)
+ ("K" ?Ⲕ)
+ ("kh" ?ⲭ)
+ ("Kh" ?Ⲭ)
+ ("l" ?ⲗ)
+ ("L" ?Ⲗ)
+ ("z" ?ⲍ)
+ ("Z" ?Ⲍ)
+ ("x" ?ⲝ)
+ ("X" ?Ⲝ)
+ ("`x" ?ϧ)
+ ("`X" ?Ϧ)
+ ("c" ?ϭ)
+ ("C" ?Ϭ)
+ ("v" ?ϥ)
+ ("V" ?Ϥ)
+ ("b" ?ⲃ)
+ ("B" ?Ⲃ)
+ ("n" ?ⲛ)
+ ("N" ?Ⲛ)
+ ("`n" ?⳯)
+ ("m" ?ⲙ)
+ ("M" ?Ⲙ)
+
+ ("`," ?⳰)
+ ("`<" ?⳱)
+ ("`." ?⳾)
+ ("`/" ?⳿))
+
(provide 'misc-lang)
;;; misc-lang.el ends here
diff --git a/lisp/leim/quail/slovak.el b/lisp/leim/quail/slovak.el
index acde11d02a..8ddd92d5b4 100644
--- a/lisp/leim/quail/slovak.el
+++ b/lisp/leim/quail/slovak.el
@@ -3,7 +3,8 @@
;; Copyright (C) 1998, 2001-2022 Free Software Foundation, Inc.
;; Authors: Tibor Šimko <tibor.simko@fmph.uniba.sk>
-;; Milan Zamazal <pdm@zamazal.org>
+;; Milan Zamazal <pdm@zamazal.org>
+;; Rudolf Adamkovič <salutis@me.com>
;; Maintainer: Pavel Janík <Pavel@Janik.cz>
;; Keywords: i18n, multilingual, input method, Slovak
@@ -25,8 +26,9 @@
;;; Commentary:
;; This file defines the following Slovak keyboards:
-;; - standard Slovak keyboard
+;; - standard Slovak keyboards, QWERTZ and QWERTY variants
;; - three Slovak keyboards for programmers
+;; LocalWords: QWERTZ
;;; Code:
@@ -35,7 +37,7 @@
(quail-define-package
"slovak" "Slovak" "SK" t
- "Standard Slovak keyboard."
+ "Standard Slovak QWERTZ keyboard."
nil t nil nil t nil nil nil nil nil t)
(quail-define-rules
@@ -154,6 +156,123 @@
("+0" ?\)))
+(quail-define-package
+ "slovak-qwerty" "Slovak" "SK" t
+ "Standard Slovak QWERTY keyboard."
+ nil t nil nil t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?+)
+ ("2" ?ľ)
+ ("3" ?š)
+ ("4" ?č)
+ ("5" ?ť)
+ ("6" ?ž)
+ ("7" ?ý)
+ ("8" ?á)
+ ("9" ?í)
+ ("0" ?é)
+ ("!" ?1)
+ ("@" ?2)
+ ("#" ?3)
+ ("$" ?4)
+ ("%" ?5)
+ ("^" ?6)
+ ("&" ?7)
+ ("*" ?8)
+ ("(" ?9)
+ (")" ?0)
+ ("-" ?=)
+ ("_" ?%)
+ ("=" ?')
+ ("[" ?ú)
+ ("{" ?/)
+ ("]" ?ä)
+ ("}" ?\()
+ ("\\" ?ň)
+ ("|" ?\))
+ (";" ?ô)
+ (":" ?\")
+ ("'" ?§)
+ ("\"" ?!)
+ ("<" ??)
+ (">" ?:)
+ ("/" ?-)
+ ("?" ?_)
+ ("`" ?\;)
+ ("~" ?^)
+ ("=a" ?á)
+ ("+a" ?ä)
+ ("+=a" ?ä)
+ ("+c" ?č)
+ ("+d" ?ď)
+ ("=e" ?é)
+ ("+e" ?ě)
+ ("=i" ?í)
+ ("=l" ?ĺ)
+ ("+l" ?ľ)
+ ("+n" ?ň)
+ ("=o" ?ó)
+ ("+o" ?ô)
+ ("~o" ?ô)
+ ("+=o" ?ö)
+ ("=r" ?ŕ)
+ ("+r" ?ř)
+ ("=s" ?ß)
+ ("+s" ?š)
+ ("+t" ?ť)
+ ("=u" ?ú)
+ ("+u" ?ů)
+ ("+=u" ?ü)
+ ("=y" ?ý)
+ ("+z" ?ž)
+ ("=A" ?Á)
+ ("+A" ?Ä)
+ ("+=A" ?Ä)
+ ("+C" ?Č)
+ ("+D" ?Ď)
+ ("=E" ?É)
+ ("+E" ?Ě)
+ ("=I" ?Í)
+ ("=L" ?Ĺ)
+ ("+L" ?Ľ)
+ ("+N" ?Ň)
+ ("=O" ?Ó)
+ ("+O" ?Ô)
+ ("~O" ?Ô)
+ ("+=O" ?Ö)
+ ("=R" ?Ŕ)
+ ("+R" ?Ř)
+ ("=S" ?ß)
+ ("+S" ?Š)
+ ("+T" ?Ť)
+ ("=U" ?Ú)
+ ("+U" ?Ů)
+ ("+=U" ?Ü)
+ ("=Y" ?Ý)
+ ("+Z" ?Ž)
+ ("=q" ?`)
+ ("=2" ?@)
+ ("=3" ?#)
+ ("=4" ?$)
+ ("=5" ?%)
+ ("=6" ?^)
+ ("=7" ?&)
+ ("=8" ?*)
+ ("=9" ?\()
+ ("=0" ?\))
+ ("+1" ?!)
+ ("+2" ?@)
+ ("+3" ?#)
+ ("+4" ?$)
+ ("+5" ?%)
+ ("+6" ?^)
+ ("+7" ?&)
+ ("+8" ?*)
+ ("+9" ?\()
+ ("+0" ?\)))
+
+
(quail-define-package
"slovak-prog-1" "Slovak" "SK" t
"Slovak (non-standard) keyboard for programmers #1.
diff --git a/lisp/loadup.el b/lisp/loadup.el
index cf8552dc52..02b4cc6e55 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -501,7 +501,10 @@ lost after dumping")))
bin-dest-dir)
;; Relative filename from the built uninstalled binary.
(file-relative-name file invocation-directory)))))
- comp-loaded-comp-units-h))))
+ comp-loaded-comp-units-h)))
+ ;; Set up the mechanism to allow inhibiting native-comp via
+ ;; file-local variables.
+ (defvar comp--no-native-compile (make-hash-table :test #'equal)))
(when (hash-table-p purify-flag)
(let ((strings 0)
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 812e9a201b..f095d5e9c0 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -4693,15 +4693,23 @@ Argument MIME is non-nil if this is a mime message."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "--------------[0-9a-zA-Z]+\n" nil t)
- (let ((delim (concat (substring (match-string 0) 0 -1) "--\n")))
+ ;; The ending delimiter is a start delimiter if another section follows.
+ ;; Otherwise it is an end delimiter, with -- affixed.
+ (let ((delim (concat (substring (match-string 0) 0 -1) "\\(\\|--\\)\n")))
(when (looking-at "\
Content-Type: text/[a-z]+; charset=UTF-8; format=flowed
Content-Transfer-Encoding: base64\n")
(goto-char (match-end 0))
+ ;; Sometimes the attachment's headers are followed by blank lines
+ (while (eolp)
+ (forward-line 1))
(let ((start (point))
(inhibit-read-only t))
- (search-forward delim)
+ (re-search-forward delim)
(forward-line -1)
+ ;; Sometimes the attachment's contents are followed by blank lines
+ (while (save-excursion (forward-line -1) (eolp))
+ (forward-line -1))
(base64-decode-region start (point))
(forward-line 1)))))))
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index c2c18320b1..849e0f7723 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -527,12 +527,12 @@
`(menu-item "Paste" yank
:enable (funcall
',(lambda ()
- (and (or
+ (and (not buffer-read-only)
+ (or
(gui-backend-selection-exists-p
'CLIPBOARD)
(if (featurep 'ns) ; like paste-from-menu
(cdr yank-menu)
- kill-ring))
- (not buffer-read-only))))
+ kill-ring)))))
:help "Paste (yank) text most recently cut/copied"
:keys ,(lambda ()
(if cua-mode
@@ -1847,6 +1847,10 @@ mail status in mode line"))
:help "Toggle automatic parsing in source code buffers
(Semantic mode)"
:button (:toggle . (bound-and-true-p semantic-mode))))
+ (bindings--define-key menu [eglot]
+ '(menu-item "Language Server Support (Eglot)" eglot
+ :help "Start language server suitable for this buffer's
major-mode"))
+
(bindings--define-key menu [ede]
'(menu-item "Project Support (EDE)"
global-ede-mode
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index be1b7642eb..38a8216dc0 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -402,7 +402,7 @@ information can be used so that you can replace multiple
Bogofilter is a Bayesian spam filtering program. Get it from your
local distribution or from the bogofilter web site at URL
-`http://bogofilter.sourceforge.net/'.
+`https://bogofilter.sourceforge.io/'.
Bogofilter is taught by running:
@@ -487,7 +487,7 @@ See `mh-bogofilter-blocklist' for more information."
SpamProbe is a Bayesian spam filtering program. Get it from your
local distribution or from the SpamProbe web site at URL
-`http://spamprobe.sourceforge.net'.
+`https://spamprobe.sourceforge.net'.
To use SpamProbe, add the following recipes to \".procmailrc\":
diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el
index ba7e68eb81..935c9111ee 100644
--- a/lisp/minibuf-eldef.el
+++ b/lisp/minibuf-eldef.el
@@ -110,8 +110,7 @@ should be displayed in its place.")
"Set up a minibuffer for `minibuffer-electric-default-mode'.
The prompt and initial input should already have been inserted."
(let ((regexps minibuffer-default-in-prompt-regexps)
- (match nil)
- (inhibit-point-motion-hooks t))
+ (match nil))
(save-excursion
(save-restriction
;; Narrow to only the prompt.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index bf9321c5fa..7a53a958cd 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1239,9 +1239,9 @@ pair of a group title string and a list of group
candidate strings."
:version "28.1")
(defface completions-group-separator
- '((t :inherit shadow :strike-through t))
+ '((t :inherit shadow :underline t))
"Face used for the separator lines between the candidate groups."
- :version "28.1")
+ :version "29.1")
(defun completion--cycle-threshold (metadata)
(let* ((cat (completion-metadata-get metadata 'category))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 2d528c4862..1597f3651a 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -1294,6 +1294,11 @@ currently selected window instead."
(let ((file (url-unhex-string (url-filename parsed))))
(when-let ((coding (browse-url--file-name-coding-system)))
(setq file (decode-coding-string file 'utf-8)))
+ ;; The local-part of file: URLs on Windows is supposed to
+ ;; start with an extra slash.
+ (when (eq system-type 'windows-nt)
+ (setq file (replace-regexp-in-string
+ "\\`/\\([a-z]:\\)" "\\1" file)))
(funcall func file))
(let ((file-name-handler-alist
(cons (cons url-handler-regexp 'url-file-handler)
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index 4c52382c67..b8f5018005 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -1173,7 +1173,10 @@ allows editing it."
(defun dictionary-lookup-definition ()
"Unconditionally lookup the word at point."
(interactive)
- (dictionary-new-search (cons (current-word) dictionary-default-dictionary)))
+ (let ((word (current-word)))
+ (unless word
+ (error "No word at point"))
+ (dictionary-new-search (cons word dictionary-default-dictionary))))
(defun dictionary-previous ()
"Go to the previous location in the current buffer."
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 40cb25fca2..5f9e78fc7f 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -106,44 +106,39 @@
;; Split the string just in case.
(version<= "3" (car (split-string bbdb-version)))))
+(defun eudc--plist-member (plist prop &optional predicate)
+ "Like `plist-member', but signal on invalid PLIST."
+ (or (plistp plist)
+ (signal 'wrong-type-argument `(plistp ,plist)))
+ (plist-member plist prop predicate))
+
(defun eudc-plist-member (plist prop)
- "Return t if PROP has a value specified in PLIST."
- (if (not (= 0 (% (length plist) 2)))
- (error "Malformed plist"))
- (catch 'found
- (while plist
- (if (eq prop (car plist))
- (throw 'found t))
- (setq plist (cdr (cdr plist))))
- nil))
+ "Return t if PROP has a value specified in PLIST.
+Signal an error if PLIST is not a valid property list."
+ (and (eudc--plist-member plist prop) t))
-;; Emacs's plist-get lacks third parameter
+;; Emacs's `plist-get' lacks a default parameter, and CL-Lib's
+;; `cl-getf' doesn't accept a predicate or signal an error.
(defun eudc-plist-get (plist prop &optional default)
- "Extract a value from a property list.
-PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
-corresponding to the given PROP, or DEFAULT if PROP is not
-one of the properties on the list."
- (if (eudc-plist-member plist prop)
- (plist-get plist prop)
- default))
+ "Extract the value of PROP in property list PLIST.
+PLIST is a list of the form (PROP1 VALUE1 PROP2 VALUE2...).
+This function returns the first value corresponding to the given
+PROP, or DEFAULT if PROP is not one of the properties in the
+list. The comparison with PROP is done using `eq'. If PLIST is
+not a valid property list, this function signals an error."
+ (let ((tail (eudc--plist-member plist prop)))
+ (if tail (cadr tail) default)))
(defun eudc-lax-plist-get (plist prop &optional default)
- "Extract a value from a lax property list.
-
-PLIST is a lax property list, which is a list of the form (PROP1
-VALUE1 PROP2 VALUE2...), where comparisons between properties are done
-using `equal' instead of `eq'. This function returns the value
-corresponding to PROP, or DEFAULT if PROP is not one of the
-properties on the list."
- (if (not (= 0 (% (length plist) 2)))
- (error "Malformed plist"))
- (catch 'found
- (while plist
- (if (equal prop (car plist))
- (throw 'found (car (cdr plist))))
- (setq plist (cdr (cdr plist))))
- default))
+ "Extract the value of PROP from lax property list PLIST.
+PLIST is a list of the form (PROP1 VALUE1 PROP2 VALUE2...), where
+comparisons between properties are done using `equal' instead of
+`eq'. This function returns the first value corresponding to
+PROP, or DEFAULT if PROP is not one of the properties in the
+list. If PLIST is not a valid property list, this function
+signals an error."
+ (let ((tail (eudc--plist-member plist prop #'equal)))
+ (if tail (cadr tail) default)))
(defun eudc-replace-in-string (str regexp newtext)
"Replace all matches in STR for REGEXP with NEWTEXT.
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 99ed14ca8b..86cf98004b 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -164,52 +164,51 @@ and `goto-address-fontify-p'."
;; Clean up from any previous go.
(goto-address-unfontify (or start (point-min)) (or end (point-max)))
(save-excursion
- (let ((inhibit-point-motion-hooks t))
+ (goto-char (or start (point-min)))
+ (when (or (eq t goto-address-fontify-maximum-size)
+ (< (- (or end (point-max)) (point))
+ goto-address-fontify-maximum-size))
+ (while (re-search-forward goto-address-url-regexp end t)
+ (let* ((s (match-beginning 0))
+ (e (match-end 0))
+ this-overlay)
+ (when (or (not goto-address-prog-mode)
+ ;; This tests for both comment and string
+ ;; syntax.
+ (nth 8 (syntax-ppss)))
+ (setq this-overlay (make-overlay s e))
+ (and goto-address-fontify-p
+ (overlay-put this-overlay 'face goto-address-url-face))
+ (overlay-put this-overlay 'evaporate t)
+ (overlay-put this-overlay
+ 'mouse-face goto-address-url-mouse-face)
+ (overlay-put this-overlay 'follow-link t)
+ (overlay-put this-overlay
+ 'help-echo "mouse-2, C-c RET: follow URL")
+ (overlay-put this-overlay
+ 'keymap goto-address-highlight-keymap)
+ (overlay-put this-overlay 'goto-address t))))
(goto-char (or start (point-min)))
- (when (or (eq t goto-address-fontify-maximum-size)
- (< (- (or end (point-max)) (point))
- goto-address-fontify-maximum-size))
- (while (re-search-forward goto-address-url-regexp end t)
- (let* ((s (match-beginning 0))
- (e (match-end 0))
- this-overlay)
- (when (or (not goto-address-prog-mode)
- ;; This tests for both comment and string
- ;; syntax.
- (nth 8 (syntax-ppss)))
- (setq this-overlay (make-overlay s e))
- (and goto-address-fontify-p
- (overlay-put this-overlay 'face goto-address-url-face))
- (overlay-put this-overlay 'evaporate t)
- (overlay-put this-overlay
- 'mouse-face goto-address-url-mouse-face)
- (overlay-put this-overlay 'follow-link t)
- (overlay-put this-overlay
- 'help-echo "mouse-2, C-c RET: follow URL")
- (overlay-put this-overlay
- 'keymap goto-address-highlight-keymap)
- (overlay-put this-overlay 'goto-address t))))
- (goto-char (or start (point-min)))
- (while (re-search-forward goto-address-mail-regexp end t)
- (let* ((s (match-beginning 0))
- (e (match-end 0))
- this-overlay)
- (when (or (not goto-address-prog-mode)
- ;; This tests for both comment and string
- ;; syntax.
- (nth 8 (syntax-ppss)))
- (setq this-overlay (make-overlay s e))
- (and goto-address-fontify-p
- (overlay-put this-overlay 'face goto-address-mail-face))
- (overlay-put this-overlay 'evaporate t)
- (overlay-put this-overlay 'mouse-face
- goto-address-mail-mouse-face)
- (overlay-put this-overlay 'follow-link t)
- (overlay-put this-overlay
- 'help-echo "mouse-2, C-c RET: mail this address")
- (overlay-put this-overlay
- 'keymap goto-address-highlight-keymap)
- (overlay-put this-overlay 'goto-address t))))))))
+ (while (re-search-forward goto-address-mail-regexp end t)
+ (let* ((s (match-beginning 0))
+ (e (match-end 0))
+ this-overlay)
+ (when (or (not goto-address-prog-mode)
+ ;; This tests for both comment and string
+ ;; syntax.
+ (nth 8 (syntax-ppss)))
+ (setq this-overlay (make-overlay s e))
+ (and goto-address-fontify-p
+ (overlay-put this-overlay 'face goto-address-mail-face))
+ (overlay-put this-overlay 'evaporate t)
+ (overlay-put this-overlay 'mouse-face
+ goto-address-mail-mouse-face)
+ (overlay-put this-overlay 'follow-link t)
+ (overlay-put this-overlay
+ 'help-echo "mouse-2, C-c RET: mail this address")
+ (overlay-put this-overlay
+ 'keymap goto-address-highlight-keymap)
+ (overlay-put this-overlay 'goto-address t)))))))
(defun goto-address-fontify-region (start end)
"Fontify URLs and e-mail addresses in the given region."
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 062ff05d69..ccad8c4edb 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -715,14 +715,14 @@ an alist of attribute/value pairs."
(eq (string-match "/\\(.:.*\\)$" value) 0))
(setq value (match-string 1 value)))
;; Do not try to open non-existent files
- (if (equal value "")
- (setq value " ")
- (with-current-buffer bufval
+ (if (match-string 3)
+ (with-current-buffer bufval
(erase-buffer)
(set-buffer-multibyte nil)
(insert-file-contents-literally value)
(delete-file value)
- (setq value (buffer-string))))
+ (setq value (buffer-string)))
+ (setq value " "))
(setq record (cons (list name value)
record))
(forward-line 1))
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index fa481ce528..eadaf00c4b 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -2176,9 +2176,11 @@ connection."
(defun rcirc-generate-log-filename (process target)
"Return filename for log file based on PROCESS and TARGET."
- (if target
- (rcirc-generate-new-buffer-name process target)
- (process-name process)))
+ (concat
+ (if target
+ (rcirc-generate-new-buffer-name process target)
+ (process-name process))
+ ".log"))
(defcustom rcirc-log-filename-function 'rcirc-generate-log-filename
"A function to generate the filename used by rcirc's logging facility.
@@ -3018,11 +3020,7 @@ for nick completion."
:version "29.1")
(defface rcirc-bridged-nick
- '((((class color) (min-colors 88) (background light)) :background
"SlateGray1")
- (((class color) (min-colors 88) (background dark)) :background
"DarkSlateGray4")
- (((class color) (min-colors 16) (background light)) :background
"LightBlue")
- (((class color) (min-colors 16) (background dark)) :background
"DarkSlateGray")
- (t :background "blue"))
+ '((t :inherit highlight))
"Face used for pseudo-nick ."
:version "29.1")
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index 35c0636b1c..78107e1a03 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -125,6 +125,8 @@ been set up by `rfn-eshadow-setup-minibuffer'."
;; eshell.el keeps the path in `eshell-path-env'. We must change it
;; when `default-directory' points to another host.
+;; This is fixed in Eshell with Emacs 29.1.
+
(defun tramp-eshell-directory-change ()
"Set `eshell-path-env' to $PATH of the host related to `default-directory'."
;; Remove last element of `(exec-path)', which is `exec-directory'.
@@ -136,16 +138,17 @@ been set up by `rfn-eshadow-setup-minibuffer'."
(getenv "PATH"))))
(with-eval-after-load 'esh-util
- (add-hook 'eshell-mode-hook
- #'tramp-eshell-directory-change)
- (add-hook 'eshell-directory-change-hook
- #'tramp-eshell-directory-change)
- (add-hook 'tramp-integration-unload-hook
- (lambda ()
- (remove-hook 'eshell-mode-hook
- #'tramp-eshell-directory-change)
- (remove-hook 'eshell-directory-change-hook
- #'tramp-eshell-directory-change))))
+ (unless (boundp 'eshell-path-env-list)
+ (add-hook 'eshell-mode-hook
+ #'tramp-eshell-directory-change)
+ (add-hook 'eshell-directory-change-hook
+ #'tramp-eshell-directory-change)
+ (add-hook 'tramp-integration-unload-hook
+ (lambda ()
+ (remove-hook 'eshell-mode-hook
+ #'tramp-eshell-directory-change)
+ (remove-hook 'eshell-directory-change-hook
+ #'tramp-eshell-directory-change)))))
;;; Integration of recentf.el:
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 3240f5352a..d74afc8412 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -789,8 +789,8 @@ use strict;
use warnings;
use POSIX qw(getgroups);
-my ($user, $passwd, $uid, $gid) = getpwuid $< ;
-my $group = getgrgid $gid ;
+my ( $uid, $user ) = ( $>, scalar getpwuid $> );
+my ( $gid, $group ) = ( $), scalar getgrgid $) );
my @groups = map { $_ . \"(\" . getgrgid ($_) . \")\" } getgroups ();
printf \"uid=%%d(%%s) gid=%%d(%%s) groups=%%s\\n\",
@@ -2827,11 +2827,14 @@ the result will be a local, non-Tramp, file name."
;; Handle empty NAME.
(when (zerop (length name)) (setq name "."))
;; On MS Windows, some special file names are not returned properly
- ;; by `file-name-absolute-p'.
- (if (and (eq system-type 'windows-nt)
- (string-match-p
- (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device)
eol)))
- name))
+ ;; by `file-name-absolute-p'. If `tramp-syntax' is `simplified',
+ ;; there could be the falso positive "/:".
+ (if (or (and (eq system-type 'windows-nt)
+ (string-match-p
+ (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device)
eol)))
+ name))
+ (and (not (tramp-tramp-file-p name))
+ (not (tramp-tramp-file-p dir))))
(tramp-run-real-handler #'expand-file-name (list name dir))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index dc87c590b3..bc8739c4d6 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -369,33 +369,36 @@ the result will be a local, non-Tramp, file name."
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
- (with-parsed-tramp-file-name name nil
- ;; Tilde expansion if necessary. We cannot accept "~/", because
- ;; under sudo "~/" is expanded to the local user home directory
- ;; but to the root home directory.
- (when (zerop (length localname))
- (setq localname "~"))
- (unless (file-name-absolute-p localname)
- (setq localname (format "~%s/%s" user localname)))
- (when (string-match
- (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos)
- localname)
- (let ((uname (match-string 1 localname))
- (fname (match-string 2 localname))
- hname)
- (when (zerop (length uname))
- (setq uname user))
- (when (setq hname (tramp-get-home-directory v uname))
- (setq localname (concat hname fname)))))
- ;; Do not keep "/..".
- (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
- (setq localname "/"))
- ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
- (tramp-make-tramp-file-name
- v (if (string-prefix-p "~" localname)
- localname
- (tramp-run-real-handler
- #'expand-file-name (list localname))))))
+ ;; If NAME is not a Tramp file, run the real handler.
+ (if (not (tramp-tramp-file-p name))
+ (tramp-run-real-handler #'expand-file-name (list name))
+ (with-parsed-tramp-file-name name nil
+ ;; Tilde expansion if necessary. We cannot accept "~/", because
+ ;; under sudo "~/" is expanded to the local user home directory
+ ;; but to the root home directory.
+ (when (zerop (length localname))
+ (setq localname "~"))
+ (unless (file-name-absolute-p localname)
+ (setq localname (format "~%s/%s" user localname)))
+ (when (string-match
+ (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl))
eos)
+ localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
+ ;; Do not keep "/..".
+ (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
+ (setq localname "/"))
+ ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
+ (tramp-make-tramp-file-name
+ v (if (string-prefix-p "~" localname)
+ localname
+ (tramp-run-real-handler
+ #'expand-file-name (list localname)))))))
(defun tramp-sudoedit-remote-acl-p (vec)
"Check, whether ACL is enabled on the remote host."
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 03dc47a053..c06adb01e8 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1088,34 +1088,18 @@ Derived from `tramp-postfix-host-format'.")
(defun tramp-build-remote-file-name-spec-regexp ()
"Construct a regexp matching a Tramp file name for a Tramp syntax.
It is expected, that `tramp-syntax' has the proper value."
- ;; Starting with Emacs 27, we can use `rx-let'.
- (let* ((user-regexp
- (tramp-compat-rx
- (group-n 6 (regexp tramp-user-regexp))
- (regexp tramp-postfix-user-regexp)))
- (host-regexp
- (tramp-compat-rx
- (group-n 7 (| (regexp tramp-host-regexp)
- (: (regexp tramp-prefix-ipv6-regexp)
- (? (regexp tramp-ipv6-regexp))
- (regexp tramp-postfix-ipv6-regexp)))
- ;; Optional port.
- (? (regexp tramp-prefix-port-regexp)
- (regexp tramp-port-regexp)))))
- (user-host-regexp
- (if (eq tramp-syntax 'simplified)
- ;; There must be either user or host.
- (tramp-compat-rx
- (| (: (regexp user-regexp) (? (regexp host-regexp)))
- (: (? (regexp user-regexp)) (regexp host-regexp))))
- (tramp-compat-rx
- (? (regexp user-regexp)) (? (regexp host-regexp))))))
- (tramp-compat-rx
- ;; Method.
- (group-n 5 (regexp tramp-method-regexp))
- (regexp tramp-postfix-method-regexp)
- ;; User and host.
- (regexp user-host-regexp))))
+ (tramp-compat-rx
+ ;; Method.
+ (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp)
+ ;; Optional user. This includes domain.
+ (? (group (regexp tramp-user-regexp)) (regexp tramp-postfix-user-regexp))
+ ;; Optional host.
+ (? (group (| (regexp tramp-host-regexp)
+ (: (regexp tramp-prefix-ipv6-regexp)
+ (? (regexp tramp-ipv6-regexp))
+ (regexp tramp-postfix-ipv6-regexp)))
+ ;; Optional port.
+ (? (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp))))))
(defvar tramp-remote-file-name-spec-regexp
nil ; Initialized when defining `tramp-syntax'!
@@ -1214,7 +1198,8 @@ The `ftp' syntax does not support methods.")
;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also
;; `tramp-drop-volume-letter'.
(? (regexp tramp-volume-letter-regexp))
- (regexp tramp-prefix-regexp)
+ ;; We cannot use `tramp-prefix-regexp', because it starts with `bol'.
+ (literal tramp-prefix-format)
;; Optional multi hops.
(* (regexp tramp-remote-file-name-spec-regexp)
@@ -1541,7 +1526,8 @@ same connection. Make a copy in order to avoid side
effects."
;; Comparison of file names is performed by `tramp-equal-remote'.
(defun tramp-file-name-equal-p (vec1 vec2)
- "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
+ "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'.
+LOCALNAME and HOP do not count."
(and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
(equal (tramp-file-name-unify vec1)
(tramp-file-name-unify vec2))))
@@ -1862,7 +1848,8 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME
&optional HOP)."
tramp-prefix-regexp ""
(replace-regexp-in-string
(tramp-compat-rx
- (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format
+ (regexp tramp-postfix-host-regexp) eos)
+ tramp-postfix-hop-format
(tramp-make-tramp-file-name vec 'noloc)))))
(defun tramp-completion-make-tramp-file-name (method user host localname)
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index dfe5c369e2..9cbab29504 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -536,8 +536,7 @@ Many aspects this mode can be customized using
(save-restriction
(widen)
(with-silent-modifications
- (nxml-with-invisible-motion
- (nxml-scan-prolog)))))
+ (nxml-scan-prolog))))
(setq-local syntax-ppss-table sgml-tag-syntax-table)
(setq-local syntax-propertize-function #'nxml-syntax-propertize)
(add-function :filter-return (local 'filter-buffer-substring-function)
@@ -584,8 +583,7 @@ Many aspects this mode can be customized using
(save-excursion
(widen)
(with-silent-modifications
- (nxml-with-invisible-motion
- (remove-text-properties (point-min) (point-max) '(face nil)))))
+ (remove-text-properties (point-min) (point-max) '(face nil))))
(remove-hook 'change-major-mode-hook #'nxml-cleanup t))
(defun nxml-degrade (context err)
diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el
index 662d43842e..241c54488f 100644
--- a/lisp/nxml/nxml-util.el
+++ b/lisp/nxml/nxml-util.el
@@ -65,12 +65,6 @@ This is the inverse of `nxml-make-namespace'."
(nxml-degrade ,context ,error-symbol))))
`(progn ,@body)))
-(defmacro nxml-with-invisible-motion (&rest body)
- "Evaluate body without calling any point motion hooks."
- (declare (indent 0) (debug t))
- `(let ((inhibit-point-motion-hooks t))
- ,@body))
-
(defun nxml-display-file-parse-error (err)
(let* ((filename (nth 1 err))
(buffer (find-file-noselect filename))
diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el
index ccbf4d8de2..b1beb19503 100644
--- a/lisp/nxml/rng-nxml.el
+++ b/lisp/nxml/rng-nxml.el
@@ -366,45 +366,44 @@ set `xmltok-dtd'. Returns the position of the end of the
token."
(save-excursion
(save-restriction
(widen)
- (nxml-with-invisible-motion
- (if (= pos (point-min))
- (rng-set-initial-state)
- (let ((state (get-text-property (1- pos) 'rng-state)))
- (cond (state
- (rng-restore-state state)
- (goto-char pos))
- (t
- (let ((start (previous-single-property-change pos
- 'rng-state)))
- (cond (start
- (rng-restore-state (get-text-property (1- start)
- 'rng-state))
- (goto-char start))
- (t (rng-set-initial-state))))))))
- (xmltok-save
- (if (= (point) 1)
- (xmltok-forward-prolog)
- (setq xmltok-dtd rng-dtd))
- (cond ((and (< pos (point))
- ;; This handles the case where the prolog ends
- ;; with a < without any following name-start
- ;; character. This will be treated by the parser
- ;; as part of the prolog, but we want to treat
- ;; it as the start of the instance.
- (eq (char-after pos) ?<)
- (<= (point)
- (save-excursion
- (goto-char (1+ pos))
- (skip-chars-forward " \t\r\n")
- (point))))
- pos)
- ((< (point) pos)
- (let ((rng-dt-namespace-context-getter
- '(nxml-ns-get-context))
- (rng-parsing-for-state t))
- (rng-forward pos))
- (point))
- (t pos)))))))
+ (if (= pos (point-min))
+ (rng-set-initial-state)
+ (let ((state (get-text-property (1- pos) 'rng-state)))
+ (cond (state
+ (rng-restore-state state)
+ (goto-char pos))
+ (t
+ (let ((start (previous-single-property-change pos
+ 'rng-state)))
+ (cond (start
+ (rng-restore-state (get-text-property (1- start)
+ 'rng-state))
+ (goto-char start))
+ (t (rng-set-initial-state))))))))
+ (xmltok-save
+ (if (= (point) 1)
+ (xmltok-forward-prolog)
+ (setq xmltok-dtd rng-dtd))
+ (cond ((and (< pos (point))
+ ;; This handles the case where the prolog ends
+ ;; with a < without any following name-start
+ ;; character. This will be treated by the parser
+ ;; as part of the prolog, but we want to treat
+ ;; it as the start of the instance.
+ (eq (char-after pos) ?<)
+ (<= (point)
+ (save-excursion
+ (goto-char (1+ pos))
+ (skip-chars-forward " \t\r\n")
+ (point))))
+ pos)
+ ((< (point) pos)
+ (let ((rng-dt-namespace-context-getter
+ '(nxml-ns-get-context))
+ (rng-parsing-for-state t))
+ (rng-forward pos))
+ (point))
+ (t pos))))))
(defun rng-adjust-state-for-attribute (lt-pos start)
(xmltok-save
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index 77fed8c32d..59e696e2cc 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -68,7 +68,7 @@ Signal an error if URI is not a valid file URL."
;; pattern is either nil or match or replace
(defun rng-uri-file-name-1 (uri pattern)
- (unless (string-match "\\`\\(?:[^%]\\|%[[:xdigit:]]{2}\\)*\\'" uri)
+ (unless (string-match "\\`\\(?:[^%]\\|%[[:xdigit:]]\\{2\\}\\)*\\'" uri)
(rng-uri-error "Bad escapes in URI `%s'" uri))
(setq uri (rng-uri-unescape-multibyte uri))
(let* ((components
@@ -312,7 +312,7 @@ Both FULL and BASE must be absolute URIs."
(defun rng-uri-unescape-unibyte (str)
(replace-regexp-in-string "%[0-7][[:xdigit:]]"
(lambda (h)
- (string-to-number (substring h 1) 16))
+ (string (string-to-number (substring h 1) 16)))
str
t
t))
@@ -325,8 +325,8 @@ Both FULL and BASE must be absolute URIs."
(regexp-quote
(if (= (length match) 1)
match
- (string-to-number (substring match 1)
- 16)))))
+ (string (string-to-number (substring match 1)
+ 16))))))
str
t
t))
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el
index ad5c9c7a15..d82c8470d7 100644
--- a/lisp/nxml/rng-valid.el
+++ b/lisp/nxml/rng-valid.el
@@ -441,25 +441,24 @@ The schema is set like `rng-auto-set-schema'."
(save-excursion
(save-restriction
(widen)
- (nxml-with-invisible-motion
- (condition-case-unless-debug err
- (and (rng-validate-prepare)
- (let ((rng-dt-namespace-context-getter '(nxml-ns-get-context)))
- (with-silent-modifications
- (rng-do-some-validation-1 continue-p-function))))
- ;; errors signaled from a function run by an idle timer
- ;; are ignored; if we don't catch them, validation
- ;; will get mysteriously stuck at a single place
- (rng-compile-error
- (message "Incorrect schema. %s" (nth 1 err))
- (rng-validate-mode 0)
- nil)
- (error
- (message "Internal error in rng-validate-mode triggered at buffer
position %d. %s"
- (point)
- (error-message-string err))
- (rng-validate-mode 0)
- nil))))))
+ (condition-case-unless-debug err
+ (and (rng-validate-prepare)
+ (let ((rng-dt-namespace-context-getter '(nxml-ns-get-context)))
+ (with-silent-modifications
+ (rng-do-some-validation-1 continue-p-function))))
+ ;; errors signaled from a function run by an idle timer
+ ;; are ignored; if we don't catch them, validation
+ ;; will get mysteriously stuck at a single place
+ (rng-compile-error
+ (message "Incorrect schema. %s" (nth 1 err))
+ (rng-validate-mode 0)
+ nil)
+ (error
+ (message "Internal error in rng-validate-mode triggered at buffer
position %d. %s"
+ (point)
+ (error-message-string err))
+ (rng-validate-mode 0)
+ nil)))))
(defun rng-validate-prepare ()
"Prepare to do some validation, initializing point and the state.
diff --git a/lisp/obsolete/linum.el b/lisp/obsolete/linum.el
index c6ce3d6d11..e94cf5086c 100644
--- a/lisp/obsolete/linum.el
+++ b/lisp/obsolete/linum.el
@@ -209,10 +209,7 @@ Linum mode is a buffer-local minor mode."
(overlay-put ov 'before-string
(propertize " " 'display `((margin left-margin)
,str)))
(overlay-put ov 'linum-str str))))
- ;; Text may contain those nasty intangible properties, but that
- ;; shouldn't prevent us from counting those lines.
- (let ((inhibit-point-motion-hooks t))
- (forward-line))
+ (forward-line)
(setq line (1+ line)))
(when (display-graphic-p)
(setq width (ceiling
diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el
index 4ee090e4ac..f50da0ea43 100644
--- a/lisp/org/ob-matlab.el
+++ b/lisp/org/ob-matlab.el
@@ -32,7 +32,7 @@
;; matlab.el required for interactive emacs sessions and matlab-mode
;; major mode for source code editing buffer
-;; http://matlab-emacs.sourceforge.net/
+;; https://matlab-emacs.sourceforge.net/
;;; Code:
(require 'ob)
diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el
index ced00fbdda..7a495e8e7f 100644
--- a/lisp/org/ob-plantuml.el
+++ b/lisp/org/ob-plantuml.el
@@ -30,7 +30,7 @@
;;; Requirements:
-;; plantuml | http://plantuml.sourceforge.net/
+;; plantuml | https://plantuml.com/
;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file (when
exec mode is `jar')
;;; Code:
diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el
index 6fc97ca399..67db49e9a6 100644
--- a/lisp/org/org-ctags.el
+++ b/lisp/org/org-ctags.el
@@ -47,7 +47,7 @@
;;
;; Install org mode
;; Ensure org-ctags.el is somewhere in your emacs load path.
-;; Download and install Exuberant ctags -- "http://ctags.sourceforge.net/";
+;; Download and install Exuberant ctags -- "https://ctags.sourceforge.net/";
;; Edit your .emacs file (see next section) and load emacs.
;; To put in your init file (.emacs):
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 7c4de03bc2..7a91a33b74 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -66,7 +66,7 @@
;;
;;
;; As of March 2009 Firefox users follow the steps documented on
-;; http://kb.mozillazine.org/Register_protocol, Opera setup is described here:
+;; https://kb.mozillazine.org/Register_protocol, Opera setup is described here:
;; http://www.opera.com/support/kb/view/535/
;;
;;
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 6f92cdeab5..7de907590e 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -5929,10 +5929,7 @@ If TAG is a number, get the corresponding match group."
(defun org-unfontify-region (beg end &optional _maybe_loudly)
"Remove fontification and activation overlays from links."
(font-lock-default-unfontify-region beg end)
- (let* ((buffer-undo-list t)
- (inhibit-read-only t) (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- deactivate-mark buffer-file-name buffer-file-truename)
+ (with-silent-modifications
(decompose-region beg end)
(remove-text-properties beg end
'(mouse-face t keymap t org-linked-text t
@@ -16702,10 +16699,9 @@ buffer boundaries with possible narrowing."
(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
"Remove inline-display overlay if a corresponding region is modified."
- (let ((inhibit-modification-hooks t))
- (when (and ov after)
- (delete ov org-inline-image-overlays)
- (delete-overlay ov))))
+ (when (and ov after)
+ (delete ov org-inline-image-overlays)
+ (delete-overlay ov)))
(defun org-remove-inline-images ()
"Remove inline display of images."
diff --git a/lisp/outline.el b/lisp/outline.el
index 93a9247f61..ef5249a146 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -281,37 +281,30 @@ This option is only in effect when
`outline-minor-mode-cycle' is non-nil."
[outline-1 outline-2 outline-3 outline-4
outline-5 outline-6 outline-7 outline-8])
-(defcustom outline-minor-mode-use-buttons '(derived-mode . help-mode)
+(defcustom outline-minor-mode-use-buttons nil
"Whether to display clickable buttons on the headings.
-The value should be a `buffer-match-p' condition.
-
These buttons can be used to hide and show the body under the heading.
-Note that this feature is not meant to be used in editing
-buffers (yet) -- that will be amended in a future version."
- :type 'buffer-predicate
- :safe #'booleanp
+When the value is `insert', additional placeholders for buttons are
+inserted to the buffer, so buttons are not only clickable,
+but also typing `RET' on them can hide and show the body.
+When the value is `in-margins', then clickable buttons are
+displayed in the margins before the headings.
+When the value is `t', clickable buttons are displayed
+in the buffer before the headings. The values `t' and
+`in-margins' can be used in editing buffers because they
+don't modify the buffer."
+ :type '(choice (const :tag "Do not use outline buttons" nil)
+ (const :tag "Show outline buttons in margins" in-margins)
+ (const :tag "Show outline buttons in buffer" t))
+ :safe #'symbolp
:version "29.1")
-(defvar-local outline--use-buttons nil
- "Non-nil when buffer displays clickable buttons on the headings.")
+(defvar-local outline--button-icons nil
+ "A list of pre-computed button icons.")
(defvar-local outline--use-rtl nil
"Non-nil when direction of clickable buttons is right-to-left.")
-(defcustom outline-minor-mode-use-margins '(and (derived-mode . special-mode)
- (not (derived-mode .
help-mode)))
- "Whether to display clickable buttons in the margins.
-The value should be a `buffer-match-p' condition.
-
-These buttons can be used to hide and show the body under the heading.
-Note that this feature is meant to be used in editing buffers."
- :type 'buffer-predicate
- :safe #'booleanp
- :version "29.1")
-
-(defvar-local outline--use-margins nil
- "Non-nil when buffer displays clickable buttons in the margins.")
-
(define-icon outline-open nil
'((image "outline-open.svg" "outline-open.pbm" :height (0.8 . em))
(emoji "🔽")
@@ -339,17 +332,26 @@ Note that this feature is meant to be used in editing
buffers."
:version "29.1")
(define-icon outline-open-in-margins outline-open
- '((image "outline-open.svg" "outline-open.pbm" :height 10))
+ '((image "outline-open.svg" "outline-open.pbm" :height 10)
+ (emoji "🔽")
+ (symbol "▼")
+ (text "v"))
"Icon used for buttons for opened sections in margins."
:version "29.1")
(define-icon outline-close-in-margins outline-close
- '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation -90))
+ '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation -90)
+ (emoji "▶️")
+ (symbol "▶")
+ (text ">"))
"Icon used for buttons for closed sections in margins."
:version "29.1")
(define-icon outline-close-rtl-in-margins outline-close-rtl
- '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation 90))
+ '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation 90)
+ (emoji "◀️")
+ (symbol "◀")
+ (text "<"))
"Right-to-left icon used for closed sections in margins."
:version "29.1")
@@ -475,7 +477,7 @@ outline font-lock faces to those of major mode."
(let ((regexp (concat "^\\(?:" outline-regexp "\\).*$")))
(while (re-search-forward regexp nil t)
(let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
- (overlay-put overlay 'outline-overlay t)
+ (overlay-put overlay 'outline-highlight t)
;; FIXME: Is it possible to override all underlying face attributes?
(when (or (memq outline-minor-mode-highlight '(append override))
(and (eq outline-minor-mode-highlight t)
@@ -499,30 +501,20 @@ See the command `outline-mode' for more information on
this mode."
(key-description outline-minor-mode-prefix)
outline-mode-prefix-map)
(if outline-minor-mode
(progn
- (cond
- ((buffer-match-p outline-minor-mode-use-margins (current-buffer))
- (setq-local outline--use-margins t))
- ((buffer-match-p outline-minor-mode-use-buttons (current-buffer))
- (setq-local outline--use-buttons t)))
- (when (and (or outline--use-buttons outline--use-margins)
- (eq (current-bidi-paragraph-direction) 'right-to-left))
- (setq-local outline--use-rtl t))
- (when outline--use-margins
- (if outline--use-rtl
- (setq-local right-margin-width (1+ right-margin-width))
- (setq-local left-margin-width (1+ left-margin-width)))
- (setq-local fringes-outside-margins t)
- ;; Force display of margins
- (set-window-buffer nil (window-buffer)))
- (when (or outline--use-buttons outline--use-margins)
+ (when outline-minor-mode-use-buttons
(add-hook 'after-change-functions
- (lambda (beg end _len)
- (when outline--use-buttons
- (remove-overlays beg end 'outline-button t))
- (when outline--use-margins
- (remove-overlays beg end 'outline-margin t))
- (outline--fix-up-all-buttons beg end))
- nil t))
+ #'outline--fix-buttons-after-change nil t)
+ (when (eq (current-bidi-paragraph-direction) 'right-to-left)
+ (setq-local outline--use-rtl t))
+ (setq-local outline--button-icons (outline--create-button-icons))
+ (when (eq outline-minor-mode-use-buttons 'in-margins)
+ (if outline--use-rtl
+ (setq-local right-margin-width (1+ right-margin-width))
+ (setq-local left-margin-width (1+ left-margin-width)))
+ (setq-local fringes-outside-margins t)
+ ;; Force display of margins
+ (when (eq (current-buffer) (window-buffer))
+ (set-window-buffer nil (window-buffer)))))
(when outline-minor-mode-highlight
(if (and global-font-lock-mode (font-lock-specified-p major-mode))
(progn
@@ -547,17 +539,17 @@ See the command `outline-mode' for more information on
this mode."
(if font-lock-fontified
(font-lock-remove-keywords nil outline-font-lock-keywords))
(font-lock-flush)
- (remove-overlays nil nil 'outline-overlay t))
- (when outline--use-buttons
- (remove-overlays nil nil 'outline-button t))
- (when outline--use-margins
- (remove-overlays nil nil 'outline-margin t)
- (if outline--use-rtl
- (setq-local right-margin-width (1- right-margin-width))
- (setq-local left-margin-width (1- left-margin-width)))
- (setq-local fringes-outside-margins nil)
- ;; Force removal of margins
- (set-window-buffer nil (window-buffer)))))
+ (remove-overlays nil nil 'outline-highlight t))
+ (when outline-minor-mode-use-buttons
+ (remove-overlays nil nil 'outline-button t)
+ (when (eq outline-minor-mode-use-buttons 'in-margins)
+ (if outline--use-rtl
+ (setq-local right-margin-width (1- right-margin-width))
+ (setq-local left-margin-width (1- left-margin-width)))
+ (setq-local fringes-outside-margins nil)
+ ;; Force removal of margins
+ (when (eq (current-buffer) (window-buffer))
+ (set-window-buffer nil (window-buffer)))))))
(defvar-local outline-heading-alist ()
"Alist associating a heading for every possible level.
@@ -1065,107 +1057,6 @@ If non-nil, EVENT should be a mouse event."
(mouse-set-point event))
(outline-flag-subtree t)))
-(defun outline--make-button-overlay (type)
- (let ((o (seq-find (lambda (o)
- (overlay-get o 'outline-button))
- (overlays-at (point)))))
- (unless o
- (setq o (make-overlay (point) (1+ (point))))
- (overlay-put o 'evaporate t)
- (overlay-put o 'follow-link 'mouse-face)
- (overlay-put o 'mouse-face 'highlight)
- (overlay-put o 'outline-button t))
- (let ((icon (icon-elements (if (eq type 'close)
- (if outline--use-rtl
- 'outline-close-rtl
- 'outline-close)
- 'outline-open)))
- (inhibit-read-only t))
- ;; In editing buffers we use overlays only, but in other buffers
- ;; we use a mix of text properties, text and overlays to make
- ;; movement commands work more logically.
- (when (derived-mode-p 'special-mode)
- (put-text-property (point) (1+ (point)) 'face (plist-get icon 'face)))
- (if-let ((image (plist-get icon 'image)))
- (overlay-put o 'display image)
- (overlay-put o 'display (concat (plist-get icon 'string)
- (string (char-after (point)))))
- (overlay-put o 'face (plist-get icon 'face))))
- o))
-
-(defun outline--make-margin-overlay (type)
- (let ((o (seq-find (lambda (o)
- (overlay-get o 'outline-margin))
- (overlays-at (point)))))
- (unless o
- (setq o (make-overlay (point) (1+ (point))))
- (overlay-put o 'evaporate t)
- (overlay-put o 'outline-margin t))
- (let ((icon (icon-elements (if (eq type 'close)
- (if outline--use-rtl
- 'outline-close-rtl-in-margins
- 'outline-close-in-margins)
- 'outline-open-in-margins)))
- (inhibit-read-only t))
- (overlay-put
- o 'before-string
- (propertize " " 'display
- `((margin ,(if outline--use-rtl
- 'right-margin 'left-margin))
- ,(or (plist-get icon 'image)
- (plist-get icon 'string))))))
- o))
-
-(defun outline--insert-open-button (&optional use-margins)
- (with-silent-modifications
- (save-excursion
- (beginning-of-line)
- (if use-margins
- (outline--make-margin-overlay 'open)
- (when (derived-mode-p 'special-mode)
- (let ((inhibit-read-only t))
- (insert " ")
- (beginning-of-line)))
- (let ((o (outline--make-button-overlay 'open)))
- (overlay-put o 'help-echo "Click to hide")
- (overlay-put o 'keymap
- (define-keymap
- "RET" #'outline-hide-subtree
- "<mouse-2>" #'outline-hide-subtree)))))))
-
-(defun outline--insert-close-button (&optional use-margins)
- (with-silent-modifications
- (save-excursion
- (beginning-of-line)
- (if use-margins
- (outline--make-margin-overlay 'close)
- (when (derived-mode-p 'special-mode)
- (let ((inhibit-read-only t))
- (insert " ")
- (beginning-of-line)))
- (let ((o (outline--make-button-overlay 'close)))
- (overlay-put o 'help-echo "Click to show")
- (overlay-put o 'keymap
- (define-keymap
- "RET" #'outline-show-subtree
- "<mouse-2>" #'outline-show-subtree)))))))
-
-(defun outline--fix-up-all-buttons (&optional from to)
- (when (or outline--use-buttons outline--use-margins)
- (when from
- (save-excursion
- (goto-char from)
- (setq from (line-beginning-position))))
- (outline-map-region
- (lambda ()
- (if (save-excursion
- (outline-end-of-heading)
- (seq-some (lambda (o) (eq (overlay-get o 'invisible) 'outline))
- (overlays-at (point))))
- (outline--insert-close-button outline--use-margins)
- (outline--insert-open-button outline--use-margins)))
- (or from (point-min)) (or to (point-max)))))
-
(define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1")
(defun outline-hide-leaves ()
@@ -1451,6 +1342,9 @@ convenient way to make a table of contents of the buffer."
(insert "\n\n"))))))
(kill-new (buffer-string)))))))
+
+;;; Initial visibility
+
(defcustom outline-default-state nil
"If non-nil, some headings are initially outlined.
@@ -1629,6 +1523,9 @@ LEVEL, decides of subtree visibility according to
beg end)))
(run-hooks 'outline-view-change-hook)))
+
+;;; Visibility cycling
+
(defun outline--cycle-state ()
"Return the cycle state of current heading.
Return either `hide-all', `headings-only', or `show-all'."
@@ -1742,6 +1639,103 @@ With a prefix argument, show headings up to that LEVEL."
(message "Show all")))))
+;;; Button/margin indicators
+
+(defun outline--create-button-icons ()
+ (pcase outline-minor-mode-use-buttons
+ ('in-margins
+ (mapcar
+ (lambda (icon-name)
+ (let* ((icon (icon-elements icon-name))
+ (face (plist-get icon 'face))
+ (string (plist-get icon 'string))
+ (image (plist-get icon 'image))
+ (display `((margin ,(if outline--use-rtl
+ 'right-margin 'left-margin))
+ ,(or image (if face (propertize
+ string 'face face)
+ string))))
+ (space (propertize " " 'display display)))
+ (if (and image face) (propertize space 'face face) space)))
+ (list 'outline-open-in-margins
+ (if outline--use-rtl
+ 'outline-close-rtl-in-margins
+ 'outline-close-in-margins))))
+ ('insert
+ (mapcar
+ (lambda (icon-name)
+ (icon-elements icon-name))
+ (list 'outline-open
+ (if outline--use-rtl 'outline-close-rtl 'outline-close))))
+ (_
+ (mapcar
+ (lambda (icon-name)
+ (propertize (icon-string icon-name)
+ 'mouse-face 'default
+ 'follow-link 'mouse-face
+ 'keymap (define-keymap "<mouse-2>" #'outline-cycle)))
+ (list 'outline-open
+ (if outline--use-rtl 'outline-close-rtl 'outline-close))))))
+
+(defun outline--insert-button (type)
+ (with-silent-modifications
+ (save-excursion
+ (beginning-of-line)
+ (let ((icon (nth (if (eq type 'close) 1 0) outline--button-icons))
+ (o (seq-find (lambda (o) (overlay-get o 'outline-button))
+ (overlays-at (point)))))
+ (unless o
+ (when (eq outline-minor-mode-use-buttons 'insert)
+ (let ((inhibit-read-only t))
+ (insert " ")
+ (beginning-of-line)))
+ (setq o (make-overlay (point) (1+ (point))))
+ (overlay-put o 'outline-button t)
+ (overlay-put o 'evaporate t))
+ (pcase outline-minor-mode-use-buttons
+ ('insert
+ (overlay-put o 'display (or (plist-get icon 'image)
+ (plist-get icon 'string)))
+ (overlay-put o 'face (plist-get icon 'face))
+ (overlay-put o 'follow-link 'mouse-face)
+ (overlay-put o 'mouse-face 'highlight)
+ (overlay-put o 'keymap (define-keymap
+ "RET" #'outline-cycle
+ "<mouse-2>" #'outline-cycle))
+ (overlay-put o 'help-echo (if (eq type 'close)
+ "Click to show"
+ "Click to hide")))
+ ('in-margins
+ (overlay-put o 'before-string icon)
+ (overlay-put o 'keymap (define-keymap "RET" #'outline-cycle)))
+ (_
+ (overlay-put o 'before-string icon)
+ (overlay-put o 'keymap (define-keymap "RET" #'outline-cycle))))))))
+
+(defun outline--fix-up-all-buttons (&optional from to)
+ (when outline-minor-mode-use-buttons
+ (when from
+ (save-excursion
+ (goto-char from)
+ (setq from (line-beginning-position))))
+ (outline-map-region
+ (lambda ()
+ (let ((close-p (save-excursion
+ (outline-end-of-heading)
+ (seq-some (lambda (o) (eq (overlay-get o 'invisible)
+ 'outline))
+ (overlays-at (point))))))
+ (outline--insert-button (if close-p 'close 'open))))
+ (or from (point-min)) (or to (point-max)))))
+
+(defun outline--fix-buttons-after-change (beg end _len)
+ ;; Handle whole lines
+ (save-excursion (goto-char beg) (setq beg (pos-bol)))
+ (save-excursion (goto-char end) (setq end (pos-eol)))
+ (remove-overlays beg end 'outline-button t)
+ (outline--fix-up-all-buttons beg end))
+
+
(defvar-keymap outline-navigation-repeat-map
"C-b" #'outline-backward-same-level
"b" #'outline-backward-same-level
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 6fe29d9dcf..8cb0aa3b7a 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -646,15 +646,12 @@ parts of the list.
The OFFSET argument is added to/taken away from the index that will be
used. This is really only useful with `first' and `last', for
accessing absolute argument positions."
- (setq index
- (if (eq index 'first)
- 0
- (if (eq index 'last)
- pcomplete-last
- (- pcomplete-index (or index 0)))))
- (if offset
- (setq index (+ index offset)))
- (nth index pcomplete-args))
+ (nth (+ (pcase index
+ ('first 0)
+ ('last pcomplete-last)
+ (_ (- pcomplete-index (or index 0))))
+ (or offset 0))
+ pcomplete-args))
(defun pcomplete-begin (&optional index offset)
"Return the beginning position of the INDEXth argument.
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index 34523fef05..e3a9507f1c 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -103,9 +103,24 @@ If the element is a function or a list of a function and a
number,
program))))
;;;###autoload
-(defun zone ()
- "Zone out, completely."
- (interactive)
+(defun zone (&optional pgm)
+ "Zone out, completely.
+With a prefix argument the user is prompted for a program to run.
+When called from Lisp the optional argument PGM can be used to
+run a specific program. The program must be a member of
+`zone-programs'."
+ (interactive
+ (and current-prefix-arg
+ (let ((choice (completing-read
+ "Program: "
+ (mapcar
+ (lambda (prog)
+ (substring (symbol-name prog) 9))
+ zone-programs)
+ nil t)))
+ (list (intern (concat "zone-pgm-" choice))))))
+ (unless pgm
+ (setq pgm (aref zone-programs (random (length zone-programs)))))
(save-window-excursion
(let ((f (selected-frame))
(outbuf (get-buffer-create "*zone*"))
@@ -124,9 +139,8 @@ If the element is a function or a list of a function and a
number,
(untabify (point-min) (point-max))
(set-window-start (selected-window) (point-min))
(set-window-point (selected-window) wp)
- (sit-for 0 500)
- (let ((pgm (elt zone-programs (random (length zone-programs))))
- (ct (and f (frame-parameter f 'cursor-type)))
+ (sit-for 0.500)
+ (let ((ct (and f (frame-parameter f 'cursor-type)))
(show-trailing-whitespace nil)
restore)
(when ct
@@ -204,8 +218,7 @@ If the element is a function or a list of a function and a
number,
(insert s)))
(defun zone-shift-left ()
- (let ((inhibit-point-motion-hooks t)
- s)
+ (let (s)
(while (not (eobp))
(unless (eolp)
(setq s (buffer-substring (point) (1+ (point))))
@@ -216,8 +229,7 @@ If the element is a function or a list of a function and a
number,
(defun zone-shift-right ()
(goto-char (point-max))
- (let ((inhibit-point-motion-hooks t)
- s)
+ (let (s)
(while (not (bobp))
(unless (bolp)
(setq s (buffer-substring (1- (point)) (point)))
@@ -237,7 +249,7 @@ If the element is a function or a list of a function and a
number,
(while (not (input-pending-p))
(funcall (elt ops (random (length ops))))
(goto-char (point-min))
- (sit-for 0 10))))
+ (sit-for 0.01))))
;;;; whacking chars
@@ -250,7 +262,7 @@ If the element is a function or a list of a function and a
number,
(aset tbl i (+ 48 (random (- 123 48))))
(setq i (1+ i)))
(translate-region (point-min) (point-max) tbl)
- (sit-for 0 2)))))
+ (sit-for 0.002)))))
(put 'zone-pgm-whack-chars 'wc-tbl
(let ((tbl (make-string 128 ?x))
@@ -278,7 +290,7 @@ If the element is a function or a list of a function and a
number,
(delete-char 1)
(insert " ")))
(forward-char 1))))
- (sit-for 0 2))))
+ (sit-for 0.002))))
(defun zone-pgm-dissolve ()
(zone-remove-text)
@@ -448,8 +460,7 @@ If the element is a function or a list of a function and a
number,
(defun zone-fill-out-screen (width height)
(let ((start (window-start))
- (line (make-string width 32))
- (inhibit-point-motion-hooks t))
+ (line (make-string width 32)))
(goto-char start)
;; fill out rectangular ws block
(while (progn (end-of-line)
@@ -664,8 +675,7 @@ If nil, `zone-pgm-random-life' chooses a value from 0-3
(inclusive).")
(setq c (point))
(move-to-column 9)
(setq col (cons (buffer-substring (point) c) col))
-; (let ((inhibit-point-motion-hooks t))
- (end-of-line 0);)
+ (end-of-line 0)
(forward-char -10))
(let ((life-patterns (vector
(if (and col (search-forward "@" max t))
diff --git a/lisp/printing.el b/lisp/printing.el
index 0654dcda3d..767648df4d 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -944,7 +944,7 @@
;;
`https://www.gnu.org/software/ghostscript/ghostscript.html'
;; gsprint `https://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'.
;; enscript `https://people.ssh.fi/mtr/genscript/'
-;; psnup `http://gnuwin32.sourceforge.net/packages/psutils.htm'
+;; psnup `https://gnuwin32.sourceforge.net/packages/psutils.htm'
;; redmon `http://www.ghostgum.com.au/software/redmon.htm'
;;
;;
@@ -1752,7 +1752,7 @@ Useful links:
`https://linux.die.net/man/1/lp'
* GNU utilities for w32 (cp.exe)
- `http://unxutils.sourceforge.net/'"
+ `https://unxutils.sourceforge.net/'"
:type '(repeat
(list
:tag "PostScript Printer"
@@ -2382,7 +2382,7 @@ Useful links:
`http://gershwin.ens.fr/vdaniel/Doc-Locale/Outils-Gnu-Linux/PsUtils/'
* psnup (PsUtils for Windows)
- `http://gnuwin32.sourceforge.net/packages/psutils.htm'
+ `https://gnuwin32.sourceforge.net/packages/psutils.htm'
* psnup documentation (GNU or Unix - or type `man psnup')
`https://linux.die.net/man/1/psnup'
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 5002a3bbfa..1aee1107e6 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -5,7 +5,7 @@
;; Author: Christoph Wedler <Christoph.Wedler@sap.com>
;; Keywords: languages, ANTLR, code generator
;; Version: 2.2c
-;; URL: http://antlr-mode.sourceforge.net/
+;; URL: https://antlr-mode.sourceforge.net/
;; This file is part of GNU Emacs.
@@ -29,7 +29,7 @@
;; supported options and various other things like running ANTLR from within
;; Emacs.
-;; For details, check <http://antlr-mode.sourceforge.net/> or, if you prefer
+;; For details, check <https://antlr-mode.sourceforge.net/> or, if you prefer
;; the manual style, follow all commands mentioned in the documentation of
;; `antlr-mode'. ANTLR is a LL(k)-based recognition tool which generates
;; lexers, parsers and tree transformers in Java, C++ or Sather and can be
@@ -83,14 +83,6 @@
(require 'easymenu))
(require 'cc-mode)
-;; More compile-time-macros
-(eval-when-compile
- (defmacro save-buffer-state-x (&rest body) ; similar to EMACS/lazy-lock.el
- (declare (debug t) (indent 0))
- `(let ((inhibit-point-motion-hooks t))
- (with-silent-modifications
- ,@body))))
-
(defvar outline-level)
(defvar imenu-use-markers)
(defvar imenu-create-index-function)
@@ -114,12 +106,12 @@
"Major mode for ANTLR grammar files."
:group 'languages
:link '(emacs-commentary-link "antlr-mode.el")
- :link '(url-link "http://antlr-mode.sourceforge.net/";)
+ :link '(url-link "https://antlr-mode.sourceforge.net/";)
:prefix "antlr-")
(defconst antlr-version "2.2c"
"ANTLR major mode version number.
-Check <http://antlr-mode.sourceforge.net/> for the newest.")
+Check <https://antlr-mode.sourceforge.net/> for the newest.")
;;;===========================================================================
@@ -1320,7 +1312,7 @@ actions if ARG is 0 or negative. See
`antlr-action-visibility'.
Display a message unless optional argument SILENT is non-nil."
(interactive "p")
- (save-buffer-state-x
+ (with-silent-modifications
(if (> arg 0)
(let ((regexp (if (= arg 1) "[]}]" "}"))
(diff (and antlr-action-visibility
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 4f1a08cfa0..81aac2ec27 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -60,7 +60,6 @@
(cc-bytecomp-defun region-active-p) ; XEmacs
(cc-bytecomp-defvar mark-active) ; Emacs
(cc-bytecomp-defvar deactivate-mark) ; Emacs
-(cc-bytecomp-defvar inhibit-point-motion-hooks) ; Emacs
(cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs
(cc-bytecomp-defvar text-property-default-nonsticky) ; Emacs 21
(cc-bytecomp-defun string-to-syntax) ; Emacs 21
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 0ac96219a1..e71560fa25 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -8356,6 +8356,23 @@ multi-line strings (but not C++, for example)."
(goto-char here))))
t)
+(defun c-forward-over-colon-type-list ()
+ ;; If we're at a sequence of characters which can extend from, e.g.,
+ ;; a class name up to a colon introducing an inheritance list,
+ ;; move forward over them, including the colon, and return non-nil.
+ ;; Otherwise return nil, leaving point unmoved.
+ (let ((here (point)) pos)
+ (while (and (re-search-forward c-sub-colon-type-list-re nil t)
+ (not (eq (char-after) ?:))
+ (c-major-mode-is 'c++-mode)
+ (setq pos (c-looking-at-c++-attribute)))
+ (goto-char pos))
+ (if (eq (char-after) ?:)
+ (progn (forward-char)
+ t)
+ (goto-char here)
+ nil)))
+
(defun c-forward-keyword-clause (match)
;; Submatch MATCH in the current match data is assumed to surround a
;; token. If it's a keyword, move over it and any immediately
@@ -8463,12 +8480,11 @@ multi-line strings (but not C++, for example)."
(and c-record-type-identifiers
(progn
;; If a keyword matched both one of the types above and
- ;; this one, we match `c-colon-type-list-re' after the
+ ;; this one, we move forward to the colon following the
;; clause matched above.
(goto-char safe-pos)
- (looking-at c-colon-type-list-re))
+ (c-forward-over-colon-type-list))
(progn
- (goto-char (match-end 0))
(c-forward-syntactic-ws)
(c-forward-keyword-prefixed-id type))
;; There's a type after the `c-colon-type-list-re' match
@@ -8921,8 +8937,16 @@ multi-line strings (but not C++, for example)."
;; Got some other operator.
(setq c-last-identifier-range
(cons (point) (match-end 0)))
+ (if (and (eq (char-after) ?\")
+ (eq (char-after (1+ (point))) ?\"))
+ ;; operator"" has an (?)optional tag after it.
+ (progn
+ (goto-char (match-end 0))
+ (c-forward-syntactic-ws lim+)
+ (when (c-on-identifier)
+ (c-forward-token-2 1 nil lim+)))
(goto-char (match-end 0))
- (c-forward-syntactic-ws lim+)
+ (c-forward-syntactic-ws lim+))
(setq pos (point)
res 'operator)))
@@ -9031,7 +9055,8 @@ multi-line strings (but not C++, for example)."
(c-forward-<>-arglist t)
(c-forward-syntactic-ws))
- (let ((start (point)) pos res name-res id-start id-end id-range)
+ (let ((start (point)) pos res name-res id-start id-end id-range
+ post-prefix-pos)
;; Skip leading type modifiers. If any are found we know it's a
;; prefix of a type.
@@ -9043,6 +9068,7 @@ multi-line strings (but not C++, for example)."
(c-forward-syntactic-ws)
(or (eq res 'no-id)
(setq res 'prefix))))
+ (setq post-prefix-pos (point))
(cond
((looking-at c-typeof-key) ; e.g. C++'s "decltype".
@@ -9075,9 +9101,14 @@ multi-line strings (but not C++, for example)."
(setq name-res (c-forward-name))
(setq res (not (null name-res)))
(when (eq name-res t)
- ;; In many languages the name can be used without the
- ;; prefix, so we add it to `c-found-types'.
- (c-add-type pos (point))
+ ;; With some keywords the name can be used without the prefix, so we
+ ;; add the name to `c-found-types' when this is the case.
+ (when (save-excursion
+ (goto-char post-prefix-pos)
+ (looking-at c-self-contained-typename-key))
+ (c-add-type pos (save-excursion
+ (c-backward-syntactic-ws)
+ (point))))
(when (and c-record-type-identifiers
c-last-identifier-range)
(c-record-type-id c-last-identifier-range)))
@@ -9162,7 +9193,10 @@ multi-line strings (but not C++, for example)."
(goto-char id-end)
(if (or res c-promote-possible-types)
(progn
- (c-add-type id-start id-end)
+ (c-add-type id-start (save-excursion
+ (goto-char id-end)
+ (c-backward-syntactic-ws)
+ (point)))
(when (and c-record-type-identifiers id-range)
(c-record-type-id id-range))
(unless res
@@ -9676,7 +9710,7 @@ point unchanged and return nil."
;; (e.g. "," or ";" or "}").
(let ((here (point))
id-start id-end brackets-after-id paren-depth decorated
- got-init arglist)
+ got-init arglist double-double-quote)
(or limit (setq limit (point-max)))
(if (and
(< (point) limit)
@@ -9705,6 +9739,10 @@ point unchanged and return nil."
(setq id-start (point))
(if (looking-at c-overloadable-operators-regexp)
(progn
+ (when (and (c-major-mode-is 'c++-mode)
+ (eq (char-after) ?\")
+ (eq (char-after (1+ (point))) ?\"))
+ (setq double-double-quote t))
(goto-char (match-end 0))
(c-forward-syntactic-ws limit)
(setq got-identifier t)
@@ -9756,6 +9794,13 @@ point unchanged and return nil."
t)
(t nil)))
+ (progn
+ (c-forward-syntactic-ws limit)
+ (when (and double-double-quote ; C++'s operator"" _tag
+ (c-on-identifier))
+ (c-forward-token-2 1 nil limit))
+ t)
+
;; Skip out of the parens surrounding the identifier. If closing
;; parens are missing, this form returns nil.
(or (= paren-depth 0)
@@ -10722,8 +10767,16 @@ This function might do hidden buffer changes."
(setq backup-if-not-cast t)
(throw 'at-decl-or-cast t)))
- (setq backup-if-not-cast t)
- (throw 'at-decl-or-cast t)))
+ ;; If we're in declaration or template delimiters, or one
+ ;; of a certain set of characters follows, we've got a
+ ;; type and variable.
+ (if (or (memq context '(decl <>))
+ (memq (char-after) '(?\; ?, ?= ?\( ?{ ?:)))
+ (progn
+ (setq backup-if-not-cast t)
+ (throw 'at-decl-or-cast t))
+ ;; We're probably just typing a statement.
+ (throw 'at-decl-or-cast nil))))
;; CASE 4
(when (and got-suffix
@@ -10839,8 +10892,13 @@ This function might do hidden buffer changes."
;; CASE 10
(when at-decl-or-cast
- ;; By now we've located the type in the declaration that we know
- ;; we're in.
+ ;; By now we've located the type in the declaration that we think
+ ;; we're in. Do we have enough evidence to promote the putative
+ ;; type to a found type? The user may be halfway through typing
+ ;; a statement beginning with an identifier.
+ (when (and (eq at-type 'maybe)
+ (not (eq context 'top)))
+ (setq c-record-type-identifiers nil))
(throw 'at-decl-or-cast t))
;; CASE 11
@@ -11083,7 +11141,10 @@ This function might do hidden buffer changes."
(not (c-on-identifier)))))))))
;; Handle the cast.
- (when (and c-record-type-identifiers at-type (not (eq at-type t)))
+ (when (and c-record-type-identifiers
+ at-type
+ (not (memq at-type '(t maybe)))) ; 'maybe isn't strong enough
+ ; evidence to promote the type.
(let ((c-promote-possible-types t))
(goto-char type-start)
(c-forward-type)))
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 2e71285cb3..aa16da7070 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1141,12 +1141,28 @@ casts and declarations are fontified. Used on level 2
and higher."
(while (and (< (point) id-end)
(re-search-forward c-opt-identifier-prefix-key
id-end t))
(c-forward-syntactic-ws limit))))
- (when (not (get-text-property (point) 'face))
+ ;; Only apply the face when the text doesn't have one yet.
+ ;; Exception: The "" in C++'s operator"" will already wrongly have
+ ;; string face.
+ (when (memq (get-text-property (point) 'face)
+ '(nil font-lock-string-face))
(c-put-font-lock-face (point) id-end
(cond
((not (memq types '(nil t))) types)
(is-function 'font-lock-function-name-face)
- (t 'font-lock-variable-name-face))))))
+ (t 'font-lock-variable-name-face))))
+ ;; Fontify any _tag in C++'s operator"" _tag.
+ (when (and
+ (c-major-mode-is 'c++-mode)
+ (equal (buffer-substring-no-properties id-start id-end)
+ "\"\""))
+ (goto-char id-end)
+ (c-forward-syntactic-ws limit)
+ (when (c-on-identifier)
+ (c-put-font-lock-face
+ (point)
+ (progn (c-forward-over-token) (point))
+ font-lock-function-name-face)))))
(and template-class
(eq init-char ?=) ; C++ "<class X = Y>"?
(progn
@@ -1181,8 +1197,21 @@ casts and declarations are fontified. Used on level 2
and higher."
;; arguments lists (i.e. lists enclosed by <...>) is more strict about what
;; characters it allows within the list.
(let ((type (and (> match-pos (point-min))
- (c-get-char-property (1- match-pos) 'c-type))))
- (cond ((not (memq (char-before match-pos) '(?\( ?, ?\[ ?< ?{)))
+ (c-get-char-property (1- match-pos) 'c-type)))
+ id-pos)
+ (cond
+ ;; Are we just after something like "(foo((bar))" ?
+ ((and (eq (char-before match-pos) ?\))
+ (c-go-list-backward match-pos)
+ (progn
+ (c-backward-syntactic-ws)
+ (and (setq id-pos (c-on-identifier))
+ (goto-char id-pos)
+ (progn
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?\()))))
+ (c-get-fontification-context (point) not-front-decl toplev))
+ ((not (memq (char-before match-pos) '(?\( ?, ?\[ ?< ?{)))
(cons (and toplev 'top) nil))
;; A control flow expression or a decltype
((and (eq (char-before match-pos) ?\()
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index cd23483a58..6ccd6c30df 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -93,7 +93,7 @@
;; definitions (i.e. this file and/or cc-fonts.el) if necessary.
;;
;; A small example of a derived mode is available at
-;; <http://cc-mode.sourceforge.net/derived-mode-ex.el>. It also
+;; <https://cc-mode.sourceforge.net/derived-mode-ex.el>. It also
;; contains some useful hints for derived mode developers.
;;; Using language variables:
@@ -1449,8 +1449,7 @@ form\". See also `c-op-identifier-prefix'."
"??'=" "xor_eq" "&=" "and_eq" "|=" "??!=" "or_eq"
"<<" ">>" ">>=" "<<=" "==" "!=" "not_eq" "<=>" "<=" ">="
"&&" "and" "||" "??!??!" "or" "++" "--" "," "->*" "->"
- "()" "[]" "<::>" "??(??)")
- ;; These work like identifiers in Pike.
+ "()" "[]" "\"\"" "<::>" "??(??)")
pike '("`+" "`-" "`&" "`|" "`^" "`<<" "`>>" "`*" "`/" "`%" "`~"
"`==" "`<" "`>" "`!" "`[]" "`[]=" "`->" "`->=" "`()" "``+"
"``-" "``&" "``|" "``^" "``<<" "``>>" "``*" "``/" "``%"
@@ -2295,11 +2294,22 @@ declaration with a type as a default value. This is
used only in
C++ Mode, e.g. \"<typename X = Y>\"."
t nil
c++ '("class" "typename"))
-
(c-lang-defconst c-template-typename-key
t (c-make-keywords-re t (c-lang-const c-template-typename-kwds)))
(c-lang-defvar c-template-typename-key (c-lang-const c-template-typename-key))
+(c-lang-defconst c-self-contained-typename-kwds
+ "Keywords where the following name is a type name which can be
+used in declarations without the keyword."
+ t nil
+ c++ '("typename"))
+
+(c-lang-defconst c-self-contained-typename-key
+ ;; Adorned regexp matching `c-self-contained-typename-key'.
+ t (c-make-keywords-re t (c-lang-const c-self-contained-typename-kwds)))
+(c-lang-defvar c-self-contained-typename-key
+ (c-lang-const c-self-contained-typename-key))
+
(c-lang-defconst c-type-prefix-kwds
"Keywords where the following name - if any - is a type name, and
where the keyword together with the symbol works as a type in
@@ -2936,6 +2946,15 @@ regexp if `c-colon-type-list-kwds' isn't nil."
"[^][{}();,/#=:]*:")))
(c-lang-defvar c-colon-type-list-re (c-lang-const c-colon-type-list-re))
+(c-lang-defconst c-sub-colon-type-list-re
+ "Regexp matching buffer content that may come between a keyword in
+`c-colon-type-list-kwds' and a putative colon, or nil if there are no
+such keywords. Exception: it does not match any C++ attributes."
+ t (if (c-lang-const c-colon-type-list-re)
+ (substring (c-lang-const c-colon-type-list-re) 0 -1)))
+(c-lang-defvar c-sub-colon-type-list-re
+ (c-lang-const c-sub-colon-type-list-re))
+
(c-lang-defconst c-paren-nontype-kwds
"Keywords that may be followed by a parenthesis expression that doesn't
contain type identifiers."
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 2003b09ded..2aa6b90dea 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -66,12 +66,12 @@
;; You can get the latest version of CC Mode, including PostScript
;; documentation and separate individual files from:
;;
-;; http://cc-mode.sourceforge.net/
+;; https://cc-mode.sourceforge.net/
;;
;; You can join a moderated CC Mode announcement-only mailing list by
;; visiting
;;
-;; http://lists.sourceforge.net/mailman/listinfo/cc-mode-announce
+;; https://lists.sourceforge.net/mailman/listinfo/cc-mode-announce
;; Externally maintained major modes which use CC-mode's engine include:
;; - cuda-mode
@@ -172,7 +172,7 @@
;; `c-font-lock-init' too to set up CC Mode's font lock support.
;;
;; See cc-langs.el for further info. A small example of a derived mode
-;; is also available at <http://cc-mode.sourceforge.net/
+;; is also available at <https://cc-mode.sourceforge.net/
;; derived-mode-ex.el>.
(defun c-leave-cc-mode-mode ()
@@ -2080,13 +2080,14 @@ with // and /*, not more generic line and block
comments."
(defun c-update-new-id (end)
;; Note the bounds of any identifier that END is in or just after, in
;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to
- ;; nil.
+ ;; nil. Set `c-new-id-is-type' unconditionally to nil.
(save-excursion
(goto-char end)
(let ((id-beg (c-on-identifier)))
(setq c-new-id-start id-beg
c-new-id-end (and id-beg
- (progn (c-end-of-current-token) (point)))))))
+ (progn (c-end-of-current-token) (point)))
+ c-new-id-is-type nil))))
(defun c-post-command ()
;; If point was inside of a new identifier and no longer is, record that
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index ded5d2130e..18c996e899 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -175,7 +175,7 @@ and a string describing how the process finished.")
(defvar compilation-num-warnings-found 0)
(defvar compilation-num-infos-found 0)
-(defconst compilation-mode-line-errors
+(defvar compilation-mode-line-errors
'(" [" (:propertize (:eval (int-to-string compilation-num-errors-found))
face compilation-error
help-echo "Number of errors so far")
@@ -980,12 +980,17 @@ Faces `compilation-error-face',
`compilation-warning-face',
"Face name to use for leaving directory messages.")
(defcustom compilation-auto-jump-to-first-error nil
- "If non-nil, automatically jump to the first error during compilation."
+ "If non-nil, automatically jump to the first error during compilation.
+
+The value `if-location-known' means automatically jump to the first error
+if the error's file can be found. The value `first-known' means jump to
+the first error whose file can be found. Any other non-nil value means
+jump to the first error unconditionally."
:type '(choice (const :tag "Never" nil)
(const :tag "Always" t)
(const :tag "If location known" if-location-known)
(const :tag "First known location" first-known))
- :version "23.1")
+ :version "29.1")
(defvar-local compilation-auto-jump-to-next nil
"If non-nil, automatically jump to the next error encountered.")
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 20a73e238e..539b277149 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -8323,7 +8323,7 @@ the appropriate statement modifier."
'cperl-short-docs
'variable-documentation))))
(Man-switches "")
- (manual-program (if is-func "perldoc -f" "perldoc")))
+ (manual-program (concat "perldoc -i" (if is-func " -f"))))
(Man-getpage-in-background word)))
;;;###autoload
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
new file mode 100644
index 0000000000..71001ba680
--- /dev/null
+++ b/lisp/progmodes/eglot.el
@@ -0,0 +1,3462 @@
+;;; eglot.el --- The Emacs Client for LSP servers -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+;; Version: 1.9
+;; Author: João Távora <joaotavora@gmail.com>
+;; Maintainer: João Távora <joaotavora@gmail.com>
+;; URL: https://github.com/joaotavora/eglot
+;; Keywords: convenience, languages
+;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.14") (flymake "1.2.1")
(project "0.3.0") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23"))
+
+;; This is is a GNU ELPA :core package. Avoid adding functionality
+;; that is not available in the version of Emacs recorded above or any
+;; of the package dependencies.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Eglot ("Emacs Polyglot") is an Emacs LSP client that stays out of
+;; your way.
+;;
+;; Typing M-x eglot in some source file is often enough to get you
+;; started, if the language server you're looking to use is installed
+;; in your system. Please refer to the manual, available from
+;; https://joaotavora.github.io/eglot/ or from M-x info for more usage
+;; instructions.
+;;
+;; If you wish to contribute changes to Eglot, please do read the user
+;; manual first. Additionally, take the following in consideration:
+
+;; * Eglot's main job is to hook up the information that language
+;; servers offer via LSP to Emacs's UI facilities: Xref for
+;; definition-chasing, Flymake for diagnostics, Eldoc for at-point
+;; documentation, etc. Eglot's job is generally *not* to provide
+;; such a UI itself, though a small number of simple
+;; counter-examples do exist, for example in the `eglot-rename'
+;; command. When a new UI is evidently needed, consider adding a
+;; new package to Emacs, or extending an existing one.
+;;
+;; * Eglot was designed to function with just the UI facilities found
+;; in the latest Emacs core, as long as those facilities are also
+;; available as GNU ELPA :core packages. Historically, a number of
+;; :core packages were added or reworked in Emacs to make this
+;; possible. This principle should be upheld when adding new LSP
+;; features or tweaking exising ones. Design any new facilities in
+;; a way that they could work in the absence of LSP or using some
+;; different protocol, then make sure Eglot can link up LSP
+;; information to it.
+
+;; * There are few Eglot configuration variables. This principle
+;; should also be upheld. If Eglot had these variables, it could be
+;; duplicating configuration found elsewhere, bloating itself up,
+;; and making it generally hard to integrate with the ever growing
+;; set of LSP features and Emacs packages. For instance, this is
+;; why one finds a single variable
+;; `eglot-ignored-server-capabilities' instead of a number of
+;; capability-specific flags, or why customizing the display of
+;; LSP-provided documentation is done via ElDoc's variables, not
+;; Eglot's.
+;;
+;; * Linking up LSP information to other libraries is generally done
+;; in the `eglot--managed-mode' minor mode function, by
+;; buffer-locally setting the other library's variables to
+;; Eglot-specific versions. When deciding what to set the variable
+;; to, the general idea is to choose a good default for beginners
+;; that doesn't clash with Emacs's defaults. The settings are only
+;; in place during Eglot's LSP-enriched tenure over a project. Even
+;; so, some of those decisions will invariably aggravate a minority
+;; of Emacs power users, but these users can use `eglot-stay-out-of'
+;; and `eglot-managed-mode-hook' to quench their OCD.
+;;
+;; * On occasion, to enable new features, Eglot can have soft
+;; dependencies on popular libraries that are not in Emacs core.
+;; "Soft" means that the dependency doesn't impair any other use of
+;; Eglot beyond that feature. Such is the case of the snippet
+;; functionality, via the Yasnippet package, Markdown formatting of
+;; at-point documentation via the markdown-mode package, and nicer
+;; looking completions when the Company package is used.
+
+;;; Code:
+
+(require 'imenu)
+(require 'cl-lib)
+(require 'project)
+(require 'url-parse)
+(require 'url-util)
+(require 'pcase)
+(require 'compile) ; for some faces
+(require 'warnings)
+(require 'flymake)
+(require 'xref)
+(eval-when-compile
+ (require 'subr-x))
+(require 'jsonrpc)
+(require 'filenotify)
+(require 'ert)
+(require 'array)
+
+;; ElDoc is preloaded in Emacs, so `require'-ing won't guarantee we are
+;; using the latest version from GNU Elpa when we load eglot.el. Use an
+;; heuristic to see if we need to `load' it in Emacs < 28.
+(if (and (< emacs-major-version 28)
+ (not (boundp 'eldoc-documentation-strategy)))
+ (load "eldoc")
+ (require 'eldoc))
+
+;; Similar issue as above for Emacs 26.3 and seq.el.
+(if (< emacs-major-version 27)
+ (load "seq")
+ (require 'seq))
+
+;; forward-declare, but don't require (Emacs 28 doesn't seem to care)
+(defvar markdown-fontify-code-blocks-natively)
+(defvar company-backends)
+(defvar company-tooltip-align-annotations)
+
+
+
+;;; User tweakable stuff
+(defgroup eglot nil
+ "Interaction with Language Server Protocol servers."
+ :prefix "eglot-"
+ :group 'applications)
+
+(defun eglot-alternatives (alternatives)
+ "Compute server-choosing function for `eglot-server-programs'.
+Each element of ALTERNATIVES is a string PROGRAM or a list of
+strings (PROGRAM ARGS...) where program names an LSP server
+program to start with ARGS. Returns a function of one argument.
+When invoked, that function will return a list (ABSPATH ARGS),
+where ABSPATH is the absolute path of the PROGRAM that was
+chosen (interactively or automatically)."
+ (lambda (&optional interactive)
+ ;; JT@2021-06-13: This function is way more complicated than it
+ ;; could be because it accounts for the fact that
+ ;; `eglot--executable-find' may take much longer to execute on
+ ;; remote files.
+ (let* ((listified (cl-loop for a in alternatives
+ collect (if (listp a) a (list a))))
+ (err (lambda ()
+ (error "None of '%s' are valid executables"
+ (mapconcat #'car listified ", ")))))
+ (cond (interactive
+ (let* ((augmented (mapcar (lambda (a)
+ (let ((found (eglot--executable-find
+ (car a) t)))
+ (and found
+ (cons (car a) (cons found (cdr
a))))))
+ listified))
+ (available (remove nil augmented)))
+ (cond ((cdr available)
+ (cdr (assoc
+ (completing-read
+ "[eglot] More than one server executable
available:"
+ (mapcar #'car available)
+ nil t nil nil (car (car available)))
+ available #'equal)))
+ ((cdr (car available)))
+ (t
+ ;; Don't error when used interactively, let the
+ ;; Eglot prompt the user for alternative (github#719)
+ nil))))
+ (t
+ (cl-loop for (p . args) in listified
+ for probe = (eglot--executable-find p t)
+ when probe return (cons probe args)
+ finally (funcall err)))))))
+
+(defvar eglot-server-programs `((rust-mode . ,(eglot-alternatives
'("rust-analyzer" "rls")))
+ (cmake-mode . ("cmake-language-server"))
+ (vimrc-mode . ("vim-language-server"
"--stdio"))
+ (python-mode
+ . ,(eglot-alternatives
+ '("pylsp" "pyls" ("pyright-langserver"
"--stdio") "jedi-language-server")))
+ ((js-mode typescript-mode)
+ . ("typescript-language-server" "--stdio"))
+ (sh-mode . ("bash-language-server" "start"))
+ ((php-mode phps-mode)
+ . ("php" "vendor/felixfbecker/\
+language-server/bin/php-language-server.php"))
+ ((c++-mode c-mode) . ,(eglot-alternatives
+ '("clangd" "ccls")))
+ (((caml-mode :language-id "ocaml")
+ (tuareg-mode :language-id "ocaml")
reason-mode)
+ . ("ocamllsp"))
+ (ruby-mode
+ . ("solargraph" "socket" "--port" :autoport))
+ (haskell-mode
+ . ("haskell-language-server-wrapper" "--lsp"))
+ (elm-mode . ("elm-language-server"))
+ (mint-mode . ("mint" "ls"))
+ (kotlin-mode . ("kotlin-language-server"))
+ (go-mode . ("gopls"))
+ ((R-mode ess-r-mode) . ("R" "--slave" "-e"
+
"languageserver::run()"))
+ (java-mode . ("jdtls"))
+ (dart-mode . ("dart" "language-server"
+ "--client-id"
"emacs.eglot-dart"))
+ (elixir-mode . ("language_server.sh"))
+ (ada-mode . ("ada_language_server"))
+ (scala-mode . ("metals-emacs"))
+ (racket-mode . ("racket" "-l"
"racket-langserver"))
+ ((tex-mode context-mode texinfo-mode
bibtex-mode)
+ . ("digestif"))
+ (erlang-mode . ("erlang_ls" "--transport"
"stdio"))
+ (yaml-mode . ("yaml-language-server"
"--stdio"))
+ (nix-mode . ,(eglot-alternatives '("nil"
"rnix-lsp")))
+ (gdscript-mode . ("localhost" 6008))
+ ((fortran-mode f90-mode) . ("fortls"))
+ (futhark-mode . ("futhark" "lsp"))
+ (lua-mode . ,(eglot-alternatives
+ '("lua-language-server"
"lua-lsp")))
+ (zig-mode . ("zls"))
+ (css-mode . ,(eglot-alternatives
'(("vscode-css-language-server" "--stdio") ("css-languageserver" "--stdio"))))
+ (html-mode . ,(eglot-alternatives
'(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio"))))
+ (json-mode . ,(eglot-alternatives
'(("vscode-json-language-server" "--stdio") ("json-languageserver" "--stdio"))))
+ (dockerfile-mode . ("docker-langserver"
"--stdio"))
+ ((clojure-mode clojurescript-mode
clojurec-mode)
+ . ("clojure-lsp"))
+ (csharp-mode . ("omnisharp" "-lsp"))
+ (purescript-mode .
("purescript-language-server" "--stdio"))
+ (perl-mode . ("perl" "-MPerl::LanguageServer"
"-e" "Perl::LanguageServer::run"))
+ (markdown-mode . ("marksman" "server")))
+ "How the command `eglot' guesses the server to start.
+An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE
+identifies the buffers that are to be managed by a specific
+language server. The associated CONTACT specifies how to connect
+to a server for those buffers.
+
+MAJOR-MODE can be:
+
+* In the most common case, a symbol such as `c-mode';
+
+* A list (MAJOR-MODE-SYMBOL :LANGUAGE-ID ID) where
+ MAJOR-MODE-SYMBOL is the aforementioned symbol and ID is a
+ string identifying the language to the server;
+
+* A list combining the previous two alternatives, meaning
+ multiple major modes will be associated with a single server
+ program. This association is such that the same resulting
+ server process will manage buffers of different major modes.
+
+CONTACT can be:
+
+* In the most common case, a list of strings (PROGRAM [ARGS...]).
+ PROGRAM is called with ARGS and is expected to serve LSP requests
+ over the standard input/output channels.
+
+* A list (PROGRAM [ARGS...] :initializationOptions OPTIONS),
+ whereupon PROGRAM is called with ARGS as in the first option,
+ and the LSP \"initializationOptions\" JSON object is
+ constructed from OPTIONS. If OPTIONS is a unary function, it
+ is called with the server instance and should return a JSON
+ object.
+
+* A list (HOST PORT [TCP-ARGS...]) where HOST is a string and
+ PORT is a positive integer for connecting to a server via TCP.
+ Remaining ARGS are passed to `open-network-stream' for
+ upgrading the connection with encryption or other capabilities.
+
+* A list (PROGRAM [ARGS...] :autoport [MOREARGS...]), whereupon a
+ combination of previous options is used. First, an attempt is
+ made to find an available server port, then PROGRAM is launched
+ with ARGS; the `:autoport' keyword substituted for that number;
+ and MOREARGS. Eglot then attempts to establish a TCP
+ connection to that port number on the localhost.
+
+* A cons (CLASS-NAME . INITARGS) where CLASS-NAME is a symbol
+ designating a subclass of `eglot-lsp-server', for representing
+ experimental LSP servers. INITARGS is a keyword-value plist
+ used to initialize the object of CLASS-NAME, or a plain list
+ interpreted as the previous descriptions of CONTACT. In the
+ latter case that plain list is used to produce a plist with a
+ suitable :PROCESS initarg to CLASS-NAME. The class
+ `eglot-lsp-server' descends from `jsonrpc-process-connection',
+ which you should see for the semantics of the mandatory
+ :PROCESS argument.
+
+* A function of a single argument producing any of the above
+ values for CONTACT. The argument's value is non-nil if the
+ connection was requested interactively (e.g. from the `eglot'
+ command), and nil if it wasn't (e.g. from `eglot-ensure'). If
+ the call is interactive, the function can ask the user for
+ hints on finding the required programs, etc. Otherwise, it
+ should not ask the user for any input, and return nil or signal
+ an error if it can't produce a valid CONTACT.")
+
+(defface eglot-highlight-symbol-face
+ '((t (:inherit bold)))
+ "Face used to highlight the symbol at point.")
+
+(defface eglot-mode-line
+ '((t (:inherit font-lock-constant-face :weight bold)))
+ "Face for package-name in Eglot's mode line.")
+
+(defface eglot-diagnostic-tag-unnecessary-face
+ '((t (:inherit shadow)))
+ "Face used to render unused or unnecessary code.")
+
+(defface eglot-diagnostic-tag-deprecated-face
+ '((t . (:inherit shadow :strike-through t)))
+ "Face used to render deprecated or obsolete code.")
+
+(defcustom eglot-autoreconnect 3
+ "Control ability to reconnect automatically to the LSP server.
+If t, always reconnect automatically (not recommended). If nil,
+never reconnect automatically after unexpected server shutdowns,
+crashes or network failures. A positive integer number says to
+only autoreconnect if the previous successful connection attempt
+lasted more than that many seconds."
+ :type '(choice (boolean :tag "Whether to inhibit autoreconnection")
+ (integer :tag "Number of seconds")))
+
+(defcustom eglot-connect-timeout 30
+ "Number of seconds before timing out LSP connection attempts.
+If nil, never time out."
+ :type 'number)
+
+(defcustom eglot-sync-connect 3
+ "Control blocking of LSP connection attempts.
+If t, block for `eglot-connect-timeout' seconds. A positive
+integer number means block for that many seconds, and then wait
+for the connection in the background. nil has the same meaning
+as 0, i.e. don't block at all."
+ :type '(choice (boolean :tag "Whether to inhibit autoreconnection")
+ (integer :tag "Number of seconds")))
+
+(defcustom eglot-autoshutdown nil
+ "If non-nil, shut down server after killing last managed buffer."
+ :type 'boolean)
+
+(defcustom eglot-send-changes-idle-time 0.5
+ "Don't tell server of changes before Emacs's been idle for this many
seconds."
+ :type 'number)
+
+(defcustom eglot-events-buffer-size 2000000
+ "Control the size of the Eglot events buffer.
+If a number, don't let the buffer grow larger than that many
+characters. If 0, don't use an event's buffer at all. If nil,
+let the buffer grow forever.
+
+For changes on this variable to take effect on a connection
+already started, you need to restart the connection. That can be
+done by `eglot-reconnect'."
+ :type '(choice (const :tag "No limit" nil)
+ (integer :tag "Number of characters")))
+
+(defcustom eglot-confirm-server-initiated-edits 'confirm
+ "Non-nil if server-initiated edits should be confirmed with user."
+ :type '(choice (const :tag "Don't show confirmation prompt" nil)
+ (symbol :tag "Show confirmation prompt" 'confirm)))
+
+(defcustom eglot-extend-to-xref nil
+ "If non-nil, activate Eglot in cross-referenced non-project files."
+ :type 'boolean)
+
+(defcustom eglot-menu-string "eglot"
+ "String displayed in mode line when Eglot is active."
+ :type 'string)
+
+(defvar eglot-withhold-process-id nil
+ "If non-nil, Eglot will not send the Emacs process id to the language server.
+This can be useful when using docker to run a language server.")
+
+;; Customizable via `completion-category-overrides'.
+(when (assoc 'flex completion-styles-alist)
+ (add-to-list 'completion-category-defaults '(eglot (styles flex basic))))
+
+
+;;; Constants
+;;;
+(defconst eglot--symbol-kind-names
+ `((1 . "File") (2 . "Module")
+ (3 . "Namespace") (4 . "Package") (5 . "Class")
+ (6 . "Method") (7 . "Property") (8 . "Field")
+ (9 . "Constructor") (10 . "Enum") (11 . "Interface")
+ (12 . "Function") (13 . "Variable") (14 . "Constant")
+ (15 . "String") (16 . "Number") (17 . "Boolean")
+ (18 . "Array") (19 . "Object") (20 . "Key")
+ (21 . "Null") (22 . "EnumMember") (23 . "Struct")
+ (24 . "Event") (25 . "Operator") (26 . "TypeParameter")))
+
+(defconst eglot--kind-names
+ `((1 . "Text") (2 . "Method") (3 . "Function") (4 . "Constructor")
+ (5 . "Field") (6 . "Variable") (7 . "Class") (8 . "Interface")
+ (9 . "Module") (10 . "Property") (11 . "Unit") (12 . "Value")
+ (13 . "Enum") (14 . "Keyword") (15 . "Snippet") (16 . "Color")
+ (17 . "File") (18 . "Reference") (19 . "Folder") (20 . "EnumMember")
+ (21 . "Constant") (22 . "Struct") (23 . "Event") (24 . "Operator")
+ (25 . "TypeParameter")))
+
+(defconst eglot--tag-faces
+ `((1 . eglot-diagnostic-tag-unnecessary-face)
+ (2 . eglot-diagnostic-tag-deprecated-face)))
+
+(defvaralias 'eglot-{} 'eglot--{})
+(defconst eglot--{} (make-hash-table :size 1) "The empty JSON object.")
+
+(defun eglot--executable-find (command &optional remote)
+ "Like Emacs 27's `executable-find', ignore REMOTE on Emacs 26."
+ (if (>= emacs-major-version 27) (executable-find command remote)
+ (executable-find command)))
+
+
+;;; Message verification helpers
+;;;
+(eval-and-compile
+ (defvar eglot--lsp-interface-alist
+ `(
+ (CodeAction (:title) (:kind :diagnostics :edit :command :isPreferred))
+ (ConfigurationItem () (:scopeUri :section))
+ (Command ((:title . string) (:command . string)) (:arguments))
+ (CompletionItem (:label)
+ (:kind :detail :documentation :deprecated :preselect
+ :sortText :filterText :insertText
:insertTextFormat
+ :textEdit :additionalTextEdits :commitCharacters
+ :command :data :tags))
+ (Diagnostic (:range :message) (:severity :code :source
:relatedInformation :codeDescription :tags))
+ (DocumentHighlight (:range) (:kind))
+ (FileSystemWatcher (:globPattern) (:kind))
+ (Hover (:contents) (:range))
+ (InitializeResult (:capabilities) (:serverInfo))
+ (Location (:uri :range))
+ (LocationLink (:targetUri :targetRange :targetSelectionRange)
(:originSelectionRange))
+ (LogMessageParams (:type :message))
+ (MarkupContent (:kind :value))
+ (ParameterInformation (:label) (:documentation))
+ (Position (:line :character))
+ (Range (:start :end))
+ (Registration (:id :method) (:registerOptions))
+ (ResponseError (:code :message) (:data))
+ (ShowMessageParams (:type :message))
+ (ShowMessageRequestParams (:type :message) (:actions))
+ (SignatureHelp (:signatures) (:activeSignature :activeParameter))
+ (SignatureInformation (:label) (:documentation :parameters
:activeParameter))
+ (SymbolInformation (:name :kind :location)
+ (:deprecated :containerName))
+ (DocumentSymbol (:name :range :selectionRange :kind)
+ ;; `:containerName' isn't really allowed , but
+ ;; it simplifies the impl of `eglot-imenu'.
+ (:detail :deprecated :children :containerName))
+ (TextDocumentEdit (:textDocument :edits) ())
+ (TextEdit (:range :newText))
+ (VersionedTextDocumentIdentifier (:uri :version) ())
+ (WorkspaceEdit () (:changes :documentChanges))
+ (WorkspaceSymbol (:name :kind) (:containerName :location :data)))
+ "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces.
+
+INTERFACE-NAME is a symbol designated by the spec as
+\"interface\". INTERFACE is a list (REQUIRED OPTIONAL) where
+REQUIRED and OPTIONAL are lists of KEYWORD designating field
+names that must be, or may be, respectively, present in a message
+adhering to that interface. KEY can be a keyword or a cons (SYM
+TYPE), where type is used by `cl-typep' to check types at
+runtime.
+
+Here's what an element of this alist might look like:
+
+ (Command ((:title . string) (:command . string)) (:arguments))"))
+
+(eval-and-compile
+ (defvar eglot-strict-mode
+ '(;; Uncomment next lines for fun and debugging
+ ;; disallow-non-standard-keys
+ ;; enforce-required-keys
+ ;; enforce-optional-keys
+ )
+ "How strictly to check LSP interfaces at compile- and run-time.
+
+Value is a list of symbols (if the list is empty, no checks are
+performed).
+
+If the symbol `disallow-non-standard-keys' is present, an error
+is raised if any extraneous fields are sent by the server. At
+compile-time, a warning is raised if a destructuring spec
+includes such a field.
+
+If the symbol `enforce-required-keys' is present, an error is
+raised if any required fields are missing from the message sent
+from the server. At compile-time, a warning is raised if a
+destructuring spec doesn't use such a field.
+
+If the symbol `enforce-optional-keys' is present, nothing special
+happens at run-time. At compile-time, a warning is raised if a
+destructuring spec doesn't use all optional fields.
+
+If the symbol `disallow-unknown-methods' is present, Eglot warns
+on unknown notifications and errors on unknown requests."))
+
+(cl-defun eglot--check-object (interface-name
+ object
+ &optional
+ (enforce-required t)
+ (disallow-non-standard t)
+ (check-types t))
+ "Check that OBJECT conforms to INTERFACE. Error otherwise."
+ (cl-destructuring-bind
+ (&key types required-keys optional-keys &allow-other-keys)
+ (eglot--interface interface-name)
+ (when-let ((missing (and enforce-required
+ (cl-set-difference required-keys
+ (eglot--plist-keys object)))))
+ (eglot--error "A `%s' must have %s" interface-name missing))
+ (when-let ((excess (and disallow-non-standard
+ (cl-set-difference
+ (eglot--plist-keys object)
+ (append required-keys optional-keys)))))
+ (eglot--error "A `%s' mustn't have %s" interface-name excess))
+ (when check-types
+ (cl-loop
+ for (k v) on object by #'cddr
+ for type = (or (cdr (assoc k types)) t) ;; FIXME: enforce nil type?
+ unless (cl-typep v type)
+ do (eglot--error "A `%s' must have a %s as %s, but has %s"
+ interface-name )))
+ t))
+
+(eval-and-compile
+ (defun eglot--keywordize-vars (vars)
+ (mapcar (lambda (var) (intern (format ":%s" var))) vars))
+
+ (defun eglot--ensure-type (k) (if (consp k) k (cons k t)))
+
+ (defun eglot--interface (interface-name)
+ (let* ((interface (assoc interface-name eglot--lsp-interface-alist))
+ (required (mapcar #'eglot--ensure-type (car (cdr interface))))
+ (optional (mapcar #'eglot--ensure-type (cadr (cdr interface)))))
+ (list :types (append required optional)
+ :required-keys (mapcar #'car required)
+ :optional-keys (mapcar #'car optional))))
+
+ (defun eglot--check-dspec (interface-name dspec)
+ "Check destructuring spec DSPEC against INTERFACE-NAME."
+ (cl-destructuring-bind (&key required-keys optional-keys &allow-other-keys)
+ (eglot--interface interface-name)
+ (cond ((or required-keys optional-keys)
+ (let ((too-many
+ (and
+ (memq 'disallow-non-standard-keys eglot-strict-mode)
+ (cl-set-difference
+ (eglot--keywordize-vars dspec)
+ (append required-keys optional-keys))))
+ (ignored-required
+ (and
+ (memq 'enforce-required-keys eglot-strict-mode)
+ (cl-set-difference
+ required-keys (eglot--keywordize-vars dspec))))
+ (missing-out
+ (and
+ (memq 'enforce-optional-keys eglot-strict-mode)
+ (cl-set-difference
+ optional-keys (eglot--keywordize-vars dspec)))))
+ (when too-many (byte-compile-warn
+ "Destructuring for %s has extraneous %s"
+ interface-name too-many))
+ (when ignored-required (byte-compile-warn
+ "Destructuring for %s ignores required
%s"
+ interface-name ignored-required))
+ (when missing-out (byte-compile-warn
+ "Destructuring for %s is missing out on %s"
+ interface-name missing-out))))
+ (t
+ (byte-compile-warn "Unknown LSP interface %s" interface-name))))))
+
+(cl-defmacro eglot--dbind (vars object &body body)
+ "Destructure OBJECT, binding VARS in BODY.
+VARS is ([(INTERFACE)] SYMS...)
+Honour `eglot-strict-mode'."
+ (declare (indent 2) (debug (sexp sexp &rest form)))
+ (let ((interface-name (if (consp (car vars))
+ (car (pop vars))))
+ (object-once (make-symbol "object-once"))
+ (fn-once (make-symbol "fn-once")))
+ (cond (interface-name
+ (eglot--check-dspec interface-name vars)
+ `(let ((,object-once ,object))
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys)
,object-once
+ (eglot--check-object ',interface-name ,object-once
+ (memq 'enforce-required-keys
eglot-strict-mode)
+ (memq 'disallow-non-standard-keys
eglot-strict-mode)
+ (memq 'check-types eglot-strict-mode))
+ ,@body)))
+ (t
+ `(let ((,object-once ,object)
+ (,fn-once (lambda (,@vars) ,@body)))
+ (if (memq 'disallow-non-standard-keys eglot-strict-mode)
+ (cl-destructuring-bind (&key ,@vars) ,object-once
+ (funcall ,fn-once ,@vars))
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys)
,object-once
+ (funcall ,fn-once ,@vars))))))))
+
+
+(cl-defmacro eglot--lambda (cl-lambda-list &body body)
+ "Function of args CL-LAMBDA-LIST for processing INTERFACE objects.
+Honour `eglot-strict-mode'."
+ (declare (indent 1) (debug (sexp &rest form)))
+ (let ((e (cl-gensym "jsonrpc-lambda-elem")))
+ `(lambda (,e) (eglot--dbind ,cl-lambda-list ,e ,@body))))
+
+(cl-defmacro eglot--dcase (obj &rest clauses)
+ "Like `pcase', but for the LSP object OBJ.
+CLAUSES is a list (DESTRUCTURE FORMS...) where DESTRUCTURE is
+treated as in `eglot-dbind'."
+ (declare (indent 1) (debug (sexp &rest (sexp &rest form))))
+ (let ((obj-once (make-symbol "obj-once")))
+ `(let ((,obj-once ,obj))
+ (cond
+ ,@(cl-loop
+ for (vars . body) in clauses
+ for vars-as-keywords = (eglot--keywordize-vars vars)
+ for interface-name = (if (consp (car vars))
+ (car (pop vars)))
+ for condition =
+ (cond (interface-name
+ (eglot--check-dspec interface-name vars)
+ ;; In this mode, in runtime, we assume
+ ;; `eglot-strict-mode' is partially on, otherwise we
+ ;; can't disambiguate between certain types.
+ `(ignore-errors
+ (eglot--check-object
+ ',interface-name ,obj-once
+ t
+ (memq 'disallow-non-standard-keys eglot-strict-mode)
+ t)))
+ (t
+ ;; In this interface-less mode we don't check
+ ;; `eglot-strict-mode' at all: just check that the object
+ ;; has all the keys the user wants to destructure.
+ `(null (cl-set-difference
+ ',vars-as-keywords
+ (eglot--plist-keys ,obj-once)))))
+ collect `(,condition
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys)
+ ,obj-once
+ ,@body)))
+ (t
+ (eglot--error "%S didn't match any of %S"
+ ,obj-once
+ ',(mapcar #'car clauses)))))))
+
+
+;;; API (WORK-IN-PROGRESS!)
+;;;
+(cl-defmacro eglot--when-live-buffer (buf &rest body)
+ "Check BUF live, then do BODY in it." (declare (indent 1) (debug t))
+ (let ((b (cl-gensym)))
+ `(let ((,b ,buf)) (if (buffer-live-p ,b) (with-current-buffer ,b
,@body)))))
+
+(cl-defmacro eglot--when-buffer-window (buf &body body)
+ "Check BUF showing somewhere, then do BODY in it." (declare (indent 1)
(debug t))
+ (let ((b (cl-gensym)))
+ `(let ((,b ,buf))
+ ;;notice the exception when testing with `ert'
+ (when (or (get-buffer-window ,b) (ert-running-test))
+ (with-current-buffer ,b ,@body)))))
+
+(cl-defmacro eglot--widening (&rest body)
+ "Save excursion and restriction. Widen. Then run BODY." (declare (debug t))
+ `(save-excursion (save-restriction (widen) ,@body)))
+
+(cl-defgeneric eglot-handle-request (server method &rest params)
+ "Handle SERVER's METHOD request with PARAMS.")
+
+(cl-defgeneric eglot-handle-notification (server method &rest params)
+ "Handle SERVER's METHOD notification with PARAMS.")
+
+(cl-defgeneric eglot-execute-command (server command arguments)
+ "Ask SERVER to execute COMMAND with ARGUMENTS.")
+
+(cl-defgeneric eglot-initialization-options (server)
+ "JSON object to send under `initializationOptions'."
+ (:method (s)
+ (let ((probe (plist-get (eglot--saved-initargs s) :initializationOptions)))
+ (cond ((functionp probe) (funcall probe s))
+ (probe)
+ (t eglot--{})))))
+
+(cl-defgeneric eglot-register-capability (server method id &rest params)
+ "Ask SERVER to register capability METHOD marked with ID."
+ (:method
+ (_s method _id &rest _params)
+ (eglot--warn "Server tried to register unsupported capability `%s'"
+ method)))
+
+(cl-defgeneric eglot-unregister-capability (server method id &rest params)
+ "Ask SERVER to register capability METHOD marked with ID."
+ (:method
+ (_s method _id &rest _params)
+ (eglot--warn "Server tried to unregister unsupported capability `%s'"
+ method)))
+
+(cl-defgeneric eglot-client-capabilities (server)
+ "What the Eglot LSP client supports for SERVER."
+ (:method (s)
+ (list
+ :workspace (list
+ :applyEdit t
+ :executeCommand `(:dynamicRegistration :json-false)
+ :workspaceEdit `(:documentChanges t)
+ :didChangeWatchedFiles
+ `(:dynamicRegistration
+ ,(if (eglot--trampish-p s) :json-false t))
+ :symbol `(:dynamicRegistration :json-false)
+ :configuration t
+ :workspaceFolders t)
+ :textDocument
+ (list
+ :synchronization (list
+ :dynamicRegistration :json-false
+ :willSave t :willSaveWaitUntil t :didSave t)
+ :completion (list :dynamicRegistration :json-false
+ :completionItem
+ `(:snippetSupport
+ ,(if (eglot--snippet-expansion-fn)
+ t
+ :json-false)
+ :deprecatedSupport t
+ :tagSupport (:valueSet [1]))
+ :contextSupport t)
+ :hover (list :dynamicRegistration :json-false
+ :contentFormat
+ (if (fboundp 'gfm-view-mode)
+ ["markdown" "plaintext"]
+ ["plaintext"]))
+ :signatureHelp (list :dynamicRegistration :json-false
+ :signatureInformation
+ `(:parameterInformation
+ (:labelOffsetSupport t)
+ :activeParameterSupport t))
+ :references `(:dynamicRegistration :json-false)
+ :definition (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :declaration (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :implementation (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :typeDefinition (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :documentSymbol (list
+ :dynamicRegistration :json-false
+ :hierarchicalDocumentSymbolSupport t
+ :symbolKind `(:valueSet
+ [,@(mapcar
+ #'car
eglot--symbol-kind-names)]))
+ :documentHighlight `(:dynamicRegistration :json-false)
+ :codeAction (list
+ :dynamicRegistration :json-false
+ :codeActionLiteralSupport
+ '(:codeActionKind
+ (:valueSet
+ ["quickfix"
+ "refactor" "refactor.extract"
+ "refactor.inline" "refactor.rewrite"
+ "source" "source.organizeImports"]))
+ :isPreferredSupport t)
+ :formatting `(:dynamicRegistration :json-false)
+ :rangeFormatting `(:dynamicRegistration :json-false)
+ :rename `(:dynamicRegistration :json-false)
+ :publishDiagnostics (list :relatedInformation :json-false
+ ;; TODO: We can support
:codeDescription after
+ ;; adding an appropriate UI to
+ ;; Flymake.
+ :codeDescriptionSupport :json-false
+ :tagSupport
+ `(:valueSet
+ [,@(mapcar
+ #'car eglot--tag-faces)])))
+ :experimental eglot--{})))
+
+(cl-defgeneric eglot-workspace-folders (server)
+ "Return workspaceFolders for SERVER."
+ (let ((project (eglot--project server)))
+ (vconcat
+ (mapcar (lambda (dir)
+ (list :uri (eglot--path-to-uri dir)
+ :name (abbreviate-file-name dir)))
+ `(,(project-root project) ,@(project-external-roots project))))))
+
+(defclass eglot-lsp-server (jsonrpc-process-connection)
+ ((project-nickname
+ :documentation "Short nickname for the associated project."
+ :accessor eglot--project-nickname
+ :reader eglot-project-nickname)
+ (major-modes
+ :documentation "Major modes server is responsible for in a given project."
+ :accessor eglot--major-modes)
+ (language-id
+ :documentation "Language ID string for the mode."
+ :accessor eglot--language-id)
+ (capabilities
+ :documentation "JSON object containing server capabilities."
+ :accessor eglot--capabilities)
+ (server-info
+ :documentation "JSON object containing server info."
+ :accessor eglot--server-info)
+ (shutdown-requested
+ :documentation "Flag set when server is shutting down."
+ :accessor eglot--shutdown-requested)
+ (project
+ :documentation "Project associated with server."
+ :accessor eglot--project)
+ (spinner
+ :documentation "List (ID DOING-WHAT DONE-P) representing server progress."
+ :initform `(nil nil t) :accessor eglot--spinner)
+ (inhibit-autoreconnect
+ :initform t
+ :documentation "Generalized boolean inhibiting auto-reconnection if true."
+ :accessor eglot--inhibit-autoreconnect)
+ (file-watches
+ :documentation "Map ID to list of WATCHES for `didChangeWatchedFiles'."
+ :initform (make-hash-table :test #'equal) :accessor eglot--file-watches)
+ (managed-buffers
+ :documentation "List of buffers managed by server."
+ :accessor eglot--managed-buffers)
+ (saved-initargs
+ :documentation "Saved initargs for reconnection purposes."
+ :accessor eglot--saved-initargs)
+ (inferior-process
+ :documentation "Server subprocess started automatically."
+ :accessor eglot--inferior-process))
+ :documentation
+ "Represents a server. Wraps a process for LSP communication.")
+
+(cl-defmethod initialize-instance :before ((_server eglot-lsp-server)
&optional args)
+ (cl-remf args :initializationOptions))
+
+
+;;; Process management
+(defvar eglot--servers-by-project (make-hash-table :test #'equal)
+ "Keys are projects. Values are lists of processes.")
+
+(defun eglot-shutdown (server &optional _interactive timeout preserve-buffers)
+ "Politely ask SERVER to quit.
+Interactively, read SERVER from the minibuffer unless there is
+only one and it's managing the current buffer.
+
+Forcefully quit it if it doesn't respond within TIMEOUT seconds.
+TIMEOUT defaults to 1.5 seconds. Don't leave this function with
+the server still running.
+
+If PRESERVE-BUFFERS is non-nil (interactively, when called with a
+prefix argument), do not kill events and output buffers of
+SERVER."
+ (interactive (list (eglot--read-server "Shutdown which server"
+ (eglot-current-server))
+ t nil current-prefix-arg))
+ (eglot--message "Asking %s politely to terminate" (jsonrpc-name server))
+ (unwind-protect
+ (progn
+ (setf (eglot--shutdown-requested server) t)
+ (jsonrpc-request server :shutdown nil :timeout (or timeout 1.5))
+ (jsonrpc-notify server :exit nil))
+ ;; Now ask jsonrpc.el to shut down the server.
+ (jsonrpc-shutdown server (not preserve-buffers))
+ (unless preserve-buffers (kill-buffer (jsonrpc-events-buffer server)))))
+
+(defun eglot-shutdown-all (&optional preserve-buffers)
+ "Politely ask all language servers to quit, in order.
+PRESERVE-BUFFERS as in `eglot-shutdown', which see."
+ (interactive (list current-prefix-arg))
+ (cl-loop for ss being the hash-values of eglot--servers-by-project
+ do (cl-loop for s in ss do (eglot-shutdown s nil
preserve-buffers))))
+
+(defun eglot--on-shutdown (server)
+ "Called by jsonrpc.el when SERVER is already dead."
+ ;; Turn off `eglot--managed-mode' where appropriate.
+ (dolist (buffer (eglot--managed-buffers server))
+ (let (;; Avoid duplicate shutdowns (github#389)
+ (eglot-autoshutdown nil))
+ (eglot--when-live-buffer buffer (eglot--managed-mode-off))))
+ ;; Kill any expensive watches
+ (maphash (lambda (_id watches)
+ (mapcar #'file-notify-rm-watch watches))
+ (eglot--file-watches server))
+ ;; Kill any autostarted inferior processes
+ (when-let (proc (eglot--inferior-process server))
+ (delete-process proc))
+ ;; Sever the project/server relationship for `server'
+ (setf (gethash (eglot--project server) eglot--servers-by-project)
+ (delq server
+ (gethash (eglot--project server) eglot--servers-by-project)))
+ (cond ((eglot--shutdown-requested server)
+ t)
+ ((not (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Reconnecting after unexpected server exit.")
+ (eglot-reconnect server))
+ ((timerp (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Not auto-reconnecting, last one didn't last long."))))
+
+(defun eglot--all-major-modes ()
+ "Return all known major modes."
+ (let ((retval))
+ (mapatoms (lambda (sym)
+ (when (plist-member (symbol-plist sym) 'derived-mode-parent)
+ (push sym retval))))
+ retval))
+
+(defvar eglot--command-history nil
+ "History of CONTACT arguments to `eglot'.")
+
+(defun eglot--lookup-mode (mode)
+ "Lookup `eglot-server-programs' for MODE.
+Return (MANAGED-MODES LANGUAGE-ID CONTACT-PROXY).
+
+MANAGED-MODES is a list with MODE as its first elements.
+Subsequent elements are other major modes also potentially
+managed by the server that is to manage MODE.
+
+If not specified in `eglot-server-programs' (which see),
+LANGUAGE-ID is determined from MODE's name.
+
+CONTACT-PROXY is the value of the corresponding
+`eglot-server-programs' entry."
+ (cl-loop
+ for (modes . contact) in eglot-server-programs
+ for mode-symbols = (cons mode
+ (delete mode
+ (mapcar #'car
+ (mapcar #'eglot--ensure-list
+ (eglot--ensure-list
modes)))))
+ thereis (cl-some
+ (lambda (spec)
+ (cl-destructuring-bind (probe &key language-id &allow-other-keys)
+ (eglot--ensure-list spec)
+ (and (provided-mode-derived-p mode probe)
+ (list
+ mode-symbols
+ (or language-id
+ (or (get mode 'eglot-language-id)
+ (get spec 'eglot-language-id)
+ (string-remove-suffix "-mode" (symbol-name
mode))))
+ contact))))
+ (if (or (symbolp modes) (keywordp (cadr modes)))
+ (list modes) modes))))
+
+(defun eglot--guess-contact (&optional interactive)
+ "Helper for `eglot'.
+Return (MANAGED-MODE PROJECT CLASS CONTACT LANG-ID). If INTERACTIVE is
+non-nil, maybe prompt user, else error as soon as something can't
+be guessed."
+ (let* ((guessed-mode (if buffer-file-name major-mode))
+ (main-mode
+ (cond
+ ((and interactive
+ (or (>= (prefix-numeric-value current-prefix-arg) 16)
+ (not guessed-mode)))
+ (intern
+ (completing-read
+ "[eglot] Start a server to manage buffers of what major mode? "
+ (mapcar #'symbol-name (eglot--all-major-modes)) nil t
+ (symbol-name guessed-mode) nil (symbol-name guessed-mode) nil)))
+ ((not guessed-mode)
+ (eglot--error "Can't guess mode to manage for `%s'"
(current-buffer)))
+ (t guessed-mode)))
+ (triplet (eglot--lookup-mode main-mode))
+ (managed-modes (car triplet))
+ (language-id (or (cadr triplet)
+ (string-remove-suffix "-mode" (symbol-name
guessed-mode))))
+ (guess (caddr triplet))
+ (guess (if (functionp guess)
+ (funcall guess interactive)
+ guess))
+ (class (or (and (consp guess) (symbolp (car guess))
+ (prog1 (unless current-prefix-arg (car guess))
+ (setq guess (cdr guess))))
+ 'eglot-lsp-server))
+ (program (and (listp guess)
+ (stringp (car guess))
+ ;; A second element might be the port of a (host, port)
+ ;; pair, but in that case it is not a string.
+ (or (null (cdr guess)) (stringp (cadr guess)))
+ (car guess)))
+ (base-prompt
+ (and interactive
+ "Enter program to execute (or <host>:<port>): "))
+ (full-program-invocation
+ (and program
+ (cl-every #'stringp guess)
+ (combine-and-quote-strings guess)))
+ (prompt
+ (and base-prompt
+ (cond (current-prefix-arg base-prompt)
+ ((null guess)
+ (format "[eglot] Sorry, couldn't guess for `%s'!\n%s"
+ main-mode base-prompt))
+ ((and program
+ (not (file-name-absolute-p program))
+ (not (eglot--executable-find program t)))
+ (if full-program-invocation
+ (concat (format "[eglot] I guess you want to run
`%s'"
+ full-program-invocation)
+ (format ", but I can't find `%s' in PATH!"
+ program)
+ "\n" base-prompt)
+ (eglot--error
+ (concat "`%s' not found in PATH, but can't form"
+ " an interactive prompt for to fix %s!")
+ program guess))))))
+ (contact
+ (or (and prompt
+ (split-string-and-unquote
+ (read-shell-command
+ prompt
+ full-program-invocation
+ 'eglot-command-history)))
+ guess)))
+ (list managed-modes (eglot--current-project) class contact language-id)))
+
+(defvar eglot-lsp-context)
+(put 'eglot-lsp-context 'variable-documentation
+ "Dynamically non-nil when searching for projects in LSP context.")
+
+(defvar eglot--servers-by-xrefed-file
+ (make-hash-table :test 'equal :weakness 'value))
+
+(defun eglot--current-project ()
+ "Return a project object for Eglot's LSP purposes.
+This relies on `project-current' and thus on
+`project-find-functions'. Functions in the latter
+variable (which see) can query the value `eglot-lsp-context' to
+decide whether a given directory is a project containing a
+suitable root directory for a given LSP server's purposes."
+ (let ((eglot-lsp-context t))
+ (or (project-current) `(transient . ,default-directory))))
+
+;;;###autoload
+(defun eglot (managed-major-mode project class contact language-id
+ &optional interactive)
+ "Start LSP server in support of PROJECT's buffers under MANAGED-MAJOR-MODE.
+
+This starts a Language Server Protocol (LSP) server suitable for the
+buffers of PROJECT whose `major-mode' is MANAGED-MAJOR-MODE.
+CLASS is the class of the LSP server to start and CONTACT specifies
+how to connect to the server.
+
+Interactively, the command attempts to guess MANAGED-MAJOR-MODE
+from the current buffer's `major-mode', CLASS and CONTACT from
+`eglot-server-programs' looked up by the major mode, and PROJECT from
+`project-find-functions'. The search for active projects in this
+context binds `eglot-lsp-context' (which see).
+
+If it can't guess, it prompts the user for the mode and the server.
+With a single \\[universal-argument] prefix arg, it always prompts for COMMAND.
+With two \\[universal-argument], it also always prompts for MANAGED-MAJOR-MODE.
+
+The LSP server of CLASS is started (or contacted) via CONTACT.
+If this operation is successful, current *and future* file
+buffers of MANAGED-MAJOR-MODE inside PROJECT become \"managed\"
+by the LSP server, meaning the information about their contents is
+exchanged periodically with the server to provide enhanced
+code-analysis via `xref-find-definitions', `flymake-mode',
+`eldoc-mode', and `completion-at-point', among others.
+
+PROJECT is a project object as returned by `project-current'.
+
+CLASS is a subclass of `eglot-lsp-server'.
+
+CONTACT specifies how to contact the server. It is a
+keyword-value plist used to initialize CLASS or a plain list as
+described in `eglot-server-programs', which see.
+
+LANGUAGE-ID is the language ID string to send to the server for
+MANAGED-MAJOR-MODE, which matters to a minority of servers.
+
+INTERACTIVE is t if called interactively."
+ (interactive (append (eglot--guess-contact t) '(t)))
+ (let* ((current-server (eglot-current-server))
+ (live-p (and current-server (jsonrpc-running-p current-server))))
+ (if (and live-p
+ interactive
+ (y-or-n-p "[eglot] Live process found, reconnect instead? "))
+ (eglot-reconnect current-server interactive)
+ (when live-p (ignore-errors (eglot-shutdown current-server)))
+ (eglot--connect managed-major-mode project class contact language-id))))
+
+(defun eglot-reconnect (server &optional interactive)
+ "Reconnect to SERVER.
+INTERACTIVE is t if called interactively."
+ (interactive (list (eglot--current-server-or-lose) t))
+ (when (jsonrpc-running-p server)
+ (ignore-errors (eglot-shutdown server interactive nil 'preserve-buffers)))
+ (eglot--connect (eglot--major-modes server)
+ (eglot--project server)
+ (eieio-object-class-name server)
+ (eglot--saved-initargs server)
+ (eglot--language-id server))
+ (eglot--message "Reconnected!"))
+
+(defvar eglot--managed-mode) ; forward decl
+
+;;;###autoload
+(defun eglot-ensure ()
+ "Start Eglot session for current buffer if there isn't one."
+ (let ((buffer (current-buffer)))
+ (cl-labels
+ ((maybe-connect
+ ()
+ (remove-hook 'post-command-hook #'maybe-connect nil)
+ (eglot--when-live-buffer buffer
+ (unless eglot--managed-mode
+ (apply #'eglot--connect (eglot--guess-contact))))))
+ (when buffer-file-name
+ (add-hook 'post-command-hook #'maybe-connect 'append nil)))))
+
+(defun eglot-events-buffer (server)
+ "Display events buffer for SERVER.
+Use current server's or first available Eglot events buffer."
+ (interactive (list (eglot-current-server)))
+ (let ((buffer (if server (jsonrpc-events-buffer server)
+ (cl-find "\\*EGLOT.*events\\*"
+ (buffer-list)
+ :key #'buffer-name :test #'string-match))))
+ (if buffer (display-buffer buffer)
+ (eglot--error "Can't find an Eglot events buffer!"))))
+
+(defun eglot-stderr-buffer (server)
+ "Display stderr buffer for SERVER."
+ (interactive (list (eglot--current-server-or-lose)))
+ (display-buffer (jsonrpc-stderr-buffer server)))
+
+(defun eglot-forget-pending-continuations (server)
+ "Forget pending requests for SERVER."
+ (interactive (list (eglot--current-server-or-lose)))
+ (jsonrpc-forget-pending-continuations server))
+
+(defvar eglot-connect-hook
+ '(eglot-signal-didChangeConfiguration)
+ "Hook run after connecting in `eglot--connect'.")
+
+(defvar eglot-server-initialized-hook
+ '()
+ "Hook run after a `eglot-lsp-server' instance is created.
+
+That is before a connection was established. Use
+`eglot-connect-hook' to hook into when a connection was
+successfully established and the server on the other side has
+received the initializing configuration.
+
+Each function is passed the server as an argument")
+
+(defun eglot--cmd (contact)
+ "Helper for `eglot--connect'."
+ (if (file-remote-p default-directory)
+ ;; TODO: this seems like a bug, although it’s everywhere. For
+ ;; some reason, for remote connections only, over a pipe, we
+ ;; need to turn off line buffering on the tty.
+ ;;
+ ;; Not only does this seem like there should be a better way,
+ ;; but it almost certainly doesn’t work on non-unix systems.
+ (list "sh" "-c"
+ (string-join (cons "stty raw > /dev/null;"
+ (mapcar #'shell-quote-argument contact))
+ " "))
+ contact))
+
+(defvar-local eglot--cached-server nil
+ "A cached reference to the current Eglot server.")
+
+(defun eglot--connect (managed-modes project class contact language-id)
+ "Connect to MANAGED-MODES, LANGUAGE-ID, PROJECT, CLASS and CONTACT.
+This docstring appeases checkdoc, that's all."
+ (let* ((default-directory (project-root project))
+ (nickname (file-name-base (directory-file-name default-directory)))
+ (readable-name (format "EGLOT (%s/%s)" nickname managed-modes))
+ autostart-inferior-process
+ server-info
+ (contact (if (functionp contact) (funcall contact) contact))
+ (initargs
+ (cond ((keywordp (car contact)) contact)
+ ((integerp (cadr contact))
+ (setq server-info (list (format "%s:%s" (car contact)
+ (cadr contact))))
+ `(:process ,(lambda ()
+ (apply #'open-network-stream
+ readable-name nil
+ (car contact) (cadr contact)
+ (cddr contact)))))
+ ((and (stringp (car contact)) (memq :autoport contact))
+ (setq server-info (list "<inferior process>"))
+ `(:process ,(lambda ()
+ (pcase-let ((`(,connection . ,inferior)
+ (eglot--inferior-bootstrap
+ readable-name
+ contact)))
+ (setq autostart-inferior-process inferior)
+ connection))))
+ ((stringp (car contact))
+ (let* ((probe (cl-position-if #'keywordp contact))
+ (more-initargs (and probe (cl-subseq contact probe)))
+ (contact (cl-subseq contact 0 probe)))
+ `(:process
+ ,(lambda ()
+ (let ((default-directory default-directory))
+ (make-process
+ :name readable-name
+ :command (setq server-info (eglot--cmd contact))
+ :connection-type 'pipe
+ :coding 'utf-8-emacs-unix
+ :noquery t
+ :stderr (get-buffer-create
+ (format "*%s stderr*" readable-name))
+ :file-handler t)))
+ ,@more-initargs)))))
+ (spread (lambda (fn) (lambda (server method params)
+ (let ((eglot--cached-server server))
+ (apply fn server method (append params
nil))))))
+ (server
+ (apply
+ #'make-instance class
+ :name readable-name
+ :events-buffer-scrollback-size eglot-events-buffer-size
+ :notification-dispatcher (funcall spread
#'eglot-handle-notification)
+ :request-dispatcher (funcall spread #'eglot-handle-request)
+ :on-shutdown #'eglot--on-shutdown
+ initargs))
+ (cancelled nil)
+ (tag (make-symbol "connected-catch-tag")))
+ (when server-info
+ (jsonrpc--debug server "Running language server: %s"
+ (string-join server-info " ")))
+ (setf (eglot--saved-initargs server) initargs)
+ (setf (eglot--project server) project)
+ (setf (eglot--project-nickname server) nickname)
+ (setf (eglot--major-modes server) (eglot--ensure-list managed-modes))
+ (setf (eglot--language-id server) language-id)
+ (setf (eglot--inferior-process server) autostart-inferior-process)
+ (run-hook-with-args 'eglot-server-initialized-hook server)
+ ;; Now start the handshake. To honour `eglot-sync-connect'
+ ;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request'
+ ;; and mimic most of `jsonrpc-request'.
+ (unwind-protect
+ (condition-case _quit
+ (let ((retval
+ (catch tag
+ (jsonrpc-async-request
+ server
+ :initialize
+ (list :processId
+ (unless (or eglot-withhold-process-id
+ (file-remote-p default-directory)
+ (eq (jsonrpc-process-type server)
+ 'network))
+ (emacs-pid))
+ ;; Maybe turn trampy `/ssh:foo@bar:/path/to/baz.py'
+ ;; into `/path/to/baz.py', so LSP groks it.
+ :rootPath (file-local-name
+ (expand-file-name default-directory))
+ :rootUri (eglot--path-to-uri default-directory)
+ :initializationOptions
(eglot-initialization-options
+ server)
+ :capabilities (eglot-client-capabilities server)
+ :workspaceFolders (eglot-workspace-folders server))
+ :success-fn
+ (eglot--lambda ((InitializeResult) capabilities
serverInfo)
+ (unless cancelled
+ (push server
+ (gethash project eglot--servers-by-project))
+ (setf (eglot--capabilities server) capabilities)
+ (setf (eglot--server-info server) serverInfo)
+ (jsonrpc-notify server :initialized eglot--{})
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ ;; No need to pass SERVER as an argument: it has
+ ;; been registered in
`eglot--servers-by-project',
+ ;; so that it can be found (and cached) from
+ ;; `eglot--maybe-activate-editing-mode' in any
+ ;; managed buffer.
+ (eglot--maybe-activate-editing-mode)))
+ (setf (eglot--inhibit-autoreconnect server)
+ (cond
+ ((booleanp eglot-autoreconnect)
+ (not eglot-autoreconnect))
+ ((cl-plusp eglot-autoreconnect)
+ (run-with-timer
+ eglot-autoreconnect nil
+ (lambda ()
+ (setf (eglot--inhibit-autoreconnect
server)
+ (null eglot-autoreconnect)))))))
+ (let ((default-directory (project-root project))
+ (major-mode (car managed-modes)))
+ (hack-dir-local-variables-non-file-buffer)
+ (run-hook-with-args 'eglot-connect-hook server))
+ (eglot--message
+ "Connected! Server `%s' now managing `%s' buffers \
+in project `%s'."
+ (or (plist-get serverInfo :name)
+ (jsonrpc-name server))
+ managed-modes
+ (eglot-project-nickname server))
+ (when tag (throw tag t))))
+ :timeout eglot-connect-timeout
+ :error-fn (eglot--lambda ((ResponseError) code message)
+ (unless cancelled
+ (jsonrpc-shutdown server)
+ (let ((msg (format "%s: %s" code message)))
+ (if tag (throw tag `(error . ,msg))
+ (eglot--error msg)))))
+ :timeout-fn (lambda ()
+ (unless cancelled
+ (jsonrpc-shutdown server)
+ (let ((msg (format "Timed out after %s
seconds"
+
eglot-connect-timeout)))
+ (if tag (throw tag `(error . ,msg))
+ (eglot--error msg))))))
+ (cond ((numberp eglot-sync-connect)
+ (accept-process-output nil eglot-sync-connect))
+ (eglot-sync-connect
+ (while t (accept-process-output
+ nil eglot-connect-timeout)))))))
+ (pcase retval
+ (`(error . ,msg) (eglot--error msg))
+ (`nil (eglot--message "Waiting in background for server `%s'"
+ (jsonrpc-name server))
+ nil)
+ (_ server)))
+ (quit (jsonrpc-shutdown server) (setq cancelled 'quit)))
+ (setq tag nil))))
+
+(defun eglot--inferior-bootstrap (name contact &optional connect-args)
+ "Use CONTACT to start a server, then connect to it.
+Return a cons of two process objects (CONNECTION . INFERIOR).
+Name both based on NAME.
+CONNECT-ARGS are passed as additional arguments to
+`open-network-stream'."
+ (let* ((port-probe (make-network-process :name "eglot-port-probe-dummy"
+ :server t
+ :host "localhost"
+ :service 0))
+ (port-number (unwind-protect
+ (process-contact port-probe :service)
+ (delete-process port-probe)))
+ inferior connection)
+ (unwind-protect
+ (progn
+ (setq inferior
+ (make-process
+ :name (format "autostart-inferior-%s" name)
+ :stderr (format "*%s stderr*" name)
+ :noquery t
+ :command (cl-subst
+ (format "%s" port-number) :autoport contact)))
+ (setq connection
+ (cl-loop
+ repeat 10 for i from 1
+ do (accept-process-output nil 0.5)
+ while (process-live-p inferior)
+ do (eglot--message
+ "Trying to connect to localhost and port %s (attempt %s)"
+ port-number i)
+ thereis (ignore-errors
+ (apply #'open-network-stream
+ (format "autoconnect-%s" name)
+ nil
+ "localhost" port-number connect-args))))
+ (cons connection inferior))
+ (cond ((and (process-live-p connection)
+ (process-live-p inferior))
+ (eglot--message "Done, connected to %s!" port-number))
+ (t
+ (when inferior (delete-process inferior))
+ (when connection (delete-process connection))
+ (eglot--error "Could not start and connect to server%s"
+ (if inferior
+ (format " started with %s"
+ (process-command inferior))
+ "!")))))))
+
+
+;;; Helpers (move these to API?)
+;;;
+(defun eglot--error (format &rest args)
+ "Error out with FORMAT with ARGS."
+ (error "[eglot] %s" (apply #'format format args)))
+
+(defun eglot--message (format &rest args)
+ "Message out with FORMAT with ARGS."
+ (message "[eglot] %s" (apply #'format format args)))
+
+(defun eglot--warn (format &rest args)
+ "Warning message with FORMAT and ARGS."
+ (apply #'eglot--message (concat "(warning) " format) args)
+ (let ((warning-minimum-level :error))
+ (display-warning 'eglot (apply #'format format args) :warning)))
+
+(defun eglot-current-column () (- (point) (line-beginning-position)))
+
+(defvar eglot-current-column-function #'eglot-lsp-abiding-column
+ "Function to calculate the current column.
+
+This is the inverse operation of
+`eglot-move-to-column-function' (which see). It is a function of
+no arguments returning a column number. For buffers managed by
+fully LSP-compliant servers, this should be set to
+`eglot-lsp-abiding-column' (the default), and
+`eglot-current-column' for all others.")
+
+(defun eglot-lsp-abiding-column (&optional lbp)
+ "Calculate current COLUMN as defined by the LSP spec.
+LBP defaults to `line-beginning-position'."
+ (/ (- (length (encode-coding-region (or lbp (line-beginning-position))
+ ;; Fix github#860
+ (min (point) (point-max)) 'utf-16 t))
+ 2)
+ 2))
+
+(defun eglot--pos-to-lsp-position (&optional pos)
+ "Convert point POS to LSP position."
+ (eglot--widening
+ (list :line (1- (line-number-at-pos pos t)) ; F!@&#$CKING OFF-BY-ONE
+ :character (progn (when pos (goto-char pos))
+ (funcall eglot-current-column-function)))))
+
+(defvar eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column
+ "Function to move to a column reported by the LSP server.
+
+According to the standard, LSP column/character offsets are based
+on a count of UTF-16 code units, not actual visual columns. So
+when LSP says position 3 of a line containing just \"aXbc\",
+where X is a multi-byte character, it actually means `b', not
+`c'. However, many servers don't follow the spec this closely.
+
+For buffers managed by fully LSP-compliant servers, this should
+be set to `eglot-move-to-lsp-abiding-column' (the default), and
+`eglot-move-to-column' for all others.")
+
+(defun eglot-move-to-column (column)
+ "Move to COLUMN without closely following the LSP spec."
+ ;; We cannot use `move-to-column' here, because it moves to *visual*
+ ;; columns, which can be different from LSP columns in case of
+ ;; `whitespace-mode', `prettify-symbols-mode', etc. (github#296,
+ ;; github#297)
+ (goto-char (min (+ (line-beginning-position) column)
+ (line-end-position))))
+
+(defun eglot-move-to-lsp-abiding-column (column)
+ "Move to COLUMN abiding by the LSP spec."
+ (save-restriction
+ (cl-loop
+ with lbp = (line-beginning-position)
+ initially
+ (narrow-to-region lbp (line-end-position))
+ (move-to-column column)
+ for diff = (- column
+ (eglot-lsp-abiding-column lbp))
+ until (zerop diff)
+ do (condition-case eob-err
+ (forward-char (/ (if (> diff 0) (1+ diff) (1- diff)) 2))
+ (end-of-buffer (cl-return eob-err))))))
+
+(defun eglot--lsp-position-to-point (pos-plist &optional marker)
+ "Convert LSP position POS-PLIST to Emacs point.
+If optional MARKER, return a marker instead"
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (min most-positive-fixnum
+ (plist-get pos-plist :line)))
+ (unless (eobp) ;; if line was excessive leave point at eob
+ (let ((tab-width 1)
+ (col (plist-get pos-plist :character)))
+ (unless (wholenump col)
+ (eglot--warn
+ "Caution: LSP server sent invalid character position %s. Using 0
instead."
+ col)
+ (setq col 0))
+ (funcall eglot-move-to-column-function col)))
+ (if marker (copy-marker (point-marker)) (point)))))
+
+(defconst eglot--uri-path-allowed-chars
+ (let ((vec (copy-sequence url-path-allowed-chars)))
+ (aset vec ?: nil) ;; see github#639
+ vec)
+ "Like `url-path-allows-chars' but more restrictive.")
+
+(defun eglot--path-to-uri (path)
+ "URIfy PATH."
+ (let ((truepath (file-truename path)))
+ (concat "file://"
+ ;; Add a leading "/" for local MS Windows-style paths.
+ (if (and (eq system-type 'windows-nt)
+ (not (file-remote-p truepath)))
+ "/")
+ (url-hexify-string
+ ;; Again watch out for trampy paths.
+ (directory-file-name (file-local-name truepath))
+ eglot--uri-path-allowed-chars))))
+
+(defun eglot--uri-to-path (uri)
+ "Convert URI to file path, helped by `eglot--current-server'."
+ (when (keywordp uri) (setq uri (substring (symbol-name uri) 1)))
+ (let* ((server (eglot-current-server))
+ (remote-prefix (and server (eglot--trampish-p server)))
+ (retval (url-unhex-string (url-filename (url-generic-parse-url uri))))
+ ;; Remove the leading "/" for local MS Windows-style paths.
+ (normalized (if (and (not remote-prefix)
+ (eq system-type 'windows-nt)
+ (cl-plusp (length retval)))
+ (substring retval 1)
+ retval)))
+ (concat remote-prefix normalized)))
+
+(defun eglot--snippet-expansion-fn ()
+ "Compute a function to expand snippets.
+Doubles as an indicator of snippet support."
+ (and (boundp 'yas-minor-mode)
+ (symbol-value 'yas-minor-mode)
+ 'yas-expand-snippet))
+
+(defun eglot--format-markup (markup)
+ "Format MARKUP according to LSP's spec."
+ (pcase-let ((`(,string ,mode)
+ (if (stringp markup) (list markup 'gfm-view-mode)
+ (list (plist-get markup :value)
+ (pcase (plist-get markup :kind)
+ ("markdown" 'gfm-view-mode)
+ ("plaintext" 'text-mode)
+ (_ major-mode))))))
+ (with-temp-buffer
+ (setq-local markdown-fontify-code-blocks-natively t)
+ (insert string)
+ (let ((inhibit-message t)
+ (message-log-max nil))
+ (ignore-errors (delay-mode-hooks (funcall mode))))
+ (font-lock-ensure)
+ (string-trim (buffer-string)))))
+
+(define-obsolete-variable-alias 'eglot-ignored-server-capabilites
+ 'eglot-ignored-server-capabilities "1.8")
+
+(defcustom eglot-ignored-server-capabilities (list)
+ "LSP server capabilities that Eglot could use, but won't.
+You could add, for instance, the symbol
+`:documentHighlightProvider' to prevent automatic highlighting
+under cursor."
+ :type '(set
+ :tag "Tick the ones you're not interested in"
+ (const :tag "Documentation on hover" :hoverProvider)
+ (const :tag "Code completion" :completionProvider)
+ (const :tag "Function signature help" :signatureHelpProvider)
+ (const :tag "Go to definition" :definitionProvider)
+ (const :tag "Go to type definition" :typeDefinitionProvider)
+ (const :tag "Go to implementation" :implementationProvider)
+ (const :tag "Go to declaration" :implementationProvider)
+ (const :tag "Find references" :referencesProvider)
+ (const :tag "Highlight symbols automatically"
:documentHighlightProvider)
+ (const :tag "List symbols in buffer" :documentSymbolProvider)
+ (const :tag "List symbols in workspace" :workspaceSymbolProvider)
+ (const :tag "Execute code actions" :codeActionProvider)
+ (const :tag "Code lens" :codeLensProvider)
+ (const :tag "Format buffer" :documentFormattingProvider)
+ (const :tag "Format portion of buffer"
:documentRangeFormattingProvider)
+ (const :tag "On-type formatting" :documentOnTypeFormattingProvider)
+ (const :tag "Rename symbol" :renameProvider)
+ (const :tag "Highlight links in document" :documentLinkProvider)
+ (const :tag "Decorate color references" :colorProvider)
+ (const :tag "Fold regions of buffer" :foldingRangeProvider)
+ (const :tag "Execute custom commands" :executeCommandProvider)))
+
+(defun eglot--server-capable (&rest feats)
+ "Determine if current server is capable of FEATS."
+ (unless (cl-some (lambda (feat)
+ (memq feat eglot-ignored-server-capabilities))
+ feats)
+ (cl-loop for caps = (eglot--capabilities (eglot--current-server-or-lose))
+ then (cadr probe)
+ for (feat . more) on feats
+ for probe = (plist-member caps feat)
+ if (not probe) do (cl-return nil)
+ if (eq (cadr probe) :json-false) do (cl-return nil)
+ if (not (listp (cadr probe))) do (cl-return (if more nil (cadr
probe)))
+ finally (cl-return (or (cadr probe) t)))))
+
+(defun eglot--range-region (range &optional markers)
+ "Return region (BEG . END) that represents LSP RANGE.
+If optional MARKERS, make markers."
+ (let* ((st (plist-get range :start))
+ (beg (eglot--lsp-position-to-point st markers))
+ (end (eglot--lsp-position-to-point (plist-get range :end) markers)))
+ (cons beg end)))
+
+(defun eglot--read-server (prompt &optional dont-if-just-the-one)
+ "Read a running Eglot server from minibuffer using PROMPT.
+If DONT-IF-JUST-THE-ONE and there's only one server, don't prompt
+and just return it. PROMPT shouldn't end with a question mark."
+ (let ((servers (cl-loop for servers
+ being hash-values of eglot--servers-by-project
+ append servers))
+ (name (lambda (srv)
+ (format "%s %s" (eglot-project-nickname srv)
+ (eglot--major-modes srv)))))
+ (cond ((null servers)
+ (eglot--error "No servers!"))
+ ((or (cdr servers) (not dont-if-just-the-one))
+ (let* ((default (when-let ((current (eglot-current-server)))
+ (funcall name current)))
+ (read (completing-read
+ (if default
+ (format "%s (default %s)? " prompt default)
+ (concat prompt "? "))
+ (mapcar name servers)
+ nil t
+ nil nil
+ default)))
+ (cl-find read servers :key name :test #'equal)))
+ (t (car servers)))))
+
+(defun eglot--trampish-p (server)
+ "Tell if SERVER's project root is `file-remote-p'."
+ (file-remote-p (project-root (eglot--project server))))
+
+(defun eglot--plist-keys (plist) "Get keys of a plist."
+ (cl-loop for (k _v) on plist by #'cddr collect k))
+
+(defun eglot--ensure-list (x) (if (listp x) x (list x)))
+
+
+;;; Minor modes
+;;;
+(defvar eglot-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap display-local-help] #'eldoc-doc-buffer)
+ map))
+
+(defvar-local eglot--current-flymake-report-fn nil
+ "Current flymake report function for this buffer.")
+
+(defvar-local eglot--saved-bindings nil
+ "Bindings saved by `eglot--setq-saving'.")
+
+(defvar eglot-stay-out-of '()
+ "List of Emacs things that Eglot should try to stay of.
+Each element is a string, a symbol, or a regexp which is matched
+against a variable's name. Examples include the string
+\"company\" or the symbol `xref'.
+
+Before Eglot starts \"managing\" a particular buffer, it
+opinionatedly sets some peripheral Emacs facilities, such as
+Flymake, Xref and Company. These overriding settings help ensure
+consistent Eglot behaviour and only stay in place until
+\"managing\" stops (usually via `eglot-shutdown'), whereupon the
+previous settings are restored.
+
+However, if you wish for Eglot to stay out of a particular Emacs
+facility that you'd like to keep control of add an element to
+this list and Eglot will refrain from setting it.
+
+For example, to keep your Company customization, add the symbol
+`company' to this variable.")
+
+(defun eglot--stay-out-of-p (symbol)
+ "Tell if Eglot should stay of of SYMBOL."
+ (cl-find (symbol-name symbol) eglot-stay-out-of
+ :test (lambda (s thing)
+ (let ((re (if (symbolp thing) (symbol-name thing) thing)))
+ (string-match re s)))))
+
+(defmacro eglot--setq-saving (symbol binding)
+ `(unless (or (not (boundp ',symbol)) (eglot--stay-out-of-p ',symbol))
+ (push (cons ',symbol (symbol-value ',symbol)) eglot--saved-bindings)
+ (setq-local ,symbol ,binding)))
+
+(defun eglot-managed-p ()
+ "Tell if current buffer is managed by Eglot."
+ eglot--managed-mode)
+
+(defvar eglot-managed-mode-hook nil
+ "A hook run by Eglot after it started/stopped managing a buffer.
+Use `eglot-managed-p' to determine if current buffer is managed.")
+
+(define-minor-mode eglot--managed-mode
+ "Mode for source buffers managed by some Eglot project."
+ :init-value nil :lighter nil :keymap eglot-mode-map
+ (cond
+ (eglot--managed-mode
+ (add-hook 'after-change-functions 'eglot--after-change nil t)
+ (add-hook 'before-change-functions 'eglot--before-change nil t)
+ (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t)
+ ;; Prepend "didClose" to the hook after the "nonoff", so it will run first
+ (add-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose nil t)
+ (add-hook 'before-revert-hook 'eglot--signal-textDocument/didClose nil t)
+ (add-hook 'after-revert-hook 'eglot--after-revert-hook nil t)
+ (add-hook 'before-save-hook 'eglot--signal-textDocument/willSave nil t)
+ (add-hook 'after-save-hook 'eglot--signal-textDocument/didSave nil t)
+ (unless (eglot--stay-out-of-p 'xref)
+ (add-hook 'xref-backend-functions 'eglot-xref-backend nil t))
+ (add-hook 'completion-at-point-functions #'eglot-completion-at-point nil t)
+ (add-hook 'change-major-mode-hook #'eglot--managed-mode-off nil t)
+ (add-hook 'post-self-insert-hook 'eglot--post-self-insert-hook nil t)
+ (add-hook 'pre-command-hook 'eglot--pre-command-hook nil t)
+ (eglot--setq-saving eldoc-documentation-functions
+ '(eglot-signature-eldoc-function
+ eglot-hover-eldoc-function))
+ (eglot--setq-saving eldoc-documentation-strategy
+ #'eldoc-documentation-enthusiast)
+ (eglot--setq-saving xref-prompt-for-identifier nil)
+ (eglot--setq-saving flymake-diagnostic-functions '(eglot-flymake-backend))
+ (eglot--setq-saving company-backends '(company-capf))
+ (eglot--setq-saving company-tooltip-align-annotations t)
+ (unless (eglot--stay-out-of-p 'imenu)
+ (add-function :before-until (local 'imenu-create-index-function)
+ #'eglot-imenu))
+ (unless (eglot--stay-out-of-p 'flymake) (flymake-mode 1))
+ (unless (eglot--stay-out-of-p 'eldoc) (eldoc-mode 1))
+ (cl-pushnew (current-buffer) (eglot--managed-buffers
(eglot-current-server))))
+ (t
+ (remove-hook 'after-change-functions 'eglot--after-change t)
+ (remove-hook 'before-change-functions 'eglot--before-change t)
+ (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t)
+ (remove-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose t)
+ (remove-hook 'before-revert-hook 'eglot--signal-textDocument/didClose t)
+ (remove-hook 'after-revert-hook 'eglot--after-revert-hook t)
+ (remove-hook 'before-save-hook 'eglot--signal-textDocument/willSave t)
+ (remove-hook 'after-save-hook 'eglot--signal-textDocument/didSave t)
+ (remove-hook 'xref-backend-functions 'eglot-xref-backend t)
+ (remove-hook 'completion-at-point-functions #'eglot-completion-at-point t)
+ (remove-hook 'change-major-mode-hook #'eglot--managed-mode-off t)
+ (remove-hook 'post-self-insert-hook 'eglot--post-self-insert-hook t)
+ (remove-hook 'pre-command-hook 'eglot--pre-command-hook t)
+ (cl-loop for (var . saved-binding) in eglot--saved-bindings
+ do (set (make-local-variable var) saved-binding))
+ (remove-function (local 'imenu-create-index-function) #'eglot-imenu)
+ (when eglot--current-flymake-report-fn
+ (eglot--report-to-flymake nil)
+ (setq eglot--current-flymake-report-fn nil))
+ (let ((server eglot--cached-server))
+ (setq eglot--cached-server nil)
+ (when server
+ (setf (eglot--managed-buffers server)
+ (delq (current-buffer) (eglot--managed-buffers server)))
+ (when (and eglot-autoshutdown
+ (null (eglot--managed-buffers server)))
+ (eglot-shutdown server))))))
+ ;; Note: the public hook runs before the internal eglot--managed-mode-hook.
+ (run-hooks 'eglot-managed-mode-hook))
+
+(defun eglot--managed-mode-off ()
+ "Turn off `eglot--managed-mode' unconditionally."
+ (eglot--managed-mode -1))
+
+(defun eglot-current-server ()
+ "Return logical Eglot server for current buffer, nil if none."
+ (setq eglot--cached-server
+ (or eglot--cached-server
+ (cl-find major-mode
+ (gethash (eglot--current-project)
eglot--servers-by-project)
+ :key #'eglot--major-modes
+ :test #'memq)
+ (and eglot-extend-to-xref
+ buffer-file-name
+ (gethash (expand-file-name buffer-file-name)
+ eglot--servers-by-xrefed-file)))))
+
+(defun eglot--current-server-or-lose ()
+ "Return current logical Eglot server connection or error."
+ (or (eglot-current-server)
+ (jsonrpc-error "No current JSON-RPC connection")))
+
+(defvar-local eglot--diagnostics nil
+ "Flymake diagnostics for this buffer.")
+
+(defvar revert-buffer-preserve-modes)
+(defun eglot--after-revert-hook ()
+ "Eglot's `after-revert-hook'."
+ (when revert-buffer-preserve-modes (eglot--signal-textDocument/didOpen)))
+
+(defun eglot--maybe-activate-editing-mode ()
+ "Maybe activate `eglot--managed-mode'.
+
+If it is activated, also signal textDocument/didOpen."
+ (unless eglot--managed-mode
+ ;; Called when `revert-buffer-in-progress-p' is t but
+ ;; `revert-buffer-preserve-modes' is nil.
+ (when (and buffer-file-name (eglot-current-server))
+ (setq eglot--diagnostics nil)
+ (eglot--managed-mode)
+ (eglot--signal-textDocument/didOpen))))
+
+(add-hook 'find-file-hook 'eglot--maybe-activate-editing-mode)
+(add-hook 'after-change-major-mode-hook 'eglot--maybe-activate-editing-mode)
+
+(defun eglot-clear-status (server)
+ "Clear the last JSONRPC error for SERVER."
+ (interactive (list (eglot--current-server-or-lose)))
+ (setf (jsonrpc-last-error server) nil))
+
+
+;;; Mode-line, menu and other sugar
+;;;
+(defvar eglot--mode-line-format `(:eval (eglot--mode-line-format)))
+
+(put 'eglot--mode-line-format 'risky-local-variable t)
+
+(defun eglot--mouse-call (what)
+ "Make an interactive lambda for calling WHAT from mode-line."
+ (lambda (event)
+ (interactive "e")
+ (let ((start (event-start event))) (with-selected-window (posn-window
start)
+ (save-excursion
+ (goto-char (or (posn-point start)
+ (point)))
+ (call-interactively what)
+ (force-mode-line-update t))))))
+
+(defun eglot-manual () "Open on-line documentation."
+ (interactive) (browse-url "https://github.com/joaotavora/eglot#readme";))
+
+(easy-menu-define eglot-menu nil "Eglot"
+ `("Eglot"
+ ;; Commands for getting information and customization.
+ ["Read manual" eglot-manual]
+ ["Customize Eglot" (lambda () (interactive) (customize-group "eglot"))]
+ "--"
+ ;; xref like commands.
+ ["Find definitions" xref-find-definitions
+ :help "Find definitions of identifier at point"
+ :active (eglot--server-capable :definitionProvider)]
+ ["Find references" xref-find-references
+ :help "Find references to identifier at point"
+ :active (eglot--server-capable :referencesProvider)]
+ ["Find symbols in workspace (apropos)" xref-find-apropos
+ :help "Find symbols matching a query"
+ :active (eglot--server-capable :workspaceSymbolProvider)]
+ ["Find declaration" eglot-find-declaration
+ :help "Find declaration for identifier at point"
+ :active (eglot--server-capable :declarationProvider)]
+ ["Find implementation" eglot-find-implementation
+ :help "Find implementation for identifier at point"
+ :active (eglot--server-capable :implementationProvider)]
+ ["Find type definition" eglot-find-typeDefinition
+ :help "Find type definition for identifier at point"
+ :active (eglot--server-capable :typeDefinitionProvider)]
+ "--"
+ ;; LSP-related commands (mostly Eglot's own commands).
+ ["Rename symbol" eglot-rename
+ :active (eglot--server-capable :renameProvider)]
+ ["Format buffer" eglot-format-buffer
+ :active (eglot--server-capable :documentFormattingProvider)]
+ ["Format active region" eglot-format
+ :active (and (region-active-p)
+ (eglot--server-capable :documentRangeFormattingProvider))]
+ ["Show Flymake diagnostics for buffer" flymake-show-buffer-diagnostics]
+ ["Show Flymake diagnostics for project" flymake-show-project-diagnostics]
+ ["Show Eldoc documentation at point" eldoc-doc-buffer]
+ "--"
+ ["All possible code actions" eglot-code-actions
+ :active (eglot--server-capable :codeActionProvider)]
+ ["Organize imports" eglot-code-action-organize-imports
+ :visible (eglot--server-capable :codeActionProvider)]
+ ["Extract" eglot-code-action-extract
+ :visible (eglot--server-capable :codeActionProvider)]
+ ["Inline" eglot-code-action-inline
+ :visible (eglot--server-capable :codeActionProvider)]
+ ["Rewrite" eglot-code-action-rewrite
+ :visible (eglot--server-capable :codeActionProvider)]
+ ["Quickfix" eglot-code-action-quickfix
+ :visible (eglot--server-capable :codeActionProvider)]))
+
+(easy-menu-define eglot-server-menu nil "Monitor server communication"
+ '("Debugging the server communication"
+ ["Reconnect to server" eglot-reconnect]
+ ["Quit server" eglot-shutdown]
+ "--"
+ ["LSP events buffer" eglot-events-buffer]
+ ["Server stderr buffer" eglot-stderr-buffer]
+ ["Customize event buffer size"
+ (lambda ()
+ (interactive)
+ (customize-variable 'eglot-events-buffer-size))]))
+
+(defun eglot--mode-line-props (thing face defs &optional prepend)
+ "Helper for function `eglot--mode-line-format'.
+Uses THING, FACE, DEFS and PREPEND."
+ (cl-loop with map = (make-sparse-keymap)
+ for (elem . rest) on defs
+ for (key def help) = elem
+ do (define-key map `[mode-line ,key] (eglot--mouse-call def))
+ concat (format "%s: %s" key help) into blurb
+ when rest concat "\n" into blurb
+ finally (return `(:propertize ,thing
+ face ,face
+ keymap ,map help-echo ,(concat
prepend blurb)
+ mouse-face mode-line-highlight))))
+
+(defun eglot--mode-line-format ()
+ "Compose the Eglot's mode-line."
+ (pcase-let* ((server (eglot-current-server))
+ (nick (and server (eglot-project-nickname server)))
+ (pending (and server (hash-table-count
+ (jsonrpc--request-continuations server))))
+ (`(,_id ,doing ,done-p ,_detail) (and server (eglot--spinner
server)))
+ (last-error (and server (jsonrpc-last-error server))))
+ (append
+ `(,(propertize
+ eglot-menu-string
+ 'face 'eglot-mode-line
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Eglot: Emacs LSP client\nmouse-1: Display minor mode menu"
+ 'keymap (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line down-mouse-1] eglot-menu)
+ map)))
+ (when nick
+ `(":"
+ ,(propertize
+ nick
+ 'face 'eglot-mode-line
+ 'mouse-face 'mode-line-highlight
+ 'help-echo (format "Project '%s'\nmouse-1: LSP server control menu"
nick)
+ 'keymap (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line down-mouse-1]
eglot-server-menu)
+ map))
+ ,@(when last-error
+ `("/" ,(eglot--mode-line-props
+ "error" 'compilation-mode-line-fail
+ '((mouse-3 eglot-clear-status "Clear this status"))
+ (format "An error occurred: %s\n" (plist-get last-error
+ :message)))))
+ ,@(when (and doing (not done-p))
+ `("/" ,(eglot--mode-line-props doing
+ 'compilation-mode-line-run '())))
+ ,@(when (cl-plusp pending)
+ `("/" ,(eglot--mode-line-props
+ (format "%d" pending) 'warning
+ '((mouse-3 eglot-forget-pending-continuations
+ "Forget pending continuations"))
+ "Number of outgoing, \
+still unanswered LSP requests to the server\n"))))))))
+
+(add-to-list 'mode-line-misc-info
+ `(eglot--managed-mode (" [" eglot--mode-line-format "] ")))
+
+
+;;; Flymake customization
+;;;
+(put 'eglot-note 'flymake-category 'flymake-note)
+(put 'eglot-warning 'flymake-category 'flymake-warning)
+(put 'eglot-error 'flymake-category 'flymake-error)
+
+(defalias 'eglot--make-diag 'flymake-make-diagnostic)
+(defalias 'eglot--diag-data 'flymake-diagnostic-data)
+
+(cl-loop for i from 1
+ for type in '(eglot-note eglot-warning eglot-error )
+ do (put type 'flymake-overlay-control
+ `((mouse-face . highlight)
+ (priority . ,(+ 50 i))
+ (keymap . ,(let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1]
+ (eglot--mouse-call 'eglot-code-actions))
+ map)))))
+
+
+;;; Protocol implementation (Requests, notifications, etc)
+;;;
+(cl-defmethod eglot-handle-notification
+ (_server method &key &allow-other-keys)
+ "Handle unknown notification."
+ (unless (or (string-prefix-p "$" (format "%s" method))
+ (not (memq 'disallow-unknown-methods eglot-strict-mode)))
+ (eglot--warn "Server sent unknown notification method `%s'" method)))
+
+(cl-defmethod eglot-handle-request
+ (_server method &key &allow-other-keys)
+ "Handle unknown request."
+ (when (memq 'disallow-unknown-methods eglot-strict-mode)
+ (jsonrpc-error "Unknown request method `%s'" method)))
+
+(cl-defmethod eglot-execute-command
+ (server command arguments)
+ "Execute COMMAND on SERVER with `:workspace/executeCommand'.
+COMMAND is a symbol naming the command."
+ (jsonrpc-request server :workspace/executeCommand
+ `(:command ,(format "%s" command) :arguments ,arguments)))
+
+(cl-defmethod eglot-handle-notification
+ (_server (_method (eql window/showMessage)) &key type message)
+ "Handle notification window/showMessage."
+ (eglot--message (propertize "Server reports (type=%s): %s"
+ 'face (if (<= type 1) 'error))
+ type message))
+
+(cl-defmethod eglot-handle-request
+ (_server (_method (eql window/showMessageRequest)) &key type message actions)
+ "Handle server request window/showMessageRequest."
+ (let* ((actions (append actions nil)) ;; gh#627
+ (label (completing-read
+ (concat
+ (format (propertize "[eglot] Server reports (type=%s): %s"
+ 'face (if (<= type 1) 'error))
+ type message)
+ "\nChoose an option: ")
+ (or (mapcar (lambda (obj) (plist-get obj :title)) actions)
+ '("OK"))
+ nil t (plist-get (elt actions 0) :title))))
+ (if label `(:title ,label) :null)))
+
+(cl-defmethod eglot-handle-notification
+ (_server (_method (eql window/logMessage)) &key _type _message)
+ "Handle notification window/logMessage.") ;; noop, use events buffer
+
+(cl-defmethod eglot-handle-notification
+ (_server (_method (eql telemetry/event)) &rest _any)
+ "Handle notification telemetry/event.") ;; noop, use events buffer
+
+(cl-defmethod eglot-handle-notification
+ (_server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics
+ &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode'
+ "Handle notification publishDiagnostics."
+ (cl-flet ((eglot--diag-type (sev)
+ (cond ((null sev) 'eglot-error)
+ ((<= sev 1) 'eglot-error)
+ ((= sev 2) 'eglot-warning)
+ (t 'eglot-note)))
+ (mess (source code message)
+ (concat source (and code (format " [%s]" code)) ": " message)))
+ (if-let ((buffer (find-buffer-visiting (eglot--uri-to-path uri))))
+ (with-current-buffer buffer
+ (cl-loop
+ for diag-spec across diagnostics
+ collect (eglot--dbind ((Diagnostic) range code message severity
source tags)
+ diag-spec
+ (setq message (mess source code message))
+ (pcase-let
+ ((`(,beg . ,end) (eglot--range-region range)))
+ ;; Fallback to `flymake-diag-region' if server
+ ;; botched the range
+ (when (= beg end)
+ (if-let* ((st (plist-get range :start))
+ (diag-region
+ (flymake-diag-region
+ (current-buffer) (1+ (plist-get st :line))
+ (plist-get st :character))))
+ (setq beg (car diag-region) end (cdr diag-region))
+ (eglot--widening
+ (goto-char (point-min))
+ (setq beg
+ (line-beginning-position
+ (1+ (plist-get (plist-get range :start)
:line))))
+ (setq end
+ (line-end-position
+ (1+ (plist-get (plist-get range :end)
:line)))))))
+ (eglot--make-diag
+ (current-buffer) beg end
+ (eglot--diag-type severity)
+ message `((eglot-lsp-diag . ,diag-spec))
+ (when-let ((faces
+ (cl-loop for tag across tags
+ when (alist-get tag
eglot--tag-faces)
+ collect it)))
+ `((face . ,faces))))))
+ into diags
+ finally (cond ((and
+ ;; only add to current report if Flymake
+ ;; starts on idle-timer (github#958)
+ (not (null flymake-no-changes-timeout))
+ eglot--current-flymake-report-fn)
+ (eglot--report-to-flymake diags))
+ (t
+ (setq eglot--diagnostics diags)))))
+ (cl-loop
+ with path = (expand-file-name (eglot--uri-to-path uri))
+ for diag-spec across diagnostics
+ collect (eglot--dbind ((Diagnostic) code range message severity source)
diag-spec
+ (setq message (mess source code message))
+ (let* ((start (plist-get range :start))
+ (line (1+ (plist-get start :line)))
+ (char (1+ (plist-get start :character))))
+ (eglot--make-diag
+ path (cons line char) nil (eglot--diag-type severity)
message)))
+ into diags
+ finally
+ (setq flymake-list-only-diagnostics
+ (assoc-delete-all path flymake-list-only-diagnostics #'string=))
+ (push (cons path diags) flymake-list-only-diagnostics)))))
+
+(cl-defun eglot--register-unregister (server things how)
+ "Helper for `registerCapability'.
+THINGS are either registrations or unregisterations (sic)."
+ (cl-loop
+ for thing in (cl-coerce things 'list)
+ do (eglot--dbind ((Registration) id method registerOptions) thing
+ (apply (cl-ecase how
+ (register 'eglot-register-capability)
+ (unregister 'eglot-unregister-capability))
+ server (intern method) id registerOptions))))
+
+(cl-defmethod eglot-handle-request
+ (server (_method (eql client/registerCapability)) &key registrations)
+ "Handle server request client/registerCapability."
+ (eglot--register-unregister server registrations 'register))
+
+(cl-defmethod eglot-handle-request
+ (server (_method (eql client/unregisterCapability))
+ &key unregisterations) ;; XXX: "unregisterations" (sic)
+ "Handle server request client/unregisterCapability."
+ (eglot--register-unregister server unregisterations 'unregister))
+
+(cl-defmethod eglot-handle-request
+ (_server (_method (eql workspace/applyEdit)) &key _label edit)
+ "Handle server request workspace/applyEdit."
+ (eglot--apply-workspace-edit edit eglot-confirm-server-initiated-edits)
+ `(:applied t))
+
+(cl-defmethod eglot-handle-request
+ (server (_method (eql workspace/workspaceFolders)))
+ "Handle server request workspace/workspaceFolders."
+ (eglot-workspace-folders server))
+
+(defun eglot--TextDocumentIdentifier ()
+ "Compute TextDocumentIdentifier object for current buffer."
+ `(:uri ,(eglot--path-to-uri (or buffer-file-name
+ (ignore-errors
+ (buffer-file-name
+ (buffer-base-buffer)))))))
+
+(defvar-local eglot--versioned-identifier 0)
+
+(defun eglot--VersionedTextDocumentIdentifier ()
+ "Compute VersionedTextDocumentIdentifier object for current buffer."
+ (append (eglot--TextDocumentIdentifier)
+ `(:version ,eglot--versioned-identifier)))
+
+(defun eglot--TextDocumentItem ()
+ "Compute TextDocumentItem object for current buffer."
+ (append
+ (eglot--VersionedTextDocumentIdentifier)
+ (list :languageId
+ (eglot--language-id (eglot--current-server-or-lose))
+ :text
+ (eglot--widening
+ (buffer-substring-no-properties (point-min) (point-max))))))
+
+(defun eglot--TextDocumentPositionParams ()
+ "Compute TextDocumentPositionParams."
+ (list :textDocument (eglot--TextDocumentIdentifier)
+ :position (eglot--pos-to-lsp-position)))
+
+(defvar-local eglot--last-inserted-char nil
+ "If non-nil, value of the last inserted character in buffer.")
+
+(defun eglot--post-self-insert-hook ()
+ "Set `eglot--last-inserted-char', maybe call on-type-formatting."
+ (setq eglot--last-inserted-char last-input-event)
+ (let ((ot-provider (eglot--server-capable
:documentOnTypeFormattingProvider)))
+ (when (and ot-provider
+ (ignore-errors ; github#906, some LS's send empty strings
+ (or (eq last-input-event
+ (seq-first (plist-get ot-provider
:firstTriggerCharacter)))
+ (cl-find last-input-event
+ (plist-get ot-provider :moreTriggerCharacter)
+ :key #'seq-first))))
+ (eglot-format (point) nil last-input-event))))
+
+(defvar eglot--workspace-symbols-cache (make-hash-table :test #'equal)
+ "Cache of `workspace/Symbol' results used by `xref-find-definitions'.")
+
+(defun eglot--pre-command-hook ()
+ "Reset some temporary variables."
+ (clrhash eglot--workspace-symbols-cache)
+ (setq eglot--last-inserted-char nil))
+
+(defun eglot--CompletionParams ()
+ (append
+ (eglot--TextDocumentPositionParams)
+ `(:context
+ ,(if-let (trigger (and (characterp eglot--last-inserted-char)
+ (cl-find eglot--last-inserted-char
+ (eglot--server-capable :completionProvider
+ :triggerCharacters)
+ :key (lambda (str) (aref str 0))
+ :test #'char-equal)))
+ `(:triggerKind 2 :triggerCharacter ,trigger) `(:triggerKind 1)))))
+
+(defvar-local eglot--recent-changes nil
+ "Recent buffer changes as collected by `eglot--before-change'.")
+
+(cl-defmethod jsonrpc-connection-ready-p ((_server eglot-lsp-server) _what)
+ "Tell if SERVER is ready for WHAT in current buffer."
+ (and (cl-call-next-method) (not eglot--recent-changes)))
+
+(defvar-local eglot--change-idle-timer nil "Idle timer for didChange signals.")
+
+(defun eglot--before-change (beg end)
+ "Hook onto `before-change-functions' with BEG and END."
+ (when (listp eglot--recent-changes)
+ ;; Records BEG and END, crucially convert them into LSP
+ ;; (line/char) positions before that information is lost (because
+ ;; the after-change thingy doesn't know if newlines were
+ ;; deleted/added). Also record markers of BEG and END
+ ;; (github#259)
+ (push `(,(eglot--pos-to-lsp-position beg)
+ ,(eglot--pos-to-lsp-position end)
+ (,beg . ,(copy-marker beg nil))
+ (,end . ,(copy-marker end t)))
+ eglot--recent-changes)))
+
+(defun eglot--after-change (beg end pre-change-length)
+ "Hook onto `after-change-functions'.
+Records BEG, END and PRE-CHANGE-LENGTH locally."
+ (cl-incf eglot--versioned-identifier)
+ (pcase (and (listp eglot--recent-changes)
+ (car eglot--recent-changes))
+ (`(,lsp-beg ,lsp-end
+ (,b-beg . ,b-beg-marker)
+ (,b-end . ,b-end-marker))
+ ;; github#259 and github#367: With `capitalize-word' or somesuch,
+ ;; `before-change-functions' always records the whole word's
+ ;; `b-beg' and `b-end'. Similarly, when coalescing two lines
+ ;; into one, `fill-paragraph' they mark the end of the first line
+ ;; up to the end of the second line. In both situations, args
+ ;; received here contradict that information: `beg' and `end'
+ ;; will differ by 1 and will likely only encompass the letter
+ ;; that was capitalized or, in the sentence-joining situation,
+ ;; the replacement of the newline with a space. That's we keep
+ ;; markers _and_ positions so we're able to detect and correct
+ ;; this. We ignore `beg', `len' and `pre-change-len' and send
+ ;; "fuller" information about the region from the markers. I've
+ ;; also experimented with doing this unconditionally but it seems
+ ;; to break when newlines are added.
+ (if (and (= b-end b-end-marker) (= b-beg b-beg-marker)
+ (or (/= beg b-beg) (/= end b-end)))
+ (setcar eglot--recent-changes
+ `(,lsp-beg ,lsp-end ,(- b-end-marker b-beg-marker)
+ ,(buffer-substring-no-properties b-beg-marker
+ b-end-marker)))
+ (setcar eglot--recent-changes
+ `(,lsp-beg ,lsp-end ,pre-change-length
+ ,(buffer-substring-no-properties beg end)))))
+ (_ (setf eglot--recent-changes :emacs-messup)))
+ (when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer))
+ (let ((buf (current-buffer)))
+ (setq eglot--change-idle-timer
+ (run-with-idle-timer
+ eglot-send-changes-idle-time
+ nil (lambda () (eglot--when-live-buffer buf
+ (when eglot--managed-mode
+ (eglot--signal-textDocument/didChange)
+ (setq eglot--change-idle-timer nil))))))))
+
+;; HACK! Launching a deferred sync request with outstanding changes is a
+;; bad idea, since that might lead to the request never having a
+;; chance to run, because `jsonrpc-connection-ready-p'.
+(advice-add #'jsonrpc-request :before
+ (cl-function (lambda (_proc _method _params &key
+ deferred &allow-other-keys)
+ (when (and eglot--managed-mode deferred)
+ (eglot--signal-textDocument/didChange))))
+ '((name . eglot--signal-textDocument/didChange)))
+
+(defvar-local eglot-workspace-configuration ()
+ "Configure LSP servers specifically for a given project.
+
+This variable's value should be a plist (SECTION VALUE ...).
+SECTION is a keyword naming a parameter section relevant to a
+particular server. VALUE is a plist or a primitive type
+converted to JSON also understood by that server.
+
+Instead of a plist, an alist ((SECTION . VALUE) ...) can be used
+instead, but this variant is less reliable and not recommended.
+
+This variable should be set as a directory-local variable. See
+See info node `(emacs)Directory Variables' for various ways to to
+that.
+
+Here's an example value that establishes two sections relevant to
+the Pylsp and Gopls LSP servers:
+
+ (:pylsp (:plugins (:jedi_completion (:include_params t
+ :fuzzy t)
+ :pylint (:enabled :json-false)))
+ :gopls (:usePlaceholders t))
+
+The value of this variable can also be a unary function of a
+single argument, which will be a connected `eglot-lsp-server'
+instance. The function runs with `default-directory' set to the
+root of the current project. It should return an object of the
+format described above.")
+
+;;;###autoload
+(put 'eglot-workspace-configuration 'safe-local-variable 'listp)
+
+(defun eglot-show-workspace-configuration (&optional server)
+ "Dump `eglot-workspace-configuration' as JSON for debugging."
+ (interactive (list (and (eglot-current-server)
+ (eglot--read-server "Server configuration"
+ (eglot-current-server)))))
+ (let ((conf (eglot--workspace-configuration-plist server)))
+ (with-current-buffer (get-buffer-create "*EGLOT workspace configuration*")
+ (erase-buffer)
+ (insert (jsonrpc--json-encode conf))
+ (with-no-warnings
+ (require 'json)
+ (when (require 'json-mode nil t) (json-mode))
+ (json-pretty-print-buffer))
+ (pop-to-buffer (current-buffer)))))
+
+(defun eglot--workspace-configuration (server)
+ (if (functionp eglot-workspace-configuration)
+ (funcall eglot-workspace-configuration server)
+ eglot-workspace-configuration))
+
+(defun eglot--workspace-configuration-plist (server)
+ "Returns `eglot-workspace-configuration' suitable for serialization."
+ (let ((val (eglot--workspace-configuration server)))
+ (or (and (consp (car val))
+ (cl-loop for (section . v) in val
+ collect (if (keywordp section) section
+ (intern (format ":%s" section)))
+ collect v))
+ val)))
+
+(defun eglot-signal-didChangeConfiguration (server)
+ "Send a `:workspace/didChangeConfiguration' signal to SERVER.
+When called interactively, use the currently active server"
+ (interactive (list (eglot--current-server-or-lose)))
+ (jsonrpc-notify
+ server :workspace/didChangeConfiguration
+ (list
+ :settings
+ (or (eglot--workspace-configuration-plist server)
+ eglot--{}))))
+
+(cl-defmethod eglot-handle-request
+ (server (_method (eql workspace/configuration)) &key items)
+ "Handle server request workspace/configuration."
+ (apply #'vector
+ (mapcar
+ (eglot--lambda ((ConfigurationItem) scopeUri section)
+ (with-temp-buffer
+ (let* ((uri-path (eglot--uri-to-path scopeUri))
+ (default-directory
+ (if (and (not (string-empty-p uri-path))
+ (file-directory-p uri-path))
+ (file-name-as-directory uri-path)
+ (project-root (eglot--project server)))))
+ (setq-local major-mode (car (eglot--major-modes server)))
+ (hack-dir-local-variables-non-file-buffer)
+ (cl-loop for (wsection o)
+ on (eglot--workspace-configuration-plist server)
+ by #'cddr
+ when (string=
+ (if (keywordp wsection)
+ (substring (symbol-name wsection) 1)
+ wsection)
+ section)
+ return o))))
+ items)))
+
+(defun eglot--signal-textDocument/didChange ()
+ "Send textDocument/didChange to server."
+ (when eglot--recent-changes
+ (let* ((server (eglot--current-server-or-lose))
+ (sync-capability (eglot--server-capable :textDocumentSync))
+ (sync-kind (if (numberp sync-capability) sync-capability
+ (plist-get sync-capability :change)))
+ (full-sync-p (or (eq sync-kind 1)
+ (eq :emacs-messup eglot--recent-changes))))
+ (jsonrpc-notify
+ server :textDocument/didChange
+ (list
+ :textDocument (eglot--VersionedTextDocumentIdentifier)
+ :contentChanges
+ (if full-sync-p
+ (vector `(:text ,(eglot--widening
+ (buffer-substring-no-properties (point-min)
+ (point-max)))))
+ (cl-loop for (beg end len text) in (reverse eglot--recent-changes)
+ ;; github#259: `capitalize-word' and commands based
+ ;; on `casify_region' will cause multiple duplicate
+ ;; empty entries in `eglot--before-change' calls
+ ;; without an `eglot--after-change' reciprocal.
+ ;; Weed them out here.
+ when (numberp len)
+ vconcat `[,(list :range `(:start ,beg :end ,end)
+ :rangeLength len :text text)]))))
+ (setq eglot--recent-changes nil)
+ (setf (eglot--spinner server) (list nil :textDocument/didChange t))
+ (jsonrpc--call-deferred server))))
+
+(defun eglot--signal-textDocument/didOpen ()
+ "Send textDocument/didOpen to server."
+ (setq eglot--recent-changes nil eglot--versioned-identifier 0)
+ (jsonrpc-notify
+ (eglot--current-server-or-lose)
+ :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem))))
+
+(defun eglot--signal-textDocument/didClose ()
+ "Send textDocument/didClose to server."
+ (with-demoted-errors
+ "[eglot] error sending textDocument/didClose: %s"
+ (jsonrpc-notify
+ (eglot--current-server-or-lose)
+ :textDocument/didClose `(:textDocument
,(eglot--TextDocumentIdentifier)))))
+
+(defun eglot--signal-textDocument/willSave ()
+ "Send textDocument/willSave to server."
+ (let ((server (eglot--current-server-or-lose))
+ (params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier))))
+ (when (eglot--server-capable :textDocumentSync :willSave)
+ (jsonrpc-notify server :textDocument/willSave params))
+ (when (eglot--server-capable :textDocumentSync :willSaveWaitUntil)
+ (ignore-errors
+ (eglot--apply-text-edits
+ (jsonrpc-request server :textDocument/willSaveWaitUntil params
+ :timeout 0.5))))))
+
+(defun eglot--signal-textDocument/didSave ()
+ "Send textDocument/didSave to server."
+ (eglot--signal-textDocument/didChange)
+ (jsonrpc-notify
+ (eglot--current-server-or-lose)
+ :textDocument/didSave
+ (list
+ ;; TODO: Handle TextDocumentSaveRegistrationOptions to control this.
+ :text (buffer-substring-no-properties (point-min) (point-max))
+ :textDocument (eglot--TextDocumentIdentifier))))
+
+(defun eglot-flymake-backend (report-fn &rest _more)
+ "A Flymake backend for Eglot.
+Calls REPORT-FN (or arranges for it to be called) when the server
+publishes diagnostics. Between calls to this function, REPORT-FN
+may be called multiple times (respecting the protocol of
+`flymake-backend-functions')."
+ (cond (eglot--managed-mode
+ (setq eglot--current-flymake-report-fn report-fn)
+ (eglot--report-to-flymake eglot--diagnostics))
+ (t
+ (funcall report-fn nil))))
+
+(defun eglot--report-to-flymake (diags)
+ "Internal helper for `eglot-flymake-backend'."
+ (save-restriction
+ (widen)
+ (funcall eglot--current-flymake-report-fn diags
+ ;; If the buffer hasn't changed since last
+ ;; call to the report function, flymake won't
+ ;; delete old diagnostics. Using :region
+ ;; keyword forces flymake to delete
+ ;; them (github#159).
+ :region (cons (point-min) (point-max))))
+ (setq eglot--diagnostics diags))
+
+(defun eglot-xref-backend () "Eglot xref backend." 'eglot)
+
+(defvar eglot--temp-location-buffers (make-hash-table :test #'equal)
+ "Helper variable for `eglot--handling-xrefs'.")
+
+(defvar eglot-xref-lessp-function #'ignore
+ "Compare two `xref-item' objects for sorting.")
+
+(cl-defmacro eglot--collecting-xrefs ((collector) &rest body)
+ "Sort and handle xrefs collected with COLLECTOR in BODY."
+ (declare (indent 1) (debug (sexp &rest form)))
+ (let ((collected (cl-gensym "collected")))
+ `(unwind-protect
+ (let (,collected)
+ (cl-flet ((,collector (xref) (push xref ,collected)))
+ ,@body)
+ (setq ,collected (nreverse ,collected))
+ (sort ,collected eglot-xref-lessp-function))
+ (maphash (lambda (_uri buf) (kill-buffer buf))
eglot--temp-location-buffers)
+ (clrhash eglot--temp-location-buffers))))
+
+(defun eglot--xref-make-match (name uri range)
+ "Like `xref-make-match' but with LSP's NAME, URI and RANGE.
+Try to visit the target file for a richer summary line."
+ (pcase-let*
+ ((file (eglot--uri-to-path uri))
+ (visiting (or (find-buffer-visiting file)
+ (gethash uri eglot--temp-location-buffers)))
+ (collect (lambda ()
+ (eglot--widening
+ (pcase-let* ((`(,beg . ,end) (eglot--range-region range))
+ (bol (progn (goto-char beg)
(line-beginning-position)))
+ (substring (buffer-substring bol
(line-end-position)))
+ (hi-beg (- beg bol))
+ (hi-end (- (min (line-end-position) end) bol)))
+ (add-face-text-property hi-beg hi-end 'xref-match
+ t substring)
+ (list substring (line-number-at-pos (point) t)
+ (eglot-current-column) (- end beg))))))
+ (`(,summary ,line ,column ,length)
+ (cond
+ (visiting (with-current-buffer visiting (funcall collect)))
+ ((file-readable-p file) (with-current-buffer
+ (puthash uri (generate-new-buffer "
*temp*")
+ eglot--temp-location-buffers)
+ (insert-file-contents file)
+ (funcall collect)))
+ (t ;; fall back to the "dumb strategy"
+ (let* ((start (cl-getf range :start))
+ (line (1+ (cl-getf start :line)))
+ (start-pos (cl-getf start :character))
+ (end-pos (cl-getf (cl-getf range :end) :character)))
+ (list name line start-pos (- end-pos start-pos)))))))
+ (setf (gethash (expand-file-name file) eglot--servers-by-xrefed-file)
+ (eglot--current-server-or-lose))
+ (xref-make-match summary (xref-make-file-location file line column)
length)))
+
+(defun eglot--workspace-symbols (pat &optional buffer)
+ "Ask for :workspace/symbol on PAT, return list of formatted strings.
+If BUFFER, switch to it before."
+ (with-current-buffer (or buffer (current-buffer))
+ (unless (eglot--server-capable :workspaceSymbolProvider)
+ (eglot--error "This LSP server isn't a :workspaceSymbolProvider"))
+ (mapcar
+ (lambda (wss)
+ (eglot--dbind ((WorkspaceSymbol) name containerName kind) wss
+ (propertize
+ (format "%s%s %s"
+ (if (zerop (length containerName)) ""
+ (concat (propertize containerName 'face 'shadow) " "))
+ name
+ (propertize (alist-get kind eglot--symbol-kind-names
"Unknown")
+ 'face 'shadow))
+ 'eglot--lsp-workspaceSymbol wss)))
+ (jsonrpc-request (eglot--current-server-or-lose) :workspace/symbol
+ `(:query ,pat)))))
+
+(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot)))
+ "Yet another tricky connection between LSP and Elisp completion semantics."
+ (let ((buf (current-buffer)) (cache eglot--workspace-symbols-cache))
+ (cl-labels ((refresh (pat) (eglot--workspace-symbols pat buf))
+ (lookup-1 (pat) ;; check cache, else refresh
+ (let ((probe (gethash pat cache :missing)))
+ (if (eq probe :missing) (puthash pat (refresh pat) cache)
+ probe)))
+ (lookup (pat)
+ (let ((res (lookup-1 pat))
+ (def (and (string= pat "") (gethash :default cache))))
+ (append def res nil)))
+ (score (c)
+ (cl-getf (get-text-property
+ 0 'eglot--lsp-workspaceSymbol c)
+ :score 0)))
+ (lambda (string _pred action)
+ (pcase action
+ (`metadata `(metadata
+ (cycle-sort-function
+ . ,(lambda (completions)
+ (cl-sort completions #'> :key #'score)))
+ (category . eglot-indirection-joy)))
+ (`(eglot--lsp-tryc . ,point) `(eglot--lsp-tryc . (,string . ,point)))
+ (`(eglot--lsp-allc . ,_point) `(eglot--lsp-allc . ,(lookup string)))
+ (_ nil))))))
+
+(defun eglot--recover-workspace-symbol-meta (string)
+ "Search `eglot--workspace-symbols-cache' for rich entry of STRING."
+ (catch 'found
+ (maphash (lambda (_k v)
+ (while (consp v)
+ ;; Like mess? Ask minibuffer.el about improper lists.
+ (when (equal (car v) string) (throw 'found (car v)))
+ (setq v (cdr v))))
+ eglot--workspace-symbols-cache)))
+
+(add-to-list 'completion-category-overrides
+ '(eglot-indirection-joy (styles . (eglot--lsp-backend-style))))
+
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot)))
+ (let ((attempt
+ (and (xref--prompt-p this-command)
+ (puthash :default
+ (ignore-errors
+ (eglot--workspace-symbols (symbol-name
(symbol-at-point))))
+ eglot--workspace-symbols-cache))))
+ (if attempt (car attempt) "LSP identifier at point")))
+
+(defvar eglot--lsp-xref-refs nil
+ "`xref' objects for overriding `xref-backend-references''s.")
+
+(cl-defun eglot--lsp-xrefs-for-method (method &key extra-params capability)
+ "Make `xref''s for METHOD, EXTRA-PARAMS, check CAPABILITY."
+ (unless (eglot--server-capable
+ (or capability
+ (intern
+ (format ":%sProvider"
+ (cadr (split-string (symbol-name method)
+ "/"))))))
+ (eglot--error "Sorry, this server doesn't do %s" method))
+ (let ((response
+ (jsonrpc-request
+ (eglot--current-server-or-lose)
+ method (append (eglot--TextDocumentPositionParams) extra-params))))
+ (eglot--collecting-xrefs (collect)
+ (mapc
+ (lambda (loc-or-loc-link)
+ (let ((sym-name (symbol-name (symbol-at-point))))
+ (eglot--dcase loc-or-loc-link
+ (((LocationLink) targetUri targetSelectionRange)
+ (collect (eglot--xref-make-match sym-name
+ targetUri
targetSelectionRange)))
+ (((Location) uri range)
+ (collect (eglot--xref-make-match sym-name
+ uri range))))))
+ (if (vectorp response) response (and response (list response)))))))
+
+(cl-defun eglot--lsp-xref-helper (method &key extra-params capability )
+ "Helper for `eglot-find-declaration' & friends."
+ (let ((eglot--lsp-xref-refs (eglot--lsp-xrefs-for-method
+ method
+ :extra-params extra-params
+ :capability capability)))
+ (if eglot--lsp-xref-refs
+ (xref-find-references "LSP identifier at point.")
+ (eglot--message "%s returned no references" method))))
+
+(defun eglot-find-declaration ()
+ "Find declaration for SYM, the identifier at point."
+ (interactive)
+ (eglot--lsp-xref-helper :textDocument/declaration))
+
+(defun eglot-find-implementation ()
+ "Find implementation for SYM, the identifier at point."
+ (interactive)
+ (eglot--lsp-xref-helper :textDocument/implementation))
+
+(defun eglot-find-typeDefinition ()
+ "Find type definition for SYM, the identifier at point."
+ (interactive)
+ (eglot--lsp-xref-helper :textDocument/typeDefinition))
+
+(cl-defmethod xref-backend-definitions ((_backend (eql eglot)) id)
+ (let ((probe (eglot--recover-workspace-symbol-meta id)))
+ (if probe
+ (eglot--dbind ((WorkspaceSymbol) name location)
+ (get-text-property 0 'eglot--lsp-workspaceSymbol probe)
+ (eglot--dbind ((Location) uri range) location
+ (list (eglot--xref-make-match name uri range))))
+ (eglot--lsp-xrefs-for-method :textDocument/definition))))
+
+(cl-defmethod xref-backend-references ((_backend (eql eglot)) _identifier)
+ (or
+ eglot--lsp-xref-refs
+ (eglot--lsp-xrefs-for-method
+ :textDocument/references :extra-params `(:context (:includeDeclaration
t)))))
+
+(cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern)
+ (when (eglot--server-capable :workspaceSymbolProvider)
+ (eglot--collecting-xrefs (collect)
+ (mapc
+ (eglot--lambda ((SymbolInformation) name location)
+ (eglot--dbind ((Location) uri range) location
+ (collect (eglot--xref-make-match name uri range))))
+ (jsonrpc-request (eglot--current-server-or-lose)
+ :workspace/symbol
+ `(:query ,pattern))))))
+
+(defun eglot-format-buffer ()
+ "Format contents of current buffer."
+ (interactive)
+ (eglot-format nil nil))
+
+(defun eglot-format (&optional beg end on-type-format)
+ "Format region BEG END.
+If either BEG or END is nil, format entire buffer.
+Interactively, format active region, or entire buffer if region
+is not active.
+
+If non-nil, ON-TYPE-FORMAT is a character just inserted at BEG
+for which LSP on-type-formatting should be requested."
+ (interactive (and (region-active-p) (list (region-beginning) (region-end))))
+ (pcase-let ((`(,method ,cap ,args)
+ (cond
+ ((and beg on-type-format)
+ `(:textDocument/onTypeFormatting
+ :documentOnTypeFormattingProvider
+ ,`(:position ,(eglot--pos-to-lsp-position beg)
+ :ch ,(string on-type-format))))
+ ((and beg end)
+ `(:textDocument/rangeFormatting
+ :documentRangeFormattingProvider
+ (:range ,(list :start (eglot--pos-to-lsp-position beg)
+ :end (eglot--pos-to-lsp-position end)))))
+ (t
+ '(:textDocument/formatting :documentFormattingProvider
nil)))))
+ (unless (eglot--server-capable cap)
+ (eglot--error "Server can't format!"))
+ (eglot--apply-text-edits
+ (jsonrpc-request
+ (eglot--current-server-or-lose)
+ method
+ (cl-list*
+ :textDocument (eglot--TextDocumentIdentifier)
+ :options (list :tabSize tab-width
+ :insertSpaces (if indent-tabs-mode :json-false t)
+ :insertFinalNewline (if require-final-newline t
:json-false)
+ :trimFinalNewlines (if delete-trailing-lines t
:json-false))
+ args)
+ :deferred method))))
+
+(defun eglot-completion-at-point ()
+ "Eglot's `completion-at-point' function."
+ ;; Commit logs for this function help understand what's going on.
+ (when-let (completion-capability (eglot--server-capable :completionProvider))
+ (let* ((server (eglot--current-server-or-lose))
+ (sort-completions
+ (lambda (completions)
+ (cl-sort completions
+ #'string-lessp
+ :key (lambda (c)
+ (or (plist-get
+ (get-text-property 0 'eglot--lsp-item c)
+ :sortText)
+ "")))))
+ (metadata `(metadata (category . eglot)
+ (display-sort-function . ,sort-completions)))
+ resp items (cached-proxies :none)
+ (proxies
+ (lambda ()
+ (if (listp cached-proxies) cached-proxies
+ (setq resp
+ (jsonrpc-request server
+ :textDocument/completion
+ (eglot--CompletionParams)
+ :deferred :textDocument/completion
+ :cancel-on-input t))
+ (setq items (append
+ (if (vectorp resp) resp (plist-get resp :items))
+ nil))
+ (setq cached-proxies
+ (mapcar
+ (jsonrpc-lambda
+ (&rest item &key label insertText insertTextFormat
+ &allow-other-keys)
+ (let ((proxy
+ (cond ((and (eql insertTextFormat 2)
+ (eglot--snippet-expansion-fn))
+ (string-trim-left label))
+ ((and insertText
+ (not (string-empty-p insertText)))
+ insertText)
+ (t
+ (string-trim-left label)))))
+ (unless (zerop (length proxy))
+ (put-text-property 0 1 'eglot--lsp-item item
proxy))
+ proxy))
+ items)))))
+ (resolved (make-hash-table))
+ (resolve-maybe
+ ;; Maybe completion/resolve JSON object `lsp-comp' into
+ ;; another JSON object, if at all possible. Otherwise,
+ ;; just return lsp-comp.
+ (lambda (lsp-comp)
+ (or (gethash lsp-comp resolved)
+ (setf (gethash lsp-comp resolved)
+ (if (and (eglot--server-capable :completionProvider
+ :resolveProvider)
+ (plist-get lsp-comp :data))
+ (jsonrpc-request server :completionItem/resolve
+ lsp-comp :cancel-on-input t)
+ lsp-comp)))))
+ (bounds (bounds-of-thing-at-point 'symbol)))
+ (list
+ (or (car bounds) (point))
+ (or (cdr bounds) (point))
+ (lambda (probe pred action)
+ (cond
+ ((eq action 'metadata) metadata) ; metadata
+ ((eq action 'lambda) ; test-completion
+ (test-completion probe (funcall proxies)))
+ ((eq (car-safe action) 'boundaries) nil) ; boundaries
+ ((null action) ; try-completion
+ (try-completion probe (funcall proxies)))
+ ((eq action t) ; all-completions
+ (all-completions
+ ""
+ (funcall proxies)
+ (lambda (proxy)
+ (let* ((item (get-text-property 0 'eglot--lsp-item proxy))
+ (filterText (plist-get item :filterText)))
+ (and (or (null pred) (funcall pred proxy))
+ (string-prefix-p
+ probe (or filterText proxy)
completion-ignore-case))))))))
+ :annotation-function
+ (lambda (proxy)
+ (eglot--dbind ((CompletionItem) detail kind)
+ (get-text-property 0 'eglot--lsp-item proxy)
+ (let* ((detail (and (stringp detail)
+ (not (string= detail ""))
+ detail))
+ (annotation
+ (or detail
+ (cdr (assoc kind eglot--kind-names)))))
+ (when annotation
+ (concat " "
+ (propertize annotation
+ 'face 'font-lock-function-name-face))))))
+ :company-kind
+ ;; Associate each lsp-item with a lsp-kind symbol.
+ (lambda (proxy)
+ (when-let* ((lsp-item (get-text-property 0 'eglot--lsp-item proxy))
+ (kind (alist-get (plist-get lsp-item :kind)
+ eglot--kind-names)))
+ (intern (downcase kind))))
+ :company-deprecated
+ (lambda (proxy)
+ (when-let ((lsp-item (get-text-property 0 'eglot--lsp-item proxy)))
+ (or (seq-contains-p (plist-get lsp-item :tags)
+ 1)
+ (eq t (plist-get lsp-item :deprecated)))))
+ :company-docsig
+ ;; FIXME: autoImportText is specific to the pyright language server
+ (lambda (proxy)
+ (when-let* ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy))
+ (data (plist-get (funcall resolve-maybe lsp-comp) :data))
+ (import-text (plist-get data :autoImportText)))
+ import-text))
+ :company-doc-buffer
+ (lambda (proxy)
+ (let* ((documentation
+ (let ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy)))
+ (plist-get (funcall resolve-maybe lsp-comp)
:documentation)))
+ (formatted (and documentation
+ (eglot--format-markup documentation))))
+ (when formatted
+ (with-current-buffer (get-buffer-create " *eglot doc*")
+ (erase-buffer)
+ (insert formatted)
+ (current-buffer)))))
+ :company-require-match 'never
+ :company-prefix-length
+ (save-excursion
+ (when (car bounds) (goto-char (car bounds)))
+ (when (listp completion-capability)
+ (looking-back
+ (regexp-opt
+ (cl-coerce (cl-getf completion-capability :triggerCharacters)
'list))
+ (line-beginning-position))))
+ :exit-function
+ (lambda (proxy status)
+ (when (memq status '(finished exact))
+ ;; To assist in using this whole `completion-at-point'
+ ;; function inside `completion-in-region', ensure the exit
+ ;; function runs in the buffer where the completion was
+ ;; triggered from. This should probably be in Emacs itself.
+ ;; (github#505)
+ (with-current-buffer (if (minibufferp)
+ (window-buffer
(minibuffer-selected-window))
+ (current-buffer))
+ (eglot--dbind ((CompletionItem) insertTextFormat
+ insertText textEdit additionalTextEdits label)
+ (funcall
+ resolve-maybe
+ (or (get-text-property 0 'eglot--lsp-item proxy)
+ ;; When selecting from the *Completions*
+ ;; buffer, `proxy' won't have any properties.
+ ;; A lookup should fix that (github#148)
+ (get-text-property
+ 0 'eglot--lsp-item
+ (cl-find proxy (funcall proxies) :test #'string=))))
+ (let ((snippet-fn (and (eql insertTextFormat 2)
+ (eglot--snippet-expansion-fn))))
+ (cond (textEdit
+ ;; Undo (yes, undo) the newly inserted completion.
+ ;; If before completion the buffer was "foo.b" and
+ ;; now is "foo.bar", `proxy' will be "bar". We
+ ;; want to delete only "ar" (`proxy' minus the
+ ;; symbol whose bounds we've calculated before)
+ ;; (github#160).
+ (delete-region (+ (- (point) (length proxy))
+ (if bounds
+ (- (cdr bounds) (car bounds))
+ 0))
+ (point))
+ (eglot--dbind ((TextEdit) range newText) textEdit
+ (pcase-let ((`(,beg . ,end)
+ (eglot--range-region range)))
+ (delete-region beg end)
+ (goto-char beg)
+ (funcall (or snippet-fn #'insert) newText))))
+ (snippet-fn
+ ;; A snippet should be inserted, but using plain
+ ;; `insertText'. This requires us to delete the
+ ;; whole completion, since `insertText' is the full
+ ;; completion's text.
+ (delete-region (- (point) (length proxy)) (point))
+ (funcall snippet-fn (or insertText label))))
+ (when (cl-plusp (length additionalTextEdits))
+ (eglot--apply-text-edits additionalTextEdits)))
+ (eglot--signal-textDocument/didChange)
+ (eldoc)))))))))
+
+(defun eglot--hover-info (contents &optional _range)
+ (mapconcat #'eglot--format-markup
+ (if (vectorp contents) contents (list contents)) "\n"))
+
+(defun eglot--sig-info (sigs active-sig sig-help-active-param)
+ (cl-loop
+ for (sig . moresigs) on (append sigs nil) for i from 0
+ concat
+ (eglot--dbind ((SignatureInformation) label documentation parameters
activeParameter) sig
+ (with-temp-buffer
+ (save-excursion (insert label))
+ (let ((active-param (or activeParameter sig-help-active-param))
+ params-start params-end)
+ ;; Ad-hoc attempt to parse label as <name>(<params>)
+ (when (looking-at "\\([^(]+\\)(\\([^)]+\\))")
+ (setq params-start (match-beginning 2) params-end (match-end 2))
+ (add-face-text-property (match-beginning 1) (match-end 1)
+ 'font-lock-function-name-face))
+ (when (eql i active-sig)
+ ;; Decide whether to add one-line-summary to signature line
+ (when (and (stringp documentation)
+ (string-match "[[:space:]]*\\([^.\r\n]+[.]?\\)"
+ documentation))
+ (setq documentation (match-string 1 documentation))
+ (unless (string-prefix-p (string-trim documentation) label)
+ (goto-char (point-max))
+ (insert ": " (eglot--format-markup documentation))))
+ ;; Decide what to do with the active parameter...
+ (when (and (eql i active-sig) active-param
+ (< -1 active-param (length parameters)))
+ (eglot--dbind ((ParameterInformation) label documentation)
+ (aref parameters active-param)
+ ;; ...perhaps highlight it in the formals list
+ (when params-start
+ (goto-char params-start)
+ (pcase-let
+ ((`(,beg ,end)
+ (if (stringp label)
+ (let ((case-fold-search nil))
+ (and (re-search-forward
+ (concat "\\<" (regexp-quote label) "\\>")
+ params-end t)
+ (list (match-beginning 0) (match-end 0))))
+ (mapcar #'1+ (append label nil)))))
+ (if (and beg end)
+ (add-face-text-property
+ beg end
+ 'eldoc-highlight-function-argument))))
+ ;; ...and/or maybe add its doc on a line by its own.
+ (when documentation
+ (goto-char (point-max))
+ (insert "\n"
+ (propertize
+ (if (stringp label)
+ label
+ (apply #'buffer-substring (mapcar #'1+ label)))
+ 'face 'eldoc-highlight-function-argument)
+ ": " (eglot--format-markup documentation))))))
+ (buffer-string))))
+ when moresigs concat "\n"))
+
+(defun eglot-signature-eldoc-function (cb)
+ "A member of `eldoc-documentation-functions', for signatures."
+ (when (eglot--server-capable :signatureHelpProvider)
+ (let ((buf (current-buffer)))
+ (jsonrpc-async-request
+ (eglot--current-server-or-lose)
+ :textDocument/signatureHelp (eglot--TextDocumentPositionParams)
+ :success-fn
+ (eglot--lambda ((SignatureHelp)
+ signatures activeSignature activeParameter)
+ (eglot--when-buffer-window buf
+ (funcall cb
+ (unless (seq-empty-p signatures)
+ (eglot--sig-info signatures
+ activeSignature
+ activeParameter)))))
+ :deferred :textDocument/signatureHelp))
+ t))
+
+(defun eglot-hover-eldoc-function (cb)
+ "A member of `eldoc-documentation-functions', for hover."
+ (when (eglot--server-capable :hoverProvider)
+ (let ((buf (current-buffer)))
+ (jsonrpc-async-request
+ (eglot--current-server-or-lose)
+ :textDocument/hover (eglot--TextDocumentPositionParams)
+ :success-fn (eglot--lambda ((Hover) contents range)
+ (eglot--when-buffer-window buf
+ (let ((info (unless (seq-empty-p contents)
+ (eglot--hover-info contents range))))
+ (funcall cb info :buffer t))))
+ :deferred :textDocument/hover))
+ (eglot--highlight-piggyback cb)
+ t))
+
+(defvar eglot--highlights nil "Overlays for textDocument/documentHighlight.")
+
+(defun eglot--highlight-piggyback (_cb)
+ "Request and handle `:textDocument/documentHighlight'."
+ ;; FIXME: Obviously, this is just piggy backing on eldoc's calls for
+ ;; convenience, as shown by the fact that we just ignore cb.
+ (let ((buf (current-buffer)))
+ (when (eglot--server-capable :documentHighlightProvider)
+ (jsonrpc-async-request
+ (eglot--current-server-or-lose)
+ :textDocument/documentHighlight (eglot--TextDocumentPositionParams)
+ :success-fn
+ (lambda (highlights)
+ (mapc #'delete-overlay eglot--highlights)
+ (setq eglot--highlights
+ (eglot--when-buffer-window buf
+ (mapcar
+ (eglot--lambda ((DocumentHighlight) range)
+ (pcase-let ((`(,beg . ,end)
+ (eglot--range-region range)))
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face 'eglot-highlight-symbol-face)
+ (overlay-put ov 'modification-hooks
+ `(,(lambda (o &rest _) (delete-overlay
o))))
+ ov)))
+ highlights))))
+ :deferred :textDocument/documentHighlight)
+ nil)))
+
+(defun eglot-imenu ()
+ "Eglot's `imenu-create-index-function'.
+Returns a list as described in docstring of `imenu--index-alist'."
+ (cl-labels
+ ((unfurl (obj)
+ (eglot--dcase obj
+ (((SymbolInformation)) (list obj))
+ (((DocumentSymbol) name children)
+ (cons obj
+ (mapcar
+ (lambda (c)
+ (plist-put
+ c :containerName
+ (let ((existing (plist-get c :containerName)))
+ (if existing (format "%s::%s" name existing)
+ name))))
+ (mapcan #'unfurl children)))))))
+ (mapcar
+ (pcase-lambda (`(,kind . ,objs))
+ (cons
+ (alist-get kind eglot--symbol-kind-names "Unknown")
+ (mapcan (pcase-lambda (`(,container . ,objs))
+ (let ((elems (mapcar
+ (lambda (obj)
+ (cons (plist-get obj :name)
+ (car (eglot--range-region
+ (eglot--dcase obj
+ (((SymbolInformation) location)
+ (plist-get location :range))
+ (((DocumentSymbol)
selectionRange)
+ selectionRange))))))
+ objs)))
+ (if container (list (cons container elems)) elems)))
+ (seq-group-by
+ (lambda (e) (plist-get e :containerName)) objs))))
+ (seq-group-by
+ (lambda (obj) (plist-get obj :kind))
+ (mapcan #'unfurl
+ (jsonrpc-request (eglot--current-server-or-lose)
+ :textDocument/documentSymbol
+ `(:textDocument
+ ,(eglot--TextDocumentIdentifier))
+ :cancel-on-input non-essential))))))
+
+(defun eglot--apply-text-edits (edits &optional version)
+ "Apply EDITS for current buffer if at VERSION, or if it's nil."
+ (unless (or (not version) (equal version eglot--versioned-identifier))
+ (jsonrpc-error "Edits on `%s' require version %d, you have %d"
+ (current-buffer) version eglot--versioned-identifier))
+ (atomic-change-group
+ (let* ((change-group (prepare-change-group))
+ (howmany (length edits))
+ (reporter (make-progress-reporter
+ (format "[eglot] applying %s edits to `%s'..."
+ howmany (current-buffer))
+ 0 howmany))
+ (done 0))
+ (mapc (pcase-lambda (`(,newText ,beg . ,end))
+ (let ((source (current-buffer)))
+ (with-temp-buffer
+ (insert newText)
+ (let ((temp (current-buffer)))
+ (with-current-buffer source
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+
+ ;; On emacs versions < 26.2,
+ ;; `replace-buffer-contents' is buggy - it calls
+ ;; change functions with invalid arguments - so we
+ ;; manually call the change functions here.
+ ;;
+ ;; See emacs bugs #32237, #32278:
+ ;;
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237
+ ;;
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278
+ (let ((inhibit-modification-hooks t)
+ (length (- end beg))
+ (beg (marker-position beg))
+ (end (marker-position end)))
+ (run-hook-with-args 'before-change-functions
+ beg end)
+ (replace-buffer-contents temp)
+ (run-hook-with-args 'after-change-functions
+ beg (+ beg (length newText))
+ length))))
+ (progress-reporter-update reporter (cl-incf done)))))))
+ (mapcar (eglot--lambda ((TextEdit) range newText)
+ (cons newText (eglot--range-region range 'markers)))
+ (reverse edits)))
+ (undo-amalgamate-change-group change-group)
+ (progress-reporter-done reporter))))
+
+(defun eglot--apply-workspace-edit (wedit &optional confirm)
+ "Apply the workspace edit WEDIT. If CONFIRM, ask user first."
+ (eglot--dbind ((WorkspaceEdit) changes documentChanges) wedit
+ (let ((prepared
+ (mapcar (eglot--lambda ((TextDocumentEdit) textDocument edits)
+ (eglot--dbind ((VersionedTextDocumentIdentifier) uri
version)
+ textDocument
+ (list (eglot--uri-to-path uri) edits version)))
+ documentChanges)))
+ (unless (and changes documentChanges)
+ ;; We don't want double edits, and some servers send both
+ ;; changes and documentChanges. This unless ensures that we
+ ;; prefer documentChanges over changes.
+ (cl-loop for (uri edits) on changes by #'cddr
+ do (push (list (eglot--uri-to-path uri) edits) prepared)))
+ (if (or confirm
+ (cl-notevery #'find-buffer-visiting
+ (mapcar #'car prepared)))
+ (unless (y-or-n-p
+ (format "[eglot] Server wants to edit:\n %s\n Proceed? "
+ (mapconcat #'identity (mapcar #'car prepared) "\n
")))
+ (jsonrpc-error "User cancelled server edit")))
+ (cl-loop for edit in prepared
+ for (path edits version) = edit
+ do (with-current-buffer (find-file-noselect path)
+ (eglot--apply-text-edits edits version))
+ finally (eldoc) (eglot--message "Edit successful!")))))
+
+(defun eglot-rename (newname)
+ "Rename the current symbol to NEWNAME."
+ (interactive
+ (list (read-from-minibuffer
+ (format "Rename `%s' to: " (or (thing-at-point 'symbol t)
+ "unknown symbol"))
+ nil nil nil nil
+ (symbol-name (symbol-at-point)))))
+ (unless (eglot--server-capable :renameProvider)
+ (eglot--error "Server can't rename!"))
+ (eglot--apply-workspace-edit
+ (jsonrpc-request (eglot--current-server-or-lose)
+ :textDocument/rename
`(,@(eglot--TextDocumentPositionParams)
+ :newName ,newname))
+ current-prefix-arg))
+
+(defun eglot--region-bounds ()
+ "Region bounds if active, else bounds of things at point."
+ (if (use-region-p) `(,(region-beginning) ,(region-end))
+ (let ((boftap (bounds-of-thing-at-point 'sexp)))
+ (list (car boftap) (cdr boftap)))))
+
+(defun eglot-code-actions (beg &optional end action-kind interactive)
+ "Find LSP code actions of type ACTION-KIND between BEG and END.
+Interactively, offer to execute them.
+If ACTION-KIND is nil, consider all kinds of actions.
+Interactively, default BEG and END to region's bounds else BEG is
+point and END is nil, which results in a request for code actions
+at point. With prefix argument, prompt for ACTION-KIND."
+ (interactive
+ `(,@(eglot--region-bounds)
+ ,(and current-prefix-arg
+ (completing-read "[eglot] Action kind: "
+ '("quickfix" "refactor.extract" "refactor.inline"
+ "refactor.rewrite" "source.organizeImports")))
+ t))
+ (unless (or (not interactive)
+ (eglot--server-capable :codeActionProvider))
+ (eglot--error "Server can't execute code actions!"))
+ (let* ((server (eglot--current-server-or-lose))
+ (actions
+ (jsonrpc-request
+ server
+ :textDocument/codeAction
+ (list :textDocument (eglot--TextDocumentIdentifier)
+ :range (list :start (eglot--pos-to-lsp-position beg)
+ :end (eglot--pos-to-lsp-position end))
+ :context
+ `(:diagnostics
+ [,@(cl-loop for diag in (flymake-diagnostics beg end)
+ when (cdr (assoc 'eglot-lsp-diag
+ (eglot--diag-data diag)))
+ collect it)]
+ ,@(when action-kind `(:only [,action-kind]))))
+ :deferred t))
+ ;; Redo filtering, in case the `:only' didn't go through.
+ (actions (cl-loop for a across actions
+ when (or (not action-kind)
+ (equal action-kind (plist-get a :kind)))
+ collect a)))
+ (if interactive
+ (eglot--read-execute-code-action actions server action-kind)
+ actions)))
+
+(defun eglot--read-execute-code-action (actions server &optional action-kind)
+ "Helper for interactive calls to `eglot-code-actions'"
+ (let* ((menu-items
+ (or (cl-loop for a in actions
+ collect (cons (plist-get a :title) a))
+ (apply #'eglot--error
+ (if action-kind `("No \"%s\" code actions here"
,action-kind)
+ `("No code actions here")))))
+ (preferred-action (cl-find-if
+ (lambda (menu-item)
+ (plist-get (cdr menu-item) :isPreferred))
+ menu-items))
+ (default-action (car (or preferred-action (car menu-items))))
+ (chosen (if (and action-kind (null (cadr menu-items)))
+ (cdr (car menu-items))
+ (if (listp last-nonmenu-event)
+ (x-popup-menu last-nonmenu-event `("Eglot code actions:"
+ ("dummy"
,@menu-items)))
+ (cdr (assoc (completing-read
+ (format "[eglot] Pick an action (default
%s): "
+ default-action)
+ menu-items nil t nil nil default-action)
+ menu-items))))))
+ (eglot--dcase chosen
+ (((Command) command arguments)
+ (eglot-execute-command server (intern command) arguments))
+ (((CodeAction) edit command)
+ (when edit (eglot--apply-workspace-edit edit))
+ (when command
+ (eglot--dbind ((Command) command arguments) command
+ (eglot-execute-command server (intern command) arguments)))))))
+
+(defmacro eglot--code-action (name kind)
+ "Define NAME to execute KIND code action."
+ `(defun ,name (beg &optional end)
+ ,(format "Execute `%s' code actions between BEG and END." kind)
+ (interactive (eglot--region-bounds))
+ (eglot-code-actions beg end ,kind)))
+
+(eglot--code-action eglot-code-action-organize-imports
"source.organizeImports")
+(eglot--code-action eglot-code-action-extract "refactor.extract")
+(eglot--code-action eglot-code-action-inline "refactor.inline")
+(eglot--code-action eglot-code-action-rewrite "refactor.rewrite")
+(eglot--code-action eglot-code-action-quickfix "quickfix")
+
+
+;;; Dynamic registration
+;;;
+(cl-defmethod eglot-register-capability
+ (server (method (eql workspace/didChangeWatchedFiles)) id &key watchers)
+ "Handle dynamic registration of workspace/didChangeWatchedFiles."
+ (eglot-unregister-capability server method id)
+ (let* (success
+ (globs (mapcar
+ (eglot--lambda ((FileSystemWatcher) globPattern)
+ (eglot--glob-compile globPattern t t))
+ watchers))
+ (dirs-to-watch
+ (delete-dups (mapcar #'file-name-directory
+ (project-files
+ (eglot--project server))))))
+ (cl-labels
+ ((handle-event
+ (event)
+ (pcase-let ((`(,desc ,action ,file ,file1) event))
+ (cond
+ ((and (memq action '(created changed deleted))
+ (cl-find file globs :test (lambda (f g) (funcall g f))))
+ (jsonrpc-notify
+ server :workspace/didChangeWatchedFiles
+ `(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
+ :type ,(cl-case action
+ (created 1)
+ (changed 2)
+ (deleted 3)))))))
+ ((eq action 'renamed)
+ (handle-event `(,desc 'deleted ,file))
+ (handle-event `(,desc 'created ,file1)))))))
+ (unwind-protect
+ (progn
+ (dolist (dir dirs-to-watch)
+ (push (file-notify-add-watch dir '(change) #'handle-event)
+ (gethash id (eglot--file-watches server))))
+ (setq
+ success
+ `(:message ,(format "OK, watching %s directories in %s watchers"
+ (length dirs-to-watch) (length watchers)))))
+ (unless success
+ (eglot-unregister-capability server method id))))))
+
+(cl-defmethod eglot-unregister-capability
+ (server (_method (eql workspace/didChangeWatchedFiles)) id)
+ "Handle dynamic unregistration of workspace/didChangeWatchedFiles."
+ (mapc #'file-notify-rm-watch (gethash id (eglot--file-watches server)))
+ (remhash id (eglot--file-watches server))
+ (list t "OK"))
+
+
+;;; Glob heroics
+;;;
+(defun eglot--glob-parse (glob)
+ "Compute list of (STATE-SYM EMITTER-FN PATTERN)."
+ (with-temp-buffer
+ (save-excursion (insert glob))
+ (cl-loop
+ with grammar = '((:** "\\*\\*/?" eglot--glob-emit-**)
+ (:* "\\*" eglot--glob-emit-*)
+ (:? "\\?" eglot--glob-emit-?)
+ (:{} "{[^][*{}]+}" eglot--glob-emit-{})
+ (:range "\\[\\^?[^][/,*{}]+\\]" eglot--glob-emit-range)
+ (:literal "[^][,*?{}]+" eglot--glob-emit-self))
+ until (eobp)
+ collect (cl-loop
+ for (_token regexp emitter) in grammar
+ thereis (and (re-search-forward (concat "\\=" regexp) nil t)
+ (list (cl-gensym "state-") emitter (match-string
0)))
+ finally (error "Glob '%s' invalid at %s" (buffer-string)
(point))))))
+
+(defun eglot--glob-compile (glob &optional byte-compile noerror)
+ "Convert GLOB into Elisp function. Maybe BYTE-COMPILE it.
+If NOERROR, return predicate, else erroring function."
+ (let* ((states (eglot--glob-parse glob))
+ (body `(with-current-buffer (get-buffer-create "
*eglot-glob-matcher*")
+ (erase-buffer)
+ (save-excursion (insert string))
+ (cl-labels ,(cl-loop for (this that) on states
+ for (self emit text) = this
+ for next = (or (car that) 'eobp)
+ collect (funcall emit text self next))
+ (or (,(caar states))
+ (error "Glob done but more unmatched text: '%s'"
+ (buffer-substring (point) (point-max)))))))
+ (form `(lambda (string) ,(if noerror `(ignore-errors ,body) body))))
+ (if byte-compile (byte-compile form) form)))
+
+(defun eglot--glob-emit-self (text self next)
+ `(,self () (re-search-forward ,(concat "\\=" (regexp-quote text))) (,next)))
+
+(defun eglot--glob-emit-** (_ self next)
+ `(,self () (or (ignore-errors (save-excursion (,next)))
+ (and (re-search-forward "\\=/?[^/]+/?") (,self)))))
+
+(defun eglot--glob-emit-* (_ self next)
+ `(,self () (re-search-forward "\\=[^/]")
+ (or (ignore-errors (save-excursion (,next))) (,self))))
+
+(defun eglot--glob-emit-? (_ self next)
+ `(,self () (re-search-forward "\\=[^/]") (,next)))
+
+(defun eglot--glob-emit-{} (arg self next)
+ (let ((alternatives (split-string (substring arg 1 (1- (length arg))) ",")))
+ `(,self ()
+ (or (re-search-forward ,(concat "\\=" (regexp-opt alternatives))
nil t)
+ (error "Failed matching any of %s" ',alternatives))
+ (,next))))
+
+(defun eglot--glob-emit-range (arg self next)
+ (when (eq ?! (aref arg 1)) (aset arg 1 ?^))
+ `(,self () (re-search-forward ,(concat "\\=" arg)) (,next)))
+
+
+;;; List connections mode
+
+(define-derived-mode eglot-list-connections-mode tabulated-list-mode
+ "" "Eglot mode for listing server connections
+\\{eglot-list-connections-mode-map}"
+ (setq-local tabulated-list-format
+ `[("Language server" 16) ("Project name" 16) ("Modes handled"
16)])
+ (tabulated-list-init-header))
+
+(defun eglot-list-connections ()
+ "List currently active Eglot connections."
+ (interactive)
+ (with-current-buffer
+ (get-buffer-create "*EGLOT connections*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (eglot-list-connections-mode)
+ (setq-local tabulated-list-entries
+ (mapcar
+ (lambda (server)
+ (list server
+ `[,(or (plist-get (eglot--server-info server) :name)
+ (jsonrpc-name server))
+ ,(eglot-project-nickname server)
+ ,(mapconcat #'symbol-name
+ (eglot--major-modes server)
+ ", ")]))
+ (cl-reduce #'append
+ (hash-table-values eglot--servers-by-project))))
+ (revert-buffer)
+ (pop-to-buffer (current-buffer)))))
+
+
+;;; Hacks
+;;;
+;; FIXME: Although desktop.el compatibility is Emacs bug#56407, the
+;; optimal solution agreed to there is a bit more work than what I
+;; have time to right now. See
+;; e.g. https://debbugs.gnu.org/cgi/bugreport.cgi?bug=bug%2356407#68.
+;; For now, just use `with-eval-after-load'
+(with-eval-after-load 'desktop
+ (add-to-list 'desktop-minor-mode-handlers '(eglot--managed-mode . ignore)))
+
+
+;;; Obsolete
+;;;
+
+(make-obsolete-variable 'eglot--managed-mode-hook
+ 'eglot-managed-mode-hook "1.6")
+(provide 'eglot)
+
+
+;;; Backend completion
+
+;; Written by Stefan Monnier circa 2016. Something to move to
+;; minibuffer.el "ASAP" (with all the `eglot--lsp-' replaced by
+;; something else. The very same code already in SLY and stable for a
+;; long time.
+
+;; This "completion style" delegates all the work to the "programmable
+;; completion" table which is then free to implement its own
+;; completion style. Typically this is used to take advantage of some
+;; external tool which already has its own completion system and
+;; doesn't give you efficient access to the prefix completion needed
+;; by other completion styles. The table should recognize the symbols
+;; 'eglot--lsp-tryc and 'eglot--lsp-allc as ACTION, reply with
+;; (eglot--lsp-tryc COMP...) or (eglot--lsp-allc . (STRING . POINT)),
+;; accordingly. tryc/allc names made akward/recognizable on purpose.
+
+(add-to-list 'completion-styles-alist
+ '(eglot--lsp-backend-style
+ eglot--lsp-backend-style-try-completion
+ eglot--lsp-backend-style-all-completions
+ "Ad-hoc completion style provided by the completion table."))
+
+(defun eglot--lsp-backend-style-call (op string table pred point)
+ (when (functionp table)
+ (let ((res (funcall table string pred (cons op point))))
+ (when (eq op (car-safe res))
+ (cdr res)))))
+
+(defun eglot--lsp-backend-style-try-completion (string table pred point)
+ (eglot--lsp-backend-style-call 'eglot--lsp-tryc string table pred point))
+
+(defun eglot--lsp-backend-style-all-completions (string table pred point)
+ (eglot--lsp-backend-style-call 'eglot--lsp-allc string table pred point))
+
+
+;; Local Variables:
+;; bug-reference-bug-regexp: "\\(github#\\([0-9]+\\)\\)"
+;; bug-reference-url-format: "https://github.com/joaotavora/eglot/issues/%s";
+;; checkdoc-force-docstrings-flag: nil
+;; End:
+
+;;; eglot.el ends here
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 7e7ea6aeb9..537b9484bd 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1826,8 +1826,8 @@ or elsewhere, return a 1-line docstring."
(eq 'function (aref elisp--eldoc-last-data 2)))
(aref elisp--eldoc-last-data 1))
(t
- (let* ((advertised (gethash (indirect-function sym)
- advertised-signature-table t))
+ (let* ((advertised (get-advertised-calling-convention
+ (indirect-function sym)))
doc
(args
(cond
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 58d7a2026e..6791e2fc9f 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -1,7 +1,6 @@
;;; fortran.el --- Fortran mode for GNU Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1986, 1993-1995, 1997-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1986-2022 Free Software Foundation, Inc.
;; Author: Michael D. Prange <prange@erl.mit.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -624,34 +623,32 @@ Used in the Fortran entry in `hs-special-modes-alist'.")
st)
"Syntax table used to parse Fortran expressions for printing in GUD.")
-(defvar fortran-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map ";" 'fortran-abbrev-start)
- (define-key map "\C-c;" 'fortran-comment-region)
- ;; The default comment-dwim does at least as much as this.
-;;; (define-key map "\M-;" 'fortran-indent-comment)
- (define-key map "\M-\n" 'fortran-split-line)
- (define-key map "\M-\C-n" 'fortran-end-of-block)
- (define-key map "\M-\C-p" 'fortran-beginning-of-block)
- (define-key map "\M-\C-q" 'fortran-indent-subprogram)
- (define-key map "\C-c\C-w" 'fortran-window-create-momentarily)
- (define-key map "\C-c\C-r" 'fortran-column-ruler)
- (define-key map "\C-c\C-p" 'fortran-previous-statement)
- (define-key map "\C-c\C-n" 'fortran-next-statement)
- (define-key map "\C-c\C-d" 'fortran-join-line) ; like f90
- (define-key map "\M-^" 'fortran-join-line) ; subvert delete-indentation
- (define-key map "0" 'fortran-electric-line-number)
- (define-key map "1" 'fortran-electric-line-number)
- (define-key map "2" 'fortran-electric-line-number)
- (define-key map "3" 'fortran-electric-line-number)
- (define-key map "4" 'fortran-electric-line-number)
- (define-key map "5" 'fortran-electric-line-number)
- (define-key map "6" 'fortran-electric-line-number)
- (define-key map "7" 'fortran-electric-line-number)
- (define-key map "8" 'fortran-electric-line-number)
- (define-key map "9" 'fortran-electric-line-number)
- map)
- "Keymap used in Fortran mode.")
+(defvar-keymap fortran-mode-map
+ :doc "Keymap used in Fortran mode."
+ ";" #'fortran-abbrev-start
+ "C-c ;" #'fortran-comment-region
+ ;; The default comment-dwim does at least as much as this.
+ ;; "M-;" #'fortran-indent-comment
+ "C-M-j" #'fortran-split-line
+ "C-M-n" #'fortran-end-of-block
+ "C-M-p" #'fortran-beginning-of-block
+ "C-M-q" #'fortran-indent-subprogram
+ "C-c C-w" #'fortran-window-create-momentarily
+ "C-c C-r" #'fortran-column-ruler
+ "C-c C-p" #'fortran-previous-statement
+ "C-c C-n" #'fortran-next-statement
+ "C-c C-d" #'fortran-join-line ; like f90
+ "M-^" #'fortran-join-line ; subvert delete-indentation
+ "0" #'fortran-electric-line-number
+ "1" #'fortran-electric-line-number
+ "2" #'fortran-electric-line-number
+ "3" #'fortran-electric-line-number
+ "4" #'fortran-electric-line-number
+ "5" #'fortran-electric-line-number
+ "6" #'fortran-electric-line-number
+ "7" #'fortran-electric-line-number
+ "8" #'fortran-electric-line-number
+ "9" #'fortran-electric-line-number)
(define-abbrev-table 'fortran-mode-abbrev-table
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 6e8032b7ea..0de3d213a4 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -966,7 +966,7 @@ detailed description of this mode.
(if gdb-active-process
(gdb-gud-context-command "-exec-continue")
"-exec-run")))
- "C-v" "Start or continue execution. Use a prefix to specify arguments.")
+ "\C-v" "Start or continue execution. Use a prefix to specify arguments.")
;; For debugging Emacs only.
(gud-def gud-pp
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 2a1b6d6b7b..6de079f05a 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -3,7 +3,7 @@
;; Copyright (C) 1994-2022 Free Software Foundation, Inc.
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
-;; Dan Nicolaescu <dann@ics.uci.edu>
+;; Dan Nicolaescu <dann@gnu.org>
;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
;; Maintainer-Version: 5.65.2.2
;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
@@ -256,7 +256,7 @@ This has effect only if `search-invisible' is set to
`open'."
;;;###autoload
(defvar hs-special-modes-alist
- (mapcar 'purecopy
+ (mapcar #'purecopy
'((c-mode "{" "}" "/[*/]" nil nil)
(c++-mode "{" "}" "/[*/]" nil nil)
(bibtex-mode ("@\\S(*\\(\\s(\\)" 1))
@@ -351,17 +351,17 @@ Use the command `hs-minor-mode' to toggle or set this
variable.")
(defvar hs-minor-mode-map
(let ((map (make-sparse-keymap)))
;; These bindings roughly imitate those used by Outline mode.
- (define-key map "\C-c@\C-h" 'hs-hide-block)
- (define-key map "\C-c@\C-s" 'hs-show-block)
- (define-key map "\C-c@\C-\M-h" 'hs-hide-all)
- (define-key map "\C-c@\C-\M-s" 'hs-show-all)
- (define-key map "\C-c@\C-l" 'hs-hide-level)
- (define-key map "\C-c@\C-c" 'hs-toggle-hiding)
- (define-key map "\C-c@\C-a" 'hs-show-all)
- (define-key map "\C-c@\C-t" 'hs-hide-all)
- (define-key map "\C-c@\C-d" 'hs-hide-block)
- (define-key map "\C-c@\C-e" 'hs-toggle-hiding)
- (define-key map [(shift mouse-2)] 'hs-toggle-hiding)
+ (define-key map "\C-c@\C-h" #'hs-hide-block)
+ (define-key map "\C-c@\C-s" #'hs-show-block)
+ (define-key map "\C-c@\C-\M-h" #'hs-hide-all)
+ (define-key map "\C-c@\C-\M-s" #'hs-show-all)
+ (define-key map "\C-c@\C-l" #'hs-hide-level)
+ (define-key map "\C-c@\C-c" #'hs-toggle-hiding)
+ (define-key map "\C-c@\C-a" #'hs-show-all)
+ (define-key map "\C-c@\C-t" #'hs-hide-all)
+ (define-key map "\C-c@\C-d" #'hs-hide-block)
+ (define-key map "\C-c@\C-e" #'hs-toggle-hiding)
+ (define-key map [(shift mouse-2)] #'hs-toggle-hiding)
map)
"Keymap for hideshow minor mode.")
@@ -778,12 +778,10 @@ region (point MAXP)."
(defmacro hs-life-goes-on (&rest body)
"Evaluate BODY forms if variable `hs-minor-mode' is non-nil.
-In the dynamic context of this macro, `inhibit-point-motion-hooks'
-and `case-fold-search' are both t."
+In the dynamic context of this macro, `case-fold-search' is t."
(declare (debug t))
`(when hs-minor-mode
- (let ((inhibit-point-motion-hooks t)
- (case-fold-search t))
+ (let ((case-fold-search t))
,@body)))
(defun hs-find-block-beginning-match ()
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index cbbcf1c2b7..5f26521299 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -488,17 +488,12 @@ not be enclosed in { } or ( )."
(defconst makefile-imake-font-lock-keywords
- (append
- (makefile-make-font-lock-keywords
- makefile-var-use-regex
- makefile-statements
- t
- nil
- '("^XCOMM.*$" . font-lock-comment-face)
- '("XVAR\\(?:use\\|def\\)[0-9]" 0 font-lock-keyword-face prepend)
- '("@@" . font-lock-preprocessor-face)
- )
- cpp-font-lock-keywords))
+ (append (list '("XCOMM.*$" . font-lock-comment-face)
+ '("XVAR\\(?:use\\|def\\)[0-9]" 0
+ font-lock-keyword-face prepend)
+ '("@@" . font-lock-preprocessor-face))
+ cpp-font-lock-keywords
+ makefile-font-lock-keywords))
(defconst makefile-syntax-propertize-function
@@ -932,7 +927,9 @@ Makefile mode can be configured by modifying the following
variables:
:syntax-table makefile-imake-mode-syntax-table
(setq-local syntax-propertize-function nil)
(setq font-lock-defaults
- `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))))
+ `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults)))
+ (setq-local comment-start "XCOMM")
+ (setq-local comment-start-skip "XCOMM[ \t]*"))
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index e668570ba1..09cb848fd5 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -65,39 +65,36 @@
"Column for aligning the end of a comment, in Modula-2."
:type 'integer)
-;;; Added by TEP
-(defvar m2-mode-map
- (let ((map (make-sparse-keymap)))
- ;; FIXME: Many of those bindings are contrary to coding conventions.
- (define-key map "\C-cb" #'m2-begin)
- (define-key map "\C-cc" #'m2-case)
- (define-key map "\C-cd" #'m2-definition)
- (define-key map "\C-ce" #'m2-else)
- (define-key map "\C-cf" #'m2-for)
- (define-key map "\C-ch" #'m2-header)
- (define-key map "\C-ci" #'m2-if)
- (define-key map "\C-cm" #'m2-module)
- (define-key map "\C-cl" #'m2-loop)
- (define-key map "\C-co" #'m2-or)
- (define-key map "\C-cp" #'m2-procedure)
- (define-key map "\C-c\C-w" #'m2-with)
- (define-key map "\C-cr" #'m2-record)
- (define-key map "\C-cs" #'m2-stdio)
- (define-key map "\C-ct" #'m2-type)
- (define-key map "\C-cu" #'m2-until)
- (define-key map "\C-cv" #'m2-var)
- (define-key map "\C-cw" #'m2-while)
- (define-key map "\C-cx" #'m2-export)
- (define-key map "\C-cy" #'m2-import)
- (define-key map "\C-c{" #'m2-begin-comment)
- (define-key map "\C-c}" #'m2-end-comment)
- (define-key map "\C-c\C-z" #'suspend-emacs)
- (define-key map "\C-c\C-v" #'m2-visit)
- (define-key map "\C-c\C-t" #'m2-toggle)
- (define-key map "\C-c\C-l" #'m2-link)
- (define-key map "\C-c\C-c" #'m2-compile)
- map)
- "Keymap used in Modula-2 mode.")
+(defvar-keymap m2-mode-map
+ :doc "Keymap used in Modula-2 mode."
+ ;; FIXME: Many of those bindings are contrary to coding conventions.
+ "C-c b" #'m2-begin
+ "C-c c" #'m2-case
+ "C-c d" #'m2-definition
+ "C-c e" #'m2-else
+ "C-c f" #'m2-for
+ "C-c h" #'m2-header
+ "C-c i" #'m2-if
+ "C-c m" #'m2-module
+ "C-c l" #'m2-loop
+ "C-c o" #'m2-or
+ "C-c p" #'m2-procedure
+ "C-c C-w" #'m2-with
+ "C-c r" #'m2-record
+ "C-c s" #'m2-stdio
+ "C-c t" #'m2-type
+ "C-c u" #'m2-until
+ "C-c v" #'m2-var
+ "C-c w" #'m2-while
+ "C-c x" #'m2-export
+ "C-c y" #'m2-import
+ "C-c {" #'m2-begin-comment
+ "C-c }" #'m2-end-comment
+ "C-c C-z" #'suspend-emacs
+ "C-c C-v" #'m2-visit
+ "C-c C-t" #'m2-toggle
+ "C-c C-l" #'m2-link
+ "C-c C-c" #'m2-compile)
(defcustom m2-indent 5
"This variable gives the indentation in Modula-2 mode."
diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el
index 5ed719b5a7..fb1e501066 100644
--- a/lisp/progmodes/opascal.el
+++ b/lisp/progmodes/opascal.el
@@ -275,8 +275,7 @@ nested routine.")
(declare (debug t))
`(save-excursion
(save-match-data
- (let ((inhibit-point-motion-hooks t)
- (deactivate-mark nil))
+ (let ((deactivate-mark nil))
(progn ,@forms)))))
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 7b7a2cdf01..db9df67279 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -215,11 +215,16 @@
(eval-and-compile
(defconst perl--syntax-exp-intro-keywords
'("split" "if" "unless" "until" "while" "print" "printf"
- "grep" "map" "not" "or" "and" "for" "foreach" "return"))
+ "grep" "map" "not" "or" "and" "for" "foreach" "return" "die"
+ "warn" "eval"))
(defconst perl--syntax-exp-intro-regexp
(concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
(regexp-opt perl--syntax-exp-intro-keywords)
+ ;; A HERE document as an argument to printf?
+ ;; when printing to a filehandle.
+ "\\|printf?[ \t]*\\$?[_[:alpha:]][_[:alnum:]]*"
+ "\\|=>"
"\\|[?:.,;|&*=!~({[]"
"\\|[^-+][-+]" ;Bug#42168: `+' is intro but `++' isn't!
"\\|\\(^\\)\\)[ \t\n]*")))
@@ -335,7 +340,7 @@
"<<\\(~\\)?[
\t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)"
;; The <<EOF case which needs perl--syntax-exp-intro-regexp, to
;; disambiguate with the left-bitshift operator.
- "\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)"
+ "\\|" perl--syntax-exp-intro-regexp "<<\\(?1:~\\)?\\(?2:\\sw+\\)\\)"
".*\\(\n\\)")
(4 (let* ((eol (match-beginning 4))
(st (get-text-property eol 'syntax-table))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index ee94d0d85d..ac278edd40 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t;
-*-
;; Copyright (C) 2015-2022 Free Software Foundation, Inc.
-;; Version: 0.8.1
+;; Version: 0.8.2
;; Package-Requires: ((emacs "26.1") (xref "1.4.0"))
;; This is a GNU ELPA :core package. Avoid using functionality that
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 80c5b31b6e..1119589423 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -3413,15 +3413,25 @@ detecting a prompt at the end of the buffer."
"Send STRING to PROCESS and inhibit output.
Return the output."
(or process (setq process (python-shell-get-process-or-error)))
- (cl-letf (((process-filter process)
- (lambda (_proc str)
- (with-current-buffer (process-buffer process)
- (python-shell-output-filter str))))
- (python-shell-output-filter-in-progress t)
- (inhibit-quit t))
+ (cl-letf* (((process-filter process)
+ (lambda (_proc str)
+ (with-current-buffer (process-buffer process)
+ (python-shell-output-filter str))))
+ (python-shell-output-filter-in-progress t)
+ (inhibit-quit t)
+ (buffer (process-buffer process))
+ (last-prompt (cond ((boundp 'comint-last-prompt-overlay)
+ 'comint-last-prompt-overlay)
+ ((boundp 'comint-last-prompt)
+ 'comint-last-prompt)))
+ (last-prompt-value (buffer-local-value last-prompt buffer)))
(or
(with-local-quit
- (python-shell-send-string string process)
+ (unwind-protect
+ (python-shell-send-string string process)
+ (when (not (null last-prompt))
+ (with-current-buffer buffer
+ (set last-prompt last-prompt-value))))
(while python-shell-output-filter-in-progress
;; `python-shell-output-filter' takes care of setting
;; `python-shell-output-filter-in-progress' to NIL after it
@@ -3430,7 +3440,7 @@ Return the output."
(prog1
python-shell-output-filter-buffer
(setq python-shell-output-filter-buffer nil)))
- (with-current-buffer (process-buffer process)
+ (with-current-buffer buffer
(comint-interrupt-subjob)))))
(defun python-shell-internal-send-string (string)
@@ -4059,7 +4069,8 @@ With argument MSG show activation/deactivation message."
Optional argument PROCESS forces completions to be retrieved
using that one instead of current buffer's process."
(setq process (or process (get-buffer-process (current-buffer))))
- (let* ((line-start (if (derived-mode-p 'inferior-python-mode)
+ (let* ((is-shell-buffer (derived-mode-p 'inferior-python-mode))
+ (line-start (if is-shell-buffer
;; Working on a shell buffer: use prompt end.
(cdr (python-util-comint-last-prompt))
(line-beginning-position)))
@@ -4069,15 +4080,18 @@ using that one instead of current buffer's process."
(buffer-substring-no-properties line-start (point)))
(buffer-substring-no-properties line-start (point))))
(start
- (save-excursion
- (if (not (re-search-backward
- (python-rx
- (or whitespace open-paren close-paren string-delimiter
simple-operator))
- line-start
- t 1))
- line-start
- (forward-char (length (match-string-no-properties 0)))
- (point))))
+ (if (< (point) line-start)
+ (point)
+ (save-excursion
+ (if (not (re-search-backward
+ (python-rx
+ (or whitespace open-paren close-paren
+ string-delimiter simple-operator))
+ line-start
+ t 1))
+ line-start
+ (forward-char (length (match-string-no-properties 0)))
+ (point)))))
(end (point))
(prompt-boundaries
(with-current-buffer (process-buffer process)
@@ -4090,7 +4104,11 @@ using that one instead of current buffer's process."
(completion-fn
(with-current-buffer (process-buffer process)
(cond ((or (null prompt)
- (< (point) (cdr prompt-boundaries)))
+ (and is-shell-buffer
+ (< (point) (cdr prompt-boundaries)))
+ (and (not is-shell-buffer)
+ (string-match-p
+ python-shell-prompt-pdb-regexp prompt)))
#'ignore)
((or (not python-shell-completion-native-enable)
;; Even if native completion is enabled, for
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index fa799a0fb3..d6b8edaa36 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -3409,7 +3409,8 @@ A change is considered significant if it affects the
buffer text
in any way that isn't completely restored again. Any
user-visible changes to the buffer must not be within a
`verilog-save-buffer-state'."
- `(let ((inhibit-point-motion-hooks t)
+ `(let (,@(unless (>= emacs-major-version 25)
+ '((inhibit-point-motion-hooks t)))
(verilog-no-change-functions t))
,(if (fboundp 'with-silent-modifications)
`(with-silent-modifications ,@body)
@@ -3455,11 +3456,13 @@ For insignificant changes, see instead
`verilog-save-buffer-state'."
(run-hook-with-args 'before-change-functions (point-min) (point-max))
(unwind-protect
;; Must inhibit and restore hooks before restoring font-lock
- (let* ((inhibit-point-motion-hooks t)
+ (let* (,@(unless (>= emacs-major-version 25)
+ '((inhibit-point-motion-hooks t) ;Obsolete since 25.1
+ ;; XEmacs and pre-Emacs 21 ignore
+ ;; `inhibit-modification-hooks'.
+ before-change-functions after-change-functions))
(inhibit-modification-hooks t)
- (verilog-no-change-functions t)
- ;; XEmacs and pre-Emacs 21 ignore inhibit-modification-hooks.
- before-change-functions after-change-functions)
+ (verilog-no-change-functions t))
(progn ,@body))
;; Unwind forms
(run-hook-with-args 'after-change-functions (point-min) (point-max)
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index b763da3fbc..a36bb7fbe4 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -2507,11 +2507,10 @@ consistent searching."
(defmacro vhdl-prepare-search-2 (&rest body)
"Enable case insensitive search, switch to syntax table that includes `_',
-arrange to ignore `intangible' overlays, then execute BODY, and finally restore
-the old environment. Used for consistent searching."
+then execute BODY, and finally restore the old environment.
+Used for consistent searching."
(declare (debug t))
- `(let ((case-fold-search t) ; case insensitive search
- (inhibit-point-motion-hooks t))
+ `(let ((case-fold-search t)) ; case insensitive search
;; use extended syntax table
(with-syntax-table vhdl-mode-ext-syntax-table
;; execute BODY safely
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index ac04b64ce5..bb36688ef8 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -751,17 +751,22 @@ quit the *xref* buffer."
(defun xref-query-replace-in-results (from to)
"Perform interactive replacement of FROM with TO in all displayed xrefs.
-This command interactively replaces FROM with TO in the names of the
+This function interactively replaces FROM with TO in the names of the
references displayed in the current *xref* buffer.
-When called interactively, it uses '.*' as FROM, which means
-replace the whole name. Unless called with prefix argument, in
-which case the user is prompted for both FROM and TO.
+When called interactively, it uses '.*' as FROM, which means replace
+the whole name, and prompts the user for TO.
+If invoked with prefix argument, it prompts the user for both FROM and TO.
As each match is found, the user must type a character saying
what to do with it. Type SPC or `y' to replace the match,
DEL or `n' to skip and go to the next match. For more directions,
-type \\[help-command] at that time."
+type \\[help-command] at that time.
+
+Note that this function cannot be used in *xref* buffers that show
+a partial list of all references, such as the *xref* buffer created
+by \\[xref-find-definitions] and its variants, since those list only
+some of the references to the identifiers."
(interactive
(let* ((fr
(if current-prefix-arg
@@ -891,7 +896,9 @@ ITEMS is an xref item which " ; FIXME: Expand documentation.
(setq pairs (cdr buf-pairs))
(setq continue
(perform-replace from to t t nil nil multi-query-replace-map)))
- (unless did-it-once (user-error "No suitable matches here"))
+ (unless did-it-once
+ (user-error
+ "Cannot perform global renaming of symbols using find-definition
results"))
(when (and continue (not buf-pairs))
(message "All results processed"))))
diff --git a/lisp/server.el b/lisp/server.el
index 3caa335c4e..90d97c1538 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1589,14 +1589,19 @@ specifically for the clients and did not exist before
their request for it."
(server-buffer-done (current-buffer))))
(defun server-kill-emacs-query-function ()
- "Ask before exiting Emacs if it has live clients.
+ "Ask before exiting Emacs if it has other live clients.
A \"live client\" is a client with at least one live buffer
-associated with it."
- (or (not (seq-some (lambda (proc)
- (seq-some #'buffer-live-p
- (process-get proc 'buffers)))
- server-clients))
- (yes-or-no-p "This Emacs session has clients; exit anyway? ")))
+associated with it. These clients were (probably) started by
+external processes that are waiting for some buffers to be
+edited. If there are any other clients, we don't want to fail
+their waiting processes, so ask the user to be sure."
+ (let ((this-client (frame-parameter nil 'client)))
+ (or (not (seq-some (lambda (proc)
+ (unless (eq proc this-client)
+ (seq-some #'buffer-live-p
+ (process-get proc 'buffers))))
+ server-clients))
+ (yes-or-no-p "This Emacs session has other clients; exit anyway? "))))
(defun server-kill-buffer ()
"Remove the current buffer from its clients' buffer list.
diff --git a/lisp/simple.el b/lisp/simple.el
index 6b73ccb516..e804f717b0 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2465,9 +2465,13 @@ Also see `suggest-key-bindings'."
(defun execute-extended-command--shorter (name typed)
(let ((candidates '())
+ commands
(max (length typed))
(len 1)
binding)
+ ;; Precompute a list of commands once to avoid repeated `commandp' testing
+ ;; of symbols in the `completion-try-completion' call inside the loop below
+ (mapatoms (lambda (s) (when (commandp s) (push s commands))))
(while (and (not binding)
(progn
(unless candidates
@@ -2480,8 +2484,8 @@ Also see `suggest-key-bindings'."
(input-pending-p) ;Dummy call to trigger input-processing, bug#23002.
(let ((candidate (pop candidates)))
(when (equal name
- (car-safe (completion-try-completion
- candidate obarray 'commandp len)))
+ (car-safe (completion-try-completion
+ candidate commands nil len)))
(setq binding candidate))))
binding))
@@ -3526,8 +3530,6 @@ Return what remains of the list."
;; In a writable buffer, enable undoing read-only text that is
;; so because of text properties.
(inhibit-read-only t)
- ;; Don't let `intangible' properties interfere with undo.
- (inhibit-point-motion-hooks t)
;; We use oldlist only to check for EQ. ++kfs
(oldlist buffer-undo-list)
(did-apply nil)
@@ -7839,7 +7841,9 @@ If NOERROR, don't signal an error if we can't move that
many lines."
(defun line-move-1 (arg &optional noerror _to-end)
;; Don't run any point-motion hooks, and disregard intangibility,
;; for intermediate positions.
- (let ((inhibit-point-motion-hooks t)
+ (with-suppressed-warnings ((obsolete inhibit-point-motion-hooks))
+ (let ((outer-ipmh inhibit-point-motion-hooks)
+ (inhibit-point-motion-hooks t)
(opoint (point))
(orig-arg arg))
(if (consp temporary-goal-column)
@@ -7951,20 +7955,20 @@ If NOERROR, don't signal an error if we can't move that
many lines."
;; point-left-hooks.
(let* ((npoint (prog1 (line-end-position)
(goto-char opoint)))
- (inhibit-point-motion-hooks nil))
+ (inhibit-point-motion-hooks outer-ipmh))
(goto-char npoint)))
((< arg 0)
;; If we did not move up as far as desired,
;; at least go to beginning of line.
(let* ((npoint (prog1 (line-beginning-position)
(goto-char opoint)))
- (inhibit-point-motion-hooks nil))
+ (inhibit-point-motion-hooks outer-ipmh))
(goto-char npoint)))
(t
(line-move-finish (or goal-column temporary-goal-column)
- opoint (> orig-arg 0)))))))
+ opoint (> orig-arg 0) (not outer-ipmh))))))))
-(defun line-move-finish (column opoint forward)
+(defun line-move-finish (column opoint forward &optional not-ipmh)
(let ((repeat t))
(while repeat
;; Set REPEAT to t to repeat the whole thing.
@@ -8015,42 +8019,44 @@ If NOERROR, don't signal an error if we can't move that
many lines."
;; unnecessarily. Note that we move *forward* past intangible
;; text when the initial and final points are the same.
(goto-char new)
- (let ((inhibit-point-motion-hooks nil))
- (goto-char new)
-
- ;; If intangibility moves us to a different (later) place
- ;; in the same line, use that as the destination.
- (if (<= (point) line-end)
- (setq new (point))
- ;; If that position is "too late",
- ;; try the previous allowable position.
- ;; See if it is ok.
- (backward-char)
- (if (if forward
- ;; If going forward, don't accept the previous
- ;; allowable position if it is before the target line.
- (< line-beg (point))
- ;; If going backward, don't accept the previous
- ;; allowable position if it is still after the target line.
- (<= (point) line-end))
- (setq new (point))
- ;; As a last resort, use the end of the line.
- (setq new line-end))))
+ (with-suppressed-warnings ((obsolete inhibit-point-motion-hooks))
+ (let ((inhibit-point-motion-hooks (not not-ipmh)))
+ (goto-char new)
+
+ ;; If intangibility moves us to a different (later) place
+ ;; in the same line, use that as the destination.
+ (if (<= (point) line-end)
+ (setq new (point))
+ ;; If that position is "too late",
+ ;; try the previous allowable position.
+ ;; See if it is ok.
+ (backward-char)
+ (if (if forward
+ ;; If going forward, don't accept the previous
+ ;; allowable position if it is before the target line.
+ (< line-beg (point))
+ ;; If going backward, don't accept the previous
+ ;; allowable position if it is still after the target line.
+ (<= (point) line-end))
+ (setq new (point))
+ ;; As a last resort, use the end of the line.
+ (setq new line-end)))))
;; Now move to the updated destination, processing fields
;; as well as intangibility.
(goto-char opoint)
- (let ((inhibit-point-motion-hooks nil))
- (goto-char
- ;; Ignore field boundaries if the initial and final
- ;; positions have the same `field' property, even if the
- ;; fields are non-contiguous. This seems to be "nicer"
- ;; behavior in many situations.
- (if (eq (get-char-property new 'field)
- (get-char-property opoint 'field))
- new
- (constrain-to-field new opoint t t
- 'inhibit-line-move-field-capture))))
+ (with-suppressed-warnings ((obsolete inhibit-point-motion-hooks))
+ (let ((inhibit-point-motion-hooks (not not-ipmh)))
+ (goto-char
+ ;; Ignore field boundaries if the initial and final
+ ;; positions have the same `field' property, even if the
+ ;; fields are non-contiguous. This seems to be "nicer"
+ ;; behavior in many situations.
+ (if (eq (get-char-property new 'field)
+ (get-char-property opoint 'field))
+ new
+ (constrain-to-field new opoint t t
+ 'inhibit-line-move-field-capture)))))
;; If all this moved us to a different line,
;; retry everything within that new line.
diff --git a/lisp/startup.el b/lisp/startup.el
index 04de7e42fe..725984b815 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -458,7 +458,8 @@ or `CVS', and any subdirectory that contains a file named
`.nosearch'."
;; The Windows version doesn't report meaningful inode numbers, so
;; use the canonicalized absolute file name of the directory instead.
(setq attrs (or canonicalized
- (nthcdr 10 (file-attributes this-dir))))
+ (file-attribute-file-identifier
+ (file-attributes this-dir))))
(unless (member attrs normal-top-level-add-subdirs-inode-list)
(push attrs normal-top-level-add-subdirs-inode-list)
(dolist (file contents)
diff --git a/lisp/subr.el b/lisp/subr.el
index c975c216bb..e49c22158f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -344,7 +344,7 @@ in compilation warnings about unused variables.
;; FIXME: This let often leads to "unused var" warnings.
`((let ((,var ,counter)) ,@(cddr spec)))))))
-(defmacro declare (&rest _specs)
+(defmacro declare (&rest specs)
"Do not evaluate any arguments, and return nil.
If a `declare' form appears as the first form in the body of a
`defun' or `defmacro' form, SPECS specifies various additional
@@ -355,8 +355,16 @@ The possible values of SPECS are specified by
`defun-declarations-alist' and `macro-declarations-alist'.
For more information, see info node `(elisp)Declare Form'."
- ;; FIXME: edebug spec should pay attention to defun-declarations-alist.
- nil)
+ ;; `declare' is handled directly by `defun/defmacro' rather than here.
+ ;; If we get here, it's because there's a `declare' somewhere not attached
+ ;; to a `defun/defmacro', i.e. a `declare' which doesn't do what it's
+ ;; intended to do.
+ (let ((form `(declare . ,specs))) ;; FIXME: WIBNI we had &whole?
+ (macroexp-warn-and-return
+ (format-message "Stray `declare' form: %S" form)
+ ;; Make a "unique" harmless form to circumvent
+ ;; the cache in `macroexp-warn-and-return'.
+ `(progn ',form nil) nil 'compile-only)))
(defmacro ignore-errors (&rest body)
"Execute BODY; if an error occurs, return nil.
@@ -1837,7 +1845,12 @@ be a list of the form returned by `event-start' and
`event-end'."
(set-advertised-calling-convention 'time-convert '(time form) "29.1")
;;;; Obsolescence declarations for variables, and aliases.
-
+(make-obsolete-variable
+ 'inhibit-point-motion-hooks
+ "use `cursor-intangible-mode' or `cursor-sensor-mode' instead"
+ ;; It's been announced as obsolete in NEWS and in the docstring since
Emacs-25,
+ ;; but it's only been marked for compilation warnings since Emacs-29.
+ "25.1")
(make-obsolete-variable 'redisplay-dont-pause nil "24.5")
(make-obsolete-variable 'operating-system-release nil "28.1")
(make-obsolete-variable 'inhibit-changing-match-data 'save-match-data "29.1")
@@ -3257,7 +3270,14 @@ An obsolete, but still supported form is
where the optional arg MILLISECONDS specifies an additional wait period,
in milliseconds; this was useful when Emacs was built without
floating point support."
- (declare (advertised-calling-convention (seconds &optional nodisp) "22.1"))
+ (declare (advertised-calling-convention (seconds &optional nodisp) "22.1")
+ (compiler-macro
+ (lambda (form)
+ (if (not (or (numberp nodisp) obsolete)) form
+ (macroexp-warn-and-return
+ "Obsolete calling convention for 'sit-for'"
+ `(,(car form) (+ ,seconds (/ (or ,nodisp 0) 1000.0))
,obsolete)
+ '(obsolete sit-for))))))
;; This used to be implemented in C until the following discussion:
;; https://lists.gnu.org/r/emacs-devel/2006-07/msg00401.html
;; Then it was moved here using an implementation based on an idle timer,
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index abefd996a8..9c746b8978 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -33,7 +33,8 @@
(eval-when-compile
(require 'cl-lib)
- (require 'seq))
+ (require 'seq)
+ (require 'icons))
(defgroup tab-bar nil
@@ -155,25 +156,43 @@ For easier selection of tabs by their numbers, consider
customizing
(defun tab-bar--load-buttons ()
"Load the icons for the tab buttons."
- (when (and tab-bar-new-button
- (not (get-text-property 0 'display tab-bar-new-button)))
- ;; This file is pre-loaded so only here we can use the right
data-directory:
- (add-text-properties 0 (length tab-bar-new-button)
- `(display (image :type xpm
- :file "tabs/new.xpm"
- :margin ,tab-bar-button-margin
- :ascent center))
- tab-bar-new-button))
-
- (when (and tab-bar-close-button
- (not (get-text-property 0 'display tab-bar-close-button)))
- ;; This file is pre-loaded so only here we can use the right
data-directory:
- (add-text-properties 0 (length tab-bar-close-button)
- `(display (image :type xpm
- :file "tabs/close.xpm"
- :margin ,tab-bar-button-margin
- :ascent center))
- tab-bar-close-button)))
+ (require 'icons)
+ (unless (iconp 'tab-bar-new)
+ (define-icon tab-bar-new nil
+ `((image "tabs/new.xpm"
+ :margin ,tab-bar-button-margin
+ :ascent center)
+ ;; (emoji "➕")
+ ;; (symbol "＋")
+ (text " + "))
+ "Icon for creating a new tab."
+ :version "29.1"
+ :help-echo "New tab"))
+ (setq tab-bar-new-button (icon-string 'tab-bar-new))
+
+ (unless (iconp 'tab-bar-close)
+ (define-icon tab-bar-close nil
+ `((image "tabs/close.xpm"
+ :margin ,tab-bar-button-margin
+ :ascent center)
+ ;; (emoji " ❌")
+ ;; (symbol "✕") ;; "ⓧ"
+ (text " x"))
+ "Icon for closing the clicked tab."
+ :version "29.1"
+ :help-echo "Click to close tab"))
+ (setq tab-bar-close-button (propertize (icon-string 'tab-bar-close)
+ 'close-tab t))
+
+ (unless (iconp 'tab-bar-menu-bar)
+ (define-icon tab-bar-menu-bar nil
+ '(;; (emoji "🍔")
+ (symbol "☰")
+ (text "Menu" :face tab-bar-tab-inactive))
+ "Icon for for the menu bar."
+ :version "29.1"
+ :help-echo "Menu bar"))
+ (setq tab-bar-menu-bar-button (icon-string 'tab-bar-menu-bar)))
(defun tab-bar--tab-bar-lines-for-frame (frame)
"Determine and return the value of `tab-bar-lines' for FRAME.
@@ -721,7 +740,7 @@ If a function returns nil, it doesn't directly affect the
tab bar appearance, but can do that by some side-effect.
If the list ends with `tab-bar-format-align-right' and
`tab-bar-format-global', then after enabling `display-time-mode'
-(or any other mode that uses `global-mode-string'),
+\(or any other mode that uses `global-mode-string'),
it will display time aligned to the right on the tab bar instead
of the mode line. Replacing `tab-bar-format-tabs' with
`tab-bar-format-tabs-groups' will group tabs on the tab bar."
@@ -921,7 +940,7 @@ when the tab is current. Return the result as a keymap."
(defun tab-bar-format-global ()
"Produce display of `global-mode-string' in the tab bar.
When `tab-bar-format-global' is added to `tab-bar-format'
-(possibly appended after `tab-bar-format-align-right'),
+\(possibly appended after `tab-bar-format-align-right'),
then modes that display information on the mode line
using `global-mode-string' will display the same text
on the tab bar instead."
@@ -1916,22 +1935,27 @@ and can restore them."
:global t :group 'tab-bar
(if tab-bar-history-mode
(progn
- (when (and tab-bar-mode (not (get-text-property 0 'display
tab-bar-back-button)))
- ;; This file is pre-loaded so only here we can use the right
data-directory:
- (add-text-properties 0 (length tab-bar-back-button)
- `(display (image :type xpm
- :file "tabs/left-arrow.xpm"
- :margin ,tab-bar-button-margin
- :ascent center))
- tab-bar-back-button))
- (when (and tab-bar-mode (not (get-text-property 0 'display
tab-bar-forward-button)))
- ;; This file is pre-loaded so only here we can use the right
data-directory:
- (add-text-properties 0 (length tab-bar-forward-button)
- `(display (image :type xpm
- :file "tabs/right-arrow.xpm"
- :margin ,tab-bar-button-margin
- :ascent center))
- tab-bar-forward-button))
+ (require 'icons)
+
+ (unless (iconp 'tab-bar-back)
+ (define-icon tab-bar-back nil
+ `((image "tabs/left-arrow.xpm"
+ :margin ,tab-bar-button-margin
+ :ascent center)
+ (text " < "))
+ "Icon for going back in tab history."
+ :version "29.1"))
+ (setq tab-bar-back-button (icon-string 'tab-bar-back))
+
+ (unless (iconp 'tab-bar-forward)
+ (define-icon tab-bar-forward nil
+ `((image "tabs/right-arrow.xpm"
+ :margin ,tab-bar-button-margin
+ :ascent center)
+ (text " > "))
+ "Icon for going forward in tab history."
+ :version "29.1"))
+ (setq tab-bar-forward-button (icon-string 'tab-bar-forward))
(add-hook 'pre-command-hook 'tab-bar--history-pre-change)
(add-hook 'window-configuration-change-hook 'tab-bar--history-change))
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 8135d40d26..f4b557f443 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1,7 +1,6 @@
;;; bibtex.el --- BibTeX mode for GNU Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1994-1999, 2001-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1992-2022 Free Software Foundation, Inc.
;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de>
;; Bengt Martensson <bengt@mathematik.uni-Bremen.de>
@@ -29,14 +28,13 @@
;;; Commentary:
-;; Major mode for editing and validating BibTeX files.
+;; Major mode for editing and validating BibTeX files.
-;; Usage:
-;; See documentation for `bibtex-mode' or type "M-x describe-mode"
-;; when you are in BibTeX mode.
+;; See documentation for `bibtex-mode' or type `M-x describe-mode'
+;; when you are in BibTeX mode.
-;; Todo:
-;; Distribute texinfo file.
+;; Todo:
+;; Distribute texinfo file.
;;; Code:
@@ -1548,65 +1546,65 @@ Set this variable before loading BibTeX mode."
st)
"Syntax table used in BibTeX mode buffers.")
-(defvar bibtex-mode-map
- (let ((km (make-sparse-keymap)))
- ;; The Key `C-c&' is reserved for reftex.el
- (define-key km "\t" 'bibtex-find-text)
- (define-key km "\n" 'bibtex-next-field)
- (define-key km [remap forward-paragraph] 'bibtex-next-entry)
- (define-key km [remap backward-paragraph] 'bibtex-previous-entry)
- (define-key km "\M-\t" 'completion-at-point)
- (define-key km "\C-c\"" 'bibtex-remove-delimiters)
- (define-key km "\C-c{" 'bibtex-remove-delimiters)
- (define-key km "\C-c}" 'bibtex-remove-delimiters)
- (define-key km "\C-c\C-c" 'bibtex-clean-entry)
- (define-key km "\C-c\C-q" 'bibtex-fill-entry)
- (define-key km "\C-c\C-s" 'bibtex-search-entry)
- (define-key km "\C-c\C-x" 'bibtex-search-crossref)
- (define-key km "\C-c\C-t" 'bibtex-copy-summary-as-kill)
- (define-key km "\C-c?" 'bibtex-print-help-message)
- (define-key km "\C-c\C-p" 'bibtex-pop-previous)
- (define-key km "\C-c\C-n" 'bibtex-pop-next)
- (define-key km "\C-c\C-k" 'bibtex-kill-field)
- (define-key km "\C-c\M-k" 'bibtex-copy-field-as-kill)
- (define-key km "\C-c\C-w" 'bibtex-kill-entry)
- (define-key km "\C-c\M-w" 'bibtex-copy-entry-as-kill)
- (define-key km "\C-c\C-y" 'bibtex-yank)
- (define-key km "\C-c\M-y" 'bibtex-yank-pop)
- (define-key km "\C-c\C-d" 'bibtex-empty-field)
- (define-key km "\C-c\C-f" 'bibtex-make-field)
- (define-key km "\C-c\C-u" 'bibtex-entry-update)
- (define-key km "\C-c$" 'bibtex-ispell-abstract)
- (define-key km "\M-\C-a" 'bibtex-beginning-of-entry)
- (define-key km "\M-\C-e" 'bibtex-end-of-entry)
- (define-key km "\C-\M-l" 'bibtex-reposition-window)
- (define-key km "\C-\M-h" 'bibtex-mark-entry)
- (define-key km "\C-c\C-b" 'bibtex-entry)
- (define-key km "\C-c\C-rn" 'bibtex-narrow-to-entry)
- (define-key km "\C-c\C-rw" 'widen)
- (define-key km "\C-c\C-l" 'bibtex-url)
- (define-key km "\C-c\C-a" 'bibtex-search-entries)
- (define-key km "\C-c\C-o" 'bibtex-remove-OPT-or-ALT)
- (define-key km "\C-c\C-e\C-i" 'bibtex-InProceedings)
- (define-key km "\C-c\C-ei" 'bibtex-InCollection)
- (define-key km "\C-c\C-eI" 'bibtex-InBook)
- (define-key km "\C-c\C-e\C-a" 'bibtex-Article)
- (define-key km "\C-c\C-e\C-b" 'bibtex-InBook)
- (define-key km "\C-c\C-eb" 'bibtex-Book)
- (define-key km "\C-c\C-eB" 'bibtex-Booklet)
- (define-key km "\C-c\C-e\C-c" 'bibtex-InCollection)
- (define-key km "\C-c\C-e\C-m" 'bibtex-Manual)
- (define-key km "\C-c\C-em" 'bibtex-MastersThesis)
- (define-key km "\C-c\C-eM" 'bibtex-Misc)
- (define-key km "\C-c\C-e\C-p" 'bibtex-InProceedings)
- (define-key km "\C-c\C-ep" 'bibtex-Proceedings)
- (define-key km "\C-c\C-eP" 'bibtex-PhdThesis)
- (define-key km "\C-c\C-e\M-p" 'bibtex-Preamble)
- (define-key km "\C-c\C-e\C-s" 'bibtex-String)
- (define-key km "\C-c\C-e\C-t" 'bibtex-TechReport)
- (define-key km "\C-c\C-e\C-u" 'bibtex-Unpublished)
- km)
- "Keymap used in BibTeX mode.")
+(defvar-keymap bibtex-mode-map
+ :doc "Keymap used in BibTeX mode."
+ ;; The Key `C-c &' is reserved for reftex.el
+ "TAB" #'bibtex-find-text
+ "C-j" #'bibtex-next-field
+ "M-TAB" #'completion-at-point
+ "C-c \"" #'bibtex-remove-delimiters
+ "C-c {" #'bibtex-remove-delimiters
+ "C-c }" #'bibtex-remove-delimiters
+ "C-c C-c" #'bibtex-clean-entry
+ "C-c C-q" #'bibtex-fill-entry
+ "C-c C-s" #'bibtex-search-entry
+ "C-c C-x" #'bibtex-search-crossref
+ "C-c C-t" #'bibtex-copy-summary-as-kill
+ "C-c ?" #'bibtex-print-help-message
+ "C-c C-p" #'bibtex-pop-previous
+ "C-c C-n" #'bibtex-pop-next
+ "C-c C-k" #'bibtex-kill-field
+ "C-c M-k" #'bibtex-copy-field-as-kill
+ "C-c C-w" #'bibtex-kill-entry
+ "C-c M-w" #'bibtex-copy-entry-as-kill
+ "C-c C-y" #'bibtex-yank
+ "C-c M-y" #'bibtex-yank-pop
+ "C-c C-d" #'bibtex-empty-field
+ "C-c C-f" #'bibtex-make-field
+ "C-c C-u" #'bibtex-entry-update
+ "C-c $" #'bibtex-ispell-abstract
+ "C-M-a" #'bibtex-beginning-of-entry
+ "C-M-e" #'bibtex-end-of-entry
+ "C-M-l" #'bibtex-reposition-window
+ "C-M-h" #'bibtex-mark-entry
+ "C-c C-b" #'bibtex-entry
+ "C-c C-r n" #'bibtex-narrow-to-entry
+ "C-c C-r w" #'widen
+ "C-c C-l" #'bibtex-url
+ "C-c C-a" #'bibtex-search-entries
+ "C-c C-o" #'bibtex-remove-OPT-or-ALT
+ ;; Most below functions seem to be undefined, which makes the
+ ;; byte-compiler warn if we quote them with #'.
+ "C-c C-e TAB" 'bibtex-InProceedings
+ "C-c C-e i" 'bibtex-InCollection
+ "C-c C-e I" 'bibtex-InBook
+ "C-c C-e C-a" 'bibtex-Article
+ "C-c C-e C-b" 'bibtex-InBook
+ "C-c C-e b" 'bibtex-Book
+ "C-c C-e B" 'bibtex-Booklet
+ "C-c C-e C-c" 'bibtex-InCollection
+ "C-c C-e RET" 'bibtex-Manual
+ "C-c C-e m" 'bibtex-MastersThesis
+ "C-c C-e M" 'bibtex-Misc
+ "C-c C-e C-p" 'bibtex-InProceedings
+ "C-c C-e p" 'bibtex-Proceedings
+ "C-c C-e P" 'bibtex-PhdThesis
+ "C-c C-e M-p" #'bibtex-Preamble
+ "C-c C-e C-s" #'bibtex-String
+ "C-c C-e C-t" 'bibtex-TechReport
+ "C-c C-e C-u" 'bibtex-Unpublished
+ "<remap> <forward-paragraph>" #'bibtex-next-entry
+ "<remap> <backward-paragraph>" #'bibtex-previous-entry)
(easy-menu-define bibtex-edit-menu bibtex-mode-map
"BibTeX-Edit Menu in BibTeX mode."
diff --git a/lisp/textmodes/emacs-news-mode.el
b/lisp/textmodes/emacs-news-mode.el
index d9decae4df..ebb31da9cf 100644
--- a/lisp/textmodes/emacs-news-mode.el
+++ b/lisp/textmodes/emacs-news-mode.el
@@ -73,12 +73,9 @@
(defun emacs-news--mode-common ()
(setq-local font-lock-defaults '(emacs-news-mode-font-lock-keywords t))
- ;; This `outline-regexp' matches leading spaces inserted
- ;; by the current implementation of `outline-minor-mode-use-buttons'.
- (setq-local outline-regexp "\\(?: +\\)?\\(\\*+\\) "
- outline-level (lambda () (length (match-string 1)))
- outline-minor-mode-cycle t
- outline-minor-mode-highlight 'append)
+ (setq-local outline-minor-mode-cycle t
+ outline-minor-mode-highlight 'append
+ outline-minor-mode-use-buttons 'in-margins)
(outline-minor-mode)
(setq-local imenu-generic-expression outline-imenu-generic-expression)
(emacs-etc--hide-local-variables))
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index 935be06812..26f22a9a4a 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -325,8 +325,7 @@ the region, and the START and END of each region."
;;;###autoload
(defun enriched-encode (from to orig-buf)
(if enriched-verbose (message "Enriched: encoding document..."))
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t))
+ (let ((inhibit-read-only t))
(save-restriction
(narrow-to-region from to)
(delete-to-left-margin)
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 774e7ac737..a66b72cfd0 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -1032,7 +1032,6 @@ Mostly we check word delimiters."
(defun flyspell-word-search-backward (word bound &optional ignore-case)
(save-excursion
(let* ((r '())
- (inhibit-point-motion-hooks t)
(flyspell-not-casechars (flyspell-get-not-casechars))
(bound (if (and bound
(> bound (point-min)))
@@ -1066,7 +1065,6 @@ Mostly we check word delimiters."
(defun flyspell-word-search-forward (word bound)
(save-excursion
(let* ((r '())
- (inhibit-point-motion-hooks t)
(flyspell-not-casechars (flyspell-get-not-casechars))
(bound (if (and bound
(< bound (point-max)))
diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el
index 5d17b390f4..bfb5566e89 100644
--- a/lisp/textmodes/less-css-mode.el
+++ b/lisp/textmodes/less-css-mode.el
@@ -24,7 +24,7 @@
;;; Commentary:
;; This mode provides syntax highlighting for Less CSS files
-;; (http://lesscss.org/), plus optional support for compilation of
+;; (https://lesscss.org/), plus optional support for compilation of
;; .less files to .css files at the time they are saved: use
;; `less-css-compile-at-save' to enable this.
;;
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 7d691430ec..7ce30cba8a 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -268,7 +268,7 @@ Currently, only Latin-1 characters are supported.")
;; prefer tidy because (o)nsgmls is often built without --enable-http
;; which makes it next to useless
(cond ((executable-find "tidy")
- ;; tidy is available from http://tidy.sourceforge.net/
+ ;; tidy is available from https://tidy.sourceforge.net/
"tidy --gnu-emacs yes -utf8 -e -q")
((executable-find "nsgmls")
;; nsgmls is a free SGML parser in the SP suite available from
@@ -276,7 +276,7 @@ Currently, only Latin-1 characters are supported.")
"nsgmls -s")
((executable-find "onsgmls")
;; onsgmls is the community version of `nsgmls'
- ;; hosted on http://openjade.sourceforge.net/
+ ;; hosted on https://openjade.sourceforge.net/
"onsgmls -s")
(t "Install (o)nsgmls, tidy, or some other SGML validator, and set
`sgml-validate-command'"))
"The command to validate an SGML document.
diff --git a/lisp/textmodes/string-edit.el b/lisp/textmodes/string-edit.el
index 53850674ac..3270050ca4 100644
--- a/lisp/textmodes/string-edit.el
+++ b/lisp/textmodes/string-edit.el
@@ -46,7 +46,9 @@ called with no parameters.
PROMPT will be inserted at the start of the buffer, but won't be
included in the resulting string. If PROMPT is nil, no help text
-will be inserted."
+will be inserted.
+
+Also see `read-string-from-buffer'."
(with-current-buffer (generate-new-buffer "*edit string*")
(when prompt
(let ((inhibit-read-only t))
@@ -88,7 +90,9 @@ The user finishes editing with
\\<string-edit-mode-map>\\[string-edit-done], or
PROMPT will be inserted at the start of the buffer, but won't be
included in the resulting string. If nil, no prompt will be
-inserted in the buffer."
+inserted in the buffer.
+
+Also see `string-edit'."
(string-edit
prompt
string
@@ -115,9 +119,7 @@ This will kill the current buffer."
(interactive)
(goto-char (point-min))
;; Skip past the help text.
- (when-let ((match (text-property-search-forward
- 'string-edit--prompt nil t)))
- (goto-char (prop-match-beginning match)))
+ (text-property-search-forward 'string-edit--prompt)
(let ((string (buffer-substring (point) (point-max)))
(callback string-edit--success-callback))
(quit-window 'kill)
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index fc06c4c0da..964f94228b 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -5221,16 +5221,15 @@ instead of the current buffer and returns the OBJECT."
"Point has entered a cell.
Refresh the menu bar."
;; Avoid calling point-motion-hooks recursively.
- (let ((inhibit-point-motion-hooks t))
- (force-mode-line-update)
- (pcase dir
- ('left
- (setq table-mode-indicator nil)
- (run-hooks 'table-point-left-cell-hook))
- ('entered
- (setq table-mode-indicator t)
- (table--warn-incompatibility)
- (run-hooks 'table-point-entered-cell-hook)))))
+ (force-mode-line-update)
+ (pcase dir
+ ('left
+ (setq table-mode-indicator nil)
+ (run-hooks 'table-point-left-cell-hook))
+ ('entered
+ (setq table-mode-indicator t)
+ (table--warn-incompatibility)
+ (run-hooks 'table-point-entered-cell-hook))))
(defun table--warn-incompatibility ()
"If called from interactive operation warn the know incompatibilities.
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index bb8ea0d942..ca0312d8fb 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1039,7 +1039,7 @@ says which mode to use."
;; have files annotated with -*- LaTeX -*- (e.g. because they received
;; them from someone using AUCTeX).
;; FIXME: Turn them into autoloads so that AUCTeX can override them
-;; with it's own autoloads? Or maybe rely on `major-mode-remap-alist'?
+;; with its own autoloads? Or maybe rely on `major-mode-remap-alist'?
;;;###autoload (defalias 'TeX-mode #'tex-mode)
;;;###autoload (defalias 'plain-TeX-mode #'plain-tex-mode)
;;;###autoload (defalias 'LaTeX-mode #'latex-mode)
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index a72b2e67a6..6258e999c1 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -150,7 +150,6 @@ it up to them."
(uncompressed-filename nil)
(content-type nil)
(content-encoding nil)
- (coding-system-for-read 'binary)
(filename (url-file-build-filename url)))
(or filename (error "File does not exist: %s" (url-recreate-url url)))
;; Need to figure out the content-type from the real extension,
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index 415b1564ed..7a710386fe 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -359,6 +359,7 @@ log entries."
(overlay-put ov 'log-view-self ov)
(overlay-put ov 'log-view-marked (nth 1 entry))))))))
+;;;###autoload
(defun log-view-get-marked ()
"Return the list of tags for the marked log entries."
(save-excursion
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index bce7996712..6f77f99555 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1324,6 +1324,20 @@ stream. Standard error output is discarded."
(match-string 1)
(error "Cannot determine Bzr repository URL")))))
+(defun vc-bzr-prepare-patch (rev)
+ (with-current-buffer (generate-new-buffer " *vc-bzr-prepare-patch*")
+ (vc-bzr-command
+ "send" t 0 '()
+ "--revision" (concat (vc-bzr-previous-revision nil rev) ".." rev)
+ "--output" "-")
+ (let (subject)
+ ;; Extract the subject line
+ (goto-char (point-min))
+ (search-forward-regexp "^[^#].*")
+ (setq subject (match-string 0))
+ ;; Return the extracted data
+ (list :subject subject :buffer (current-buffer)))))
+
(provide 'vc-bzr)
;;; vc-bzr.el ends here
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 4a2a42ad2a..3c6afec037 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -95,6 +95,7 @@
;; - find-file-hook () OK
;; - conflicted-files OK
;; - repository-url (file-or-dir) OK
+;; - prepare-patch (rev) OK
;;; Code:
@@ -372,8 +373,9 @@ in the order given by `git status'."
(defun vc-git-working-revision (_file)
"Git-specific version of `vc-working-revision'."
- (let (process-file-side-effects)
- (vc-git--rev-parse "HEAD")))
+ (let* ((process-file-side-effects nil)
+ (commit (vc-git--rev-parse "HEAD" t)))
+ (or (vc-git-symbolic-commit commit) commit)))
(defun vc-git--symbolic-ref (file)
(or
@@ -1634,7 +1636,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(start-point (when branchp (vc-read-revision
(format-prompt "Start point"
(car (vc-git-branches)))
- (list dir) 'Git))))
+ (list dir) 'Git (car (vc-git-branches))))))
(and (or (zerop (vc-git-command nil t nil "update-index" "--refresh"))
(y-or-n-p "Modified files exist. Proceed? ")
(user-error (format "Can't create %s with modified files"
@@ -1673,11 +1675,15 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
;; does not (and cannot) quote.
(vc-git--rev-parse (concat rev "~1"))))
-(defun vc-git--rev-parse (rev)
+(defun vc-git--rev-parse (rev &optional short)
(with-temp-buffer
(and
- (vc-git--out-ok "rev-parse" rev)
- (buffer-substring-no-properties (point-min) (+ (point-min) 40)))))
+ (if short
+ (vc-git--out-ok "rev-parse" "--short" rev)
+ (vc-git--out-ok "rev-parse" rev))
+ (string-trim-right
+ (buffer-substring-no-properties (point-min) (min (+ (point-min) 40)
+ (point-max)))))))
(defun vc-git-next-revision (file rev)
"Git-specific version of `vc-next-revision'."
@@ -1742,6 +1748,29 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(defun vc-git-root (file)
(vc-find-root file ".git"))
+(defun vc-git-prepare-patch (rev)
+ (with-current-buffer (generate-new-buffer " *vc-git-prepare-patch*")
+ (vc-git-command
+ t 0 '() "format-patch"
+ "--no-numbered" "--stdout"
+ ;; From gitrevisions(7): ^<n> means the <n>th parent
+ ;; (i.e. <rev>^ is equivalent to <rev>^1). As a
+ ;; special rule, <rev>^0 means the commit itself and
+ ;; is used when <rev> is the object name of a tag
+ ;; object that refers to a commit object.
+ (concat rev "^.." rev))
+ (let (subject)
+ ;; Extract the subject line
+ (goto-char (point-min))
+ (search-forward-regexp "^Subject: \\(.+\\)")
+ (setq subject (match-string 1))
+ ;; Jump to the beginning for the patch
+ (search-forward-regexp "\n\n")
+ ;; Return the extracted data
+ (list :subject subject
+ :buffer (current-buffer)
+ :body-start (point)))))
+
;; grep-compute-defaults autoloads grep.
(declare-function grep-read-regexp "grep" ())
(declare-function grep-read-files "grep" (regexp))
@@ -2001,19 +2030,23 @@ FILE can be nil."
(setq ok nil))))))
(and ok str)))
-(defun vc-git-symbolic-commit (commit)
- "Translate COMMIT string into symbolic form.
-Returns nil if not possible."
+(defun vc-git-symbolic-commit (commit &optional force)
+ "Translate revision string of COMMIT to a symbolic form.
+If the optional argument FORCE is non-nil, the returned value is
+allowed to include revision specifications like \"master~8\"
+\(the 8th parent of the commit currently pointed to by the master
+branch), otherwise such revision specifications are rejected, and
+the function returns nil."
(and commit
- (let ((name (with-temp-buffer
- (and
- (vc-git--out-ok "name-rev" "--name-only" commit)
- (goto-char (point-min))
- (= (forward-line 2) 1)
- (bolp)
- (buffer-substring-no-properties (point-min)
- (1- (point-max)))))))
- (and name (not (string= name "undefined")) name))))
+ (with-temp-buffer
+ (and
+ (vc-git--out-ok "name-rev" "--no-undefined" "--name-only" commit)
+ (goto-char (point-min))
+ (or force (not (looking-at "^.*[~^].*$" t)))
+ (= (forward-line 2) 1)
+ (bolp)
+ (buffer-substring-no-properties (point-min)
+ (1- (point-max)))))))
(defvar-keymap vc-dir-git-mode-map
"z c" #'vc-git-stash
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index eed9592378..2eebe2d543 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -80,6 +80,7 @@
;; - delete-file (file) TEST IT
;; - rename-file (old new) OK
;; - find-file-hook () added for bug#10709
+;; - prepare-patch (rev) OK
;; 2) Implement Stefan Monnier's advice:
;; vc-hg-registered and vc-hg-state
@@ -1507,6 +1508,17 @@ This runs the command \"hg merge\"."
(with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))
+(defun vc-hg-prepare-patch (rev)
+ (with-current-buffer (generate-new-buffer " *vc-hg-prepare-patch*")
+ (vc-hg-command t 0 '() "export" "--rev" rev)
+ (let (subject)
+ ;; Extract the subject line
+ (goto-char (point-min))
+ (search-forward-regexp "^[^#].*")
+ (setq subject (match-string 0))
+ ;; Return the extracted data
+ (list :subject subject :buffer (current-buffer)))))
+
;;; Internal functions
(defun vc-hg-command (buffer okstatus file-or-list &rest flags)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 787dd51d07..df51f52bc7 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -574,6 +574,16 @@
;; containing FILE-OR-DIR. The optional REMOTE-NAME specifies the
;; remote (in Git parlance) whose URL is to be returned. It has
;; only a meaning for distributed VCS and is ignored otherwise.
+;;
+;; - prepare-patch (rev)
+;;
+;; Prepare a patch and return a property list with the keys
+;; `:subject' indicating the patch message as a string, `:buffer'
+;; with a buffer object that contains the entire patch message and
+;; `:body-start' and `:body-end' demarcating what part of said
+;; buffer should be inserted into an inline patch. If the two last
+;; properties are omitted, `point-min' and `point-max' will
+;; respectively be used instead.
;;; Changes from the pre-25.1 API:
;;
@@ -1673,6 +1683,50 @@ Runs the normal hooks `vc-before-checkin-hook' and
`vc-checkin-hook'."
backend
patch-string))
+(defun vc-default-checkin-patch (_backend patch-string comment)
+ (pcase-let* ((`(,backend ,files) (with-temp-buffer
+ (insert patch-string)
+ (diff-vc-deduce-fileset)))
+ (tmpdir (make-temp-file "vc-checkin-patch" t)))
+ (dolist (f files)
+ (make-directory (file-name-directory (expand-file-name f tmpdir)) t)
+ (copy-file (expand-file-name f)
+ (expand-file-name f tmpdir)))
+ (unwind-protect
+ (progn
+ (dolist (f files)
+ (with-current-buffer (find-file-noselect f)
+ (vc-revert-file buffer-file-name)))
+ (with-temp-buffer
+ ;; Trying to support CVS too. Assuming that vc-diff
+ ;; there will usually have diff root in default-directory.
+ (when (vc-find-backend-function backend 'root)
+ (setq-local default-directory
+ (vc-call-backend backend 'root (car files))))
+ (unless (eq 0
+ (call-process-region patch-string
+ nil
+ "patch"
+ nil
+ t
+ nil
+ "-p1"
+ "-r" null-device
+ "--no-backup-if-mismatch"
+ "-i" "-"))
+ (user-error "Patch failed: %s" (buffer-string))))
+ (dolist (f files)
+ (with-current-buffer (get-file-buffer f)
+ (revert-buffer t t t)))
+ (vc-call-backend backend 'checkin files comment))
+ (dolist (f files)
+ (copy-file (expand-file-name f tmpdir)
+ (expand-file-name f)
+ t)
+ (with-current-buffer (get-file-buffer f)
+ (revert-buffer t t t)))
+ (delete-directory tmpdir t))))
+
;;; Additional entry points for examining version histories
;; (defun vc-default-diff-tree (backend dir rev1 rev2)
@@ -1910,7 +1964,14 @@ Return t if the buffer had changes, nil otherwise."
(defvar vc-revision-history nil
"History for `vc-read-revision'.")
-(defun vc-read-revision (prompt &optional files backend default initial-input)
+(defun vc-read-revision (prompt &optional files backend default initial-input
multiple)
+ "Query the user for a revision using PROMPT.
+All subsequent arguments are optional. FILES may specify a file
+set to restrict the revisions to. BACKEND is a VC backend as
+listed in `vc-handled-backends'. DEFAULT and INITIAL-INPUT are
+handled as defined by `completing-read'. If MULTIPLE is non-nil,
+the user may be prompted for multiple revisions. If possible
+this means that `completing-read-multiple' will be used."
(cond
((null files)
(let ((vc-fileset (vc-deduce-fileset t))) ;FIXME: why t? --Stef
@@ -1923,9 +1984,20 @@ Return t if the buffer had changes, nil otherwise."
(completion-table
(vc-call-backend backend 'revision-completion-table files)))
(if completion-table
- (completing-read prompt completion-table
- nil nil initial-input 'vc-revision-history default)
- (read-string prompt initial-input nil default))))
+ (funcall
+ (if multiple #'completing-read-multiple #'completing-read)
+ prompt completion-table nil nil initial-input 'vc-revision-history
default)
+ (let ((answer (read-string prompt initial-input nil default)))
+ (if multiple
+ (split-string answer "[ \t]*,[ \t]*")
+ answer)))))
+
+(defun vc-read-multiple-revisions (prompt &optional files backend default
initial-input)
+ "Query the user for multiple revisions.
+This is equivalent to invoking `vc-read-revision' with t for
+MULTIPLE. The arguments PROMPT, FILES, BACKEND, DEFAULT and
+INITIAL-INPUT are passed on to `vc-read-revision' directly."
+ (vc-read-revision prompt files backend default initial-input t))
(defun vc-diff-build-argument-list-internal (&optional fileset)
"Build argument list for calling internal diff functions."
@@ -3264,6 +3336,112 @@ immediately after this one."
(lambda (&rest args)
(apply #'vc-user-edit-command (apply old args))))))
+(defcustom vc-prepare-patches-separately t
+ "Whether `vc-prepare-patch' should generate a separate message for each
patch.
+If nil, `vc-prepare-patch' creates a single email message by attaching
+all the patches to the body of that message. If non-nil, each patch
+will be sent out in a separate message, and the messages will be
+prepared sequentially."
+ :type 'boolean
+ :safe #'booleanp
+ :version "29.1")
+
+(defcustom vc-default-patch-addressee nil
+ "Default addressee for `vc-prepare-patch'.
+If nil, no default will be used. This option may be set locally."
+ :type '(choice (const :tag "No default" nil)
+ (string :tag "Addressee"))
+ :safe #'stringp
+ :version "29.1")
+
+(declare-function message--name-table "message" (orig-string))
+(declare-function mml-attach-buffer "mml"
+ (buffer &optional type description disposition))
+(declare-function log-view-get-marked "log-view" ())
+
+(defun vc-default-prepare-patch (_backend rev)
+ (let ((backend (vc-backend buffer-file-name)))
+ (with-current-buffer (generate-new-buffer " *vc-default-prepare-patch*")
+ (vc-diff-internal
+ nil (list backend) rev
+ (vc-call-backend backend 'previous-revision
+ buffer-file-name rev)
+ nil t)
+ (list :subject (concat "Patch for "
+ (file-name-nondirectory
+ (directory-file-name
+ (vc-root-dir))))
+ :buffer (current-buffer)))))
+
+;;;###autoload
+(defun vc-prepare-patch (addressee subject revisions)
+ "Compose an Email sending patches for REVISIONS to ADDRESSEE.
+If `vc-prepare-patches-separately' is nil, SUBJECT will be used
+as the default subject for the message (and it will be prompted
+for when called interactively). Otherwise a separate message
+will be composed for each revision, with SUBJECT derived from the
+invidividual commits.
+
+When invoked interactively in a Log View buffer with marked
+revisions, those revisions will be used."
+ (interactive
+ (let ((revs (vc-read-multiple-revisions
+ "Revisions: " nil nil nil
+ (or (and-let* ((revs (log-view-get-marked)))
+ (mapconcat #'identity revs ","))
+ (and-let* ((file (buffer-file-name)))
+ (vc-working-revision file)))))
+ to)
+ (require 'message)
+ (while (null (setq to (completing-read-multiple
+ (format-prompt
+ "Addressee"
+ vc-default-patch-addressee)
+ (message--name-table "")
+ nil nil nil nil
+ vc-default-patch-addressee)))
+ (message "At least one addressee required.")
+ (sit-for blink-matching-delay))
+ (list (string-join to ", ")
+ (and (not vc-prepare-patches-separately)
+ (read-string "Subject: " "[PATCH] " nil nil t))
+ revs)))
+ (save-current-buffer
+ (vc-ensure-vc-buffer)
+ (let ((patches (mapcar (lambda (rev)
+ (vc-call-backend
+ (vc-responsible-backend default-directory)
+ 'prepare-patch rev))
+ revisions)))
+ (if vc-prepare-patches-separately
+ (dolist (patch (reverse patches)
+ (message "Prepared %d patch%s..." (length patches)
+ (if (length> patches 1) "es" "")))
+ (compose-mail addressee
+ (plist-get patch :subject)
+ nil nil nil nil
+ `((kill-buffer ,(plist-get patch :buffer))))
+ (rfc822-goto-eoh) (forward-line)
+ (save-excursion ;don't jump to the end
+ (insert-buffer-substring
+ (plist-get patch :buffer)
+ (plist-get patch :body-start)
+ (plist-get patch :body-end))))
+ (compose-mail addressee subject nil nil nil nil
+ (mapcar
+ (lambda (p)
+ (list #'kill-buffer (plist-get p :buffer)))
+ patches))
+ (rfc822-goto-eoh)
+ (forward-line)
+ (save-excursion
+ (dolist (patch patches)
+ (mml-attach-buffer (buffer-name (plist-get patch :buffer))
+ "text/x-patch"
+ (plist-get patch :subject)
+ "attachment")))
+ (open-line 2)))))
+
(defun vc-default-responsible-p (_backend _file)
"Indicate whether BACKEND is responsible for FILE.
The default is to return nil always."
diff --git a/lisp/view.el b/lisp/view.el
index 1207f01db2..d9b1a2d0e7 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -68,13 +68,6 @@ the F command in `view-mode', but you can set it to t if you
want the action
for all scroll commands in view mode."
:type 'boolean)
-;;;###autoload
-(defcustom view-remove-frame-by-deleting t
- "Determine how View mode removes a frame no longer needed.
-If nil, make an icon of the frame. If non-nil, delete the frame."
- :type 'boolean
- :version "23.1")
-
(defcustom view-exits-all-viewing-windows nil
"Non-nil means restore all windows used to view buffer.
Commands that restore windows when finished viewing a buffer,
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 2bda67fe3f..ee80e41a22 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -1640,8 +1640,9 @@ VERSION is the version of the XDND protocol understood by
SOURCE."
desired-name
(or file-name-coding-system
default-file-name-coding-system)))
- (let ((name (funcall x-dnd-direct-save-function
- t desired-name)))
+ (let ((name (expand-file-name
+ (funcall x-dnd-direct-save-function
+ t desired-name))))
(setq save-to name save-to-remote name))
(when save-to
(if (file-remote-p save-to)
diff --git a/nt/INSTALL b/nt/INSTALL
index 0b8ca98c8a..81d4c6293c 100644
--- a/nt/INSTALL
+++ b/nt/INSTALL
@@ -214,7 +214,7 @@ build will run on Windows 9X and newer systems).
of the 'bsdtar' program to unpack the tarballs. 'bsdtar' is
available as part of the 'libarchive' package from here:
- http://sourceforge.net/projects/ezwinports/files/
+ https://sourceforge.net/projects/ezwinports/files/
The recommended place to install these packages is a single tree
starting from some directory on a drive other than the system drive
@@ -242,16 +242,16 @@ build will run on Windows 9X and newer systems).
. Texinfo (needed to produce the Info manuals when building from
the repository, and for "make install")
- Available from http://sourceforge.net/projects/ezwinports/files/.
+ Available from https://sourceforge.net/projects/ezwinports/files/.
. pkg-config (invoked by the configure script to look for optional
packages)
- Available from http://sourceforge.net/projects/ezwinports/files/.
+ Available from https://sourceforge.net/projects/ezwinports/files/.
. gzip (needed to compress files during "make install")
- Available from http://gnuwin32.sourceforge.net/packages/gzip.htm.
+ Available from https://gnuwin32.sourceforge.net/packages/gzip.htm.
Each package might list other packages as prerequisites on its
download page (under "Runtime requirements"); download those as
@@ -294,7 +294,7 @@ build will run on Windows 9X and newer systems).
. Additional package (needed only if building from the repository):
Autoconf. It is available from here:
-
http://sourceforge.net/projects/ezwinports/files/autoconf-2.65-msys-bin.zip/download
+
https://sourceforge.net/projects/ezwinports/files/autoconf-2.65-msys-bin.zip/download
MSYS packages are distributed as .tar.lzma compressed archives. To
install the packages manually, we recommend to use the Windows port
@@ -642,7 +642,7 @@ build will run on Windows 9X and newer systems).
To support XPM images (required for color tool-bar icons), you will
need the libXpm library. It is available from the ezwinports site,
- http://sourceforge.net/projects/ezwinports/files/ and from
+ https://sourceforge.net/projects/ezwinports/files/ and from
https://ftp.gnu.org/gnu/emacs/windows/.
For PNG images, we recommend to use versions 1.4.x and later of
@@ -665,7 +665,7 @@ build will run on Windows 9X and newer systems).
For GIF images, we recommend to use versions 5.0.0 or later of
giflib, as it is much enhanced wrt previous versions. You can find
precompiled binaries and headers for giflib on the ezwinports site,
- http://sourceforge.net/projects/ezwinports/files/ and on
+ https://sourceforge.net/projects/ezwinports/files/ and on
https://ftp.gnu.org/gnu/emacs/windows/.
Version 5.0.0 and later of giflib are binary incompatible with
@@ -689,7 +689,7 @@ build will run on Windows 9X and newer systems).
Pre-built versions of librsvg and its dependencies can be found
here:
- http://sourceforge.net/projects/ezwinports/files/
+ https://sourceforge.net/projects/ezwinports/files/
This site includes a minimal (as much as possible for librsvg)
build of the library and its dependencies; it is also more
@@ -739,7 +739,7 @@ build will run on Windows 9X and newer systems).
For WebP images you will need libwebp. You can find it here:
- http://sourceforge.net/projects/ezwinports/files/
+ https://sourceforge.net/projects/ezwinports/files/
Note: the MS-Windows binary distribution on the Google site:
@@ -779,7 +779,7 @@ build will run on Windows 9X and newer systems).
session.
You can get pre-built binaries (including any required DLL and the
- header files) at http://sourceforge.net/projects/ezwinports/files/
+ header files) at https://sourceforge.net/projects/ezwinports/files/
and on https://ftp.gnu.org/gnu/emacs/windows/.
* Optional libxml2 support
@@ -801,7 +801,7 @@ build will run on Windows 9X and newer systems).
One place where you can get pre-built Windows binaries of libxml2
(including any required DLL and the header files) is here:
- http://sourceforge.net/projects/ezwinports/files/
+ https://sourceforge.net/projects/ezwinports/files/
https://ftp.gnu.org/gnu/emacs/windows/
For runtime support of libxml2, you will also need to install the
@@ -809,7 +809,7 @@ build will run on Windows 9X and newer systems).
be available to the compiler when you compile with libxml2 support.
A MinGW port of libiconv can be found on the MinGW site:
- http://sourceforge.net/projects/mingw/files/MinGW/Base/libiconv/
+ https://sourceforge.net/projects/mingw/files/MinGW/Base/libiconv/
You need the libiconv-X.Y.Z-N-mingw32-dev.tar.lzma tarball from that
site.
diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64
index fd8f60bb0b..9261c82db1 100644
--- a/nt/INSTALL.W64
+++ b/nt/INSTALL.W64
@@ -19,7 +19,7 @@ Emacs with the full repository, or less if you're using a
release tarball.
* Set up the MinGW-w64 / MSYS2 build environment
MinGW-w64 provides a complete runtime for projects built with GCC for 64-bit
-Windows -- it's located at http://mingw-w64.org/.
+Windows -- it's located at https://mingw-w64.org/.
MSYS2 is a Cygwin-derived software distribution for Windows which provides
build tools for MinGW-w64 -- see https://msys2.github.io/.
diff --git a/oldXMenu/Activate.c b/oldXMenu/Activate.c
index e679c2ffed..781c05bd02 100644
--- a/oldXMenu/Activate.c
+++ b/oldXMenu/Activate.c
@@ -122,7 +122,6 @@ int x_menu_grab_keyboard = 1;
static Wait_func wait_func;
static void* wait_data;
static Translate_func translate_func = NULL;
-static Expose_func expose_func = NULL;
void
XMenuActivateSetWaitFunction (Wait_func func, void *data)
@@ -137,12 +136,6 @@ XMenuActivateSetTranslateFunction (Translate_func func)
translate_func = func;
}
-void
-XMenuActivateSetExposeFunction (Expose_func func)
-{
- expose_func = func;
-}
-
int
XMenuActivate(
register Display *display, /* Display to put menu on. */
@@ -346,9 +339,6 @@ XMenuActivate(
feq = feq_tmp;
}
else if (_XMEventHandler) (*_XMEventHandler)(&event);
-
- if (expose_func)
- expose_func (&event);
break;
}
if (event_xmp->activated) {
diff --git a/oldXMenu/XMenu.h b/oldXMenu/XMenu.h
index 54061235ae..2eee18a384 100644
--- a/oldXMenu/XMenu.h
+++ b/oldXMenu/XMenu.h
@@ -259,7 +259,6 @@ typedef void (*Wait_func)(void*);
XPutBackEvent on an equivalent artificial core event on any
function it wants to translate. */
typedef void (*Translate_func)(XEvent *);
-typedef void (*Expose_func)(XEvent *);
/*
* XMenu library routine declarations.
@@ -281,7 +280,6 @@ int XMenuLocate(Display *display, XMenu *menu, int p_num,
int s_num, int x_pos,
void XMenuSetFreeze(XMenu *menu, int freeze);
void XMenuActivateSetWaitFunction(Wait_func func, void *data);
void XMenuActivateSetTranslateFunction(Translate_func func);
-void XMenuActivateSetExposeFunction(Expose_func func);
int XMenuActivate(Display *display, XMenu *menu, int *p_num, int *s_num, int
x_pos, int y_pos, unsigned int event_mask, char **data, void (*help_callback)
(char const *, int, int));
char *XMenuPost(Display *display, XMenu *menu, int *p_num, int *s_num, int
x_pos, int y_pos, int event_mask);
int XMenuDeletePane(Display *display, XMenu *menu, int p_num);
diff --git a/src/ChangeLog.13 b/src/ChangeLog.13
index abf2a9421a..268a59219c 100644
--- a/src/ChangeLog.13
+++ b/src/ChangeLog.13
@@ -11147,7 +11147,7 @@
2013-11-01 Claudio Bley <claudio.bley@googlemail.com>
* image.c (pbm_next_char): New function.
- See http://netpbm.sourceforge.net/doc/pbm.html for the details.
+ See https://netpbm.sourceforge.net/doc/pbm.html for the details.
(pbm_scan_number): Use it.
(Qlibjpeg_version): New variable.
(syms_of_image): DEFSYM and initialize it.
@@ -14215,7 +14215,7 @@
* w32.c (PEXCEPTION_POINTERS, PEXCEPTION_RECORD, PCONTEXT): Define
variables of these types so that GDB would know about them, as aid
for debugging fatal exceptions. (Bug#15024) See also
- http://sourceware.org/ml/gdb/2013-08/msg00010.html for related
+ https://sourceware.org/ml/gdb/2013-08/msg00010.html for related
discussions.
2013-08-08 Jan Djärv <jan.h.d@swipnet.se>
diff --git a/src/comp.c b/src/comp.c
index b7541c5d9f..14012634cc 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -5868,8 +5868,21 @@ The last directory of this list is assumed to be the
system one. */);
Vnative_comp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil);
DEFVAR_BOOL ("comp-enable-subr-trampolines", comp_enable_subr_trampolines,
- doc: /* If non-nil enable primitive trampoline synthesis.
-This makes primitive functions redefinable or advisable effectively. */);
+ doc: /* If non-nil, enable primitive trampoline synthesis.
+This makes Emacs respect redefinition or advises of primitive functions
+when they are called from Lisp code natively-compiled at `native-comp-speed'
+of 2.
+
+By default, this is enabled, and when Emacs sees a redefined or advised
+primitive called from natively-compiled Lisp, it generates a trampoline
+for it on-the-fly.
+
+Disabling this, when a trampoline for a redefined or advised primitive is
+not available from previous compilations, means that such redefinition
+or advise will not have effect on calls from natively-compiled Lisp code.
+That is, calls to primitives without existing trampolines from
+natively-compiled Lisp will behave as if the primitive was called
+directly from C. */);
DEFVAR_LISP ("comp-installed-trampolines-h", Vcomp_installed_trampolines_h,
doc: /* Hash table subr-name -> installed trampoline.
diff --git a/src/dired.c b/src/dired.c
index c2c099f0a5..ef729df5d2 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -923,11 +923,12 @@ Elements of the attribute list are:
8. File modes, as a string of ten letters or dashes as in ls -l.
9. An unspecified value, present only for backward compatibility.
10. inode number, as a nonnegative integer.
-11. Filesystem device number, as an integer.
+11. Filesystem device identifier, as an integer or a cons cell of integers.
Large integers are bignums, so `eq' might not work on them.
On most filesystems, the combination of the inode and the device
-number uniquely identifies the file.
+identifier uniquely identifies the file. This unique file identification
+is provided by the access function `file-attribute-file-identifier'.
On MS-Windows, performance depends on `w32-get-true-file-attributes',
which see.
diff --git a/src/dispnew.c b/src/dispnew.c
index 2568ba1086..5a9ba8909e 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -3152,10 +3152,19 @@ redraw_frame (struct frame *f)
update_begin (f);
if (FRAME_MSDOS_P (f))
FRAME_TERMINAL (f)->set_terminal_modes_hook (FRAME_TERMINAL (f));
+
+ if (FRAME_WINDOW_P (f))
+ /* Garbage the frame now. Otherwise, platforms that support
+ double buffering will display the blank contents of the frame
+ even though the frame should be redrawn at some point in the
+ future. */
+ SET_FRAME_GARBAGED (f);
+
clear_frame (f);
clear_current_matrices (f);
update_end (f);
fset_redisplay (f);
+
/* Mark all windows as inaccurate, so that every window will have
its redisplay done. */
mark_window_display_accurate (FRAME_ROOT_WINDOW (f), 0);
diff --git a/src/editfns.c b/src/editfns.c
index 4f514e21bb..1c670ec036 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3551,10 +3551,15 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
|| float_conversion || conversion == 'i'
|| conversion == 'o' || conversion == 'x'
|| conversion == 'X'))
- error ("Invalid format operation %%%c",
- multibyte_format
- ? STRING_CHAR ((unsigned char *) format - 1)
- : *((unsigned char *) format - 1));
+ {
+ unsigned char *p = (unsigned char *) format - 1;
+ if (multibyte_format)
+ error ("Invalid format operation %%%c", STRING_CHAR (p));
+ else
+ error (*p <= 127 ? "Invalid format operation %%%c"
+ : "Invalid format operation char #o%03o",
+ *p);
+ }
else if (! (FIXNUMP (arg) || ((BIGNUMP (arg) || FLOATP (arg))
&& conversion != 'c')))
error ("Format specifier doesn't match argument type");
diff --git a/src/fileio.c b/src/fileio.c
index dd7f85ec97..8f96e973b2 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5000,9 +5000,10 @@ by calling `format-decode', which see. */)
unbind_to (count1, Qnil);
}
- if (!NILP (visit) && current_buffer->modtime.tv_nsec < 0)
+ if (save_errno != 0)
{
/* Signal an error if visiting a file that could not be opened. */
+ eassert (!NILP (visit) && NILP (handler));
report_file_errno ("Opening input file", orig_filename, save_errno);
}
@@ -6362,7 +6363,7 @@ init_fileio (void)
For more on why fsync does not suffice even if it works properly, see:
Roche X. Necessary step(s) to synchronize filename operations on disk.
Austin Group Defect 672, 2013-03-19
- http://austingroupbugs.net/view.php?id=672 */
+ https://austingroupbugs.net/view.php?id=672 */
write_region_inhibit_fsync = noninteractive;
}
diff --git a/src/fns.c b/src/fns.c
index ff9993c8fd..9f1af9d52e 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -433,6 +433,22 @@ If string STR1 is greater, the value is a positive number
N;
return Qt;
}
+/* Check whether the platform allows access to unaligned addresses for
+ size_t integers without trapping or undue penalty (a few cycles is OK).
+
+ This whitelist is incomplete but since it is only used to improve
+ performance, omitting cases is safe. */
+#if defined __x86_64__|| defined __amd64__ \
+ || defined __i386__ || defined __i386 \
+ || defined __arm64__ || defined __aarch64__ \
+ || defined __powerpc__ || defined __powerpc \
+ || defined __ppc__ || defined __ppc \
+ || defined __s390__ || defined __s390x__
+#define HAVE_FAST_UNALIGNED_ACCESS 1
+#else
+#define HAVE_FAST_UNALIGNED_ACCESS 0
+#endif
+
DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic
order.
Case is significant.
@@ -454,23 +470,55 @@ Symbols are also allowed; their print names are used
instead. */)
&& (!STRING_MULTIBYTE (string2) || SCHARS (string2) == SBYTES (string2)))
{
/* Each argument is either unibyte or all-ASCII multibyte:
- we can compare bytewise.
- (Arbitrary multibyte strings cannot be compared bytewise because
- that would give a different order for raw bytes 80..FF.) */
+ we can compare bytewise. */
int d = memcmp (SSDATA (string1), SSDATA (string2), n);
return d < 0 || (d == 0 && n < SCHARS (string2)) ? Qt : Qnil;
}
else if (STRING_MULTIBYTE (string1) && STRING_MULTIBYTE (string2))
{
- ptrdiff_t i1 = 0, i1_byte = 0, i2 = 0, i2_byte = 0;
- while (i1 < n)
+ /* Two arbitrary multibyte strings: we cannot use memcmp because
+ the encoding for raw bytes would sort those between U+007F and U+0080
+ which isn't where we want them.
+ Instead, we skip the longest common prefix and look at
+ what follows. */
+ ptrdiff_t nb1 = SBYTES (string1);
+ ptrdiff_t nb2 = SBYTES (string2);
+ ptrdiff_t nb = min (nb1, nb2);
+ ptrdiff_t b = 0;
+
+ /* String data is normally allocated with word alignment, but
+ there are exceptions (notably pure strings) so we restrict the
+ wordwise skipping to safe architectures. */
+ if (HAVE_FAST_UNALIGNED_ACCESS)
{
- int c1 = fetch_string_char_advance_no_check (string1, &i1, &i1_byte);
- int c2 = fetch_string_char_advance_no_check (string2, &i2, &i2_byte);
- if (c1 != c2)
- return c1 < c2 ? Qt : Qnil;
+ /* First compare entire machine words. */
+ typedef size_t word_t;
+ int ws = sizeof (word_t);
+ const word_t *w1 = (const word_t *) SDATA (string1);
+ const word_t *w2 = (const word_t *) SDATA (string2);
+ while (b < nb - ws + 1 && w1[b / ws] == w2[b / ws])
+ b += ws;
}
- return i1 < SCHARS (string2) ? Qt : Qnil;
+
+ /* Scan forward to the differing byte. */
+ while (b < nb && SREF (string1, b) == SREF (string2, b))
+ b++;
+
+ if (b >= nb)
+ /* One string is a prefix of the other. */
+ return b < nb2 ? Qt : Qnil;
+
+ /* Now back up to the start of the differing characters:
+ it's the last byte not having the bit pattern 10xxxxxx. */
+ while ((SREF (string1, b) & 0xc0) == 0x80)
+ b--;
+
+ /* Compare the differing characters. */
+ ptrdiff_t i1 = 0, i2 = 0;
+ ptrdiff_t i1_byte = b, i2_byte = b;
+ int c1 = fetch_string_char_advance_no_check (string1, &i1, &i1_byte);
+ int c2 = fetch_string_char_advance_no_check (string2, &i2, &i2_byte);
+ return c1 < c2 ? Qt : Qnil;
}
else if (STRING_MULTIBYTE (string1))
{
@@ -2425,15 +2473,15 @@ with PROP is done using PREDICATE, which defaults to
`eq'.
This function doesn't signal an error if PLIST is invalid. */)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
{
- Lisp_Object tail = plist;
if (NILP (predicate))
return plist_get (plist, prop);
+ Lisp_Object tail = plist;
FOR_EACH_TAIL_SAFE (tail)
{
if (! CONSP (XCDR (tail)))
break;
- if (!NILP (call2 (predicate, prop, XCAR (tail))))
+ if (!NILP (call2 (predicate, XCAR (tail), prop)))
return XCAR (XCDR (tail));
tail = XCDR (tail);
}
@@ -2441,7 +2489,7 @@ This function doesn't signal an error if PLIST is
invalid. */)
return Qnil;
}
-/* Faster version of the above that works with EQ only */
+/* Faster version of Fplist_get that works with EQ only. */
Lisp_Object
plist_get (Lisp_Object plist, Lisp_Object prop)
{
@@ -2450,7 +2498,7 @@ plist_get (Lisp_Object plist, Lisp_Object prop)
{
if (! CONSP (XCDR (tail)))
break;
- if (EQ (prop, XCAR (tail)))
+ if (EQ (XCAR (tail), prop))
return XCAR (XCDR (tail));
tail = XCDR (tail);
}
@@ -2484,15 +2532,15 @@ use `(setq x (plist-put x prop val))' to be sure to use
the new value.
The PLIST is modified by side effects. */)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object val, Lisp_Object predicate)
{
- Lisp_Object prev = Qnil, tail = plist;
if (NILP (predicate))
return plist_put (plist, prop, val);
+ Lisp_Object prev = Qnil, tail = plist;
FOR_EACH_TAIL (tail)
{
if (! CONSP (XCDR (tail)))
break;
- if (!NILP (call2 (predicate, prop, XCAR (tail))))
+ if (!NILP (call2 (predicate, XCAR (tail), prop)))
{
Fsetcar (XCDR (tail), val);
return plist;
@@ -2510,6 +2558,7 @@ The PLIST is modified by side effects. */)
return plist;
}
+/* Faster version of Fplist_put that works with EQ only. */
Lisp_Object
plist_put (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
@@ -2519,7 +2568,7 @@ plist_put (Lisp_Object plist, Lisp_Object prop,
Lisp_Object val)
if (! CONSP (XCDR (tail)))
break;
- if (EQ (prop, XCAR (tail)))
+ if (EQ (XCAR (tail), prop))
{
Fsetcar (XCDR (tail), val);
return plist;
@@ -2547,6 +2596,51 @@ It can be retrieved with `(get SYMBOL PROPNAME)'. */)
(symbol, plist_put (XSYMBOL (symbol)->u.s.plist, propname, value));
return value;
}
+
+DEFUN ("plist-member", Fplist_member, Splist_member, 2, 3, 0,
+ doc: /* Return non-nil if PLIST has the property PROP.
+PLIST is a property list, which is a list of the form
+\(PROP1 VALUE1 PROP2 VALUE2 ...).
+
+The comparison with PROP is done using PREDICATE, which defaults to
+`eq'.
+
+Unlike `plist-get', this allows you to distinguish between a missing
+property and a property with the value nil.
+The value is actually the tail of PLIST whose car is PROP. */)
+ (Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
+{
+ if (NILP (predicate))
+ return plist_member (plist, prop);
+ Lisp_Object tail = plist;
+ FOR_EACH_TAIL (tail)
+ {
+ if (!NILP (call2 (predicate, XCAR (tail), prop)))
+ return tail;
+ tail = XCDR (tail);
+ if (! CONSP (tail))
+ break;
+ }
+ CHECK_TYPE (NILP (tail), Qplistp, plist);
+ return Qnil;
+}
+
+/* Faster version of Fplist_member that works with EQ only. */
+Lisp_Object
+plist_member (Lisp_Object plist, Lisp_Object prop)
+{
+ Lisp_Object tail = plist;
+ FOR_EACH_TAIL (tail)
+ {
+ if (EQ (XCAR (tail), prop))
+ return tail;
+ tail = XCDR (tail);
+ if (! CONSP (tail))
+ break;
+ }
+ CHECK_TYPE (NILP (tail), Qplistp, plist);
+ return Qnil;
+}
DEFUN ("eql", Feql, Seql, 2, 2, 0,
doc: /* Return t if the two args are `eq' or are indistinguishable
numbers.
@@ -3340,43 +3434,6 @@ FILENAME are suppressed. */)
bottleneck of Widget operation. Here is their translation to C,
for the sole reason of efficiency. */
-DEFUN ("plist-member", Fplist_member, Splist_member, 2, 3, 0,
- doc: /* Return non-nil if PLIST has the property PROP.
-PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2 ...).
-
-The comparison with PROP is done using PREDICATE, which defaults to
-`eq'.
-
-Unlike `plist-get', this allows you to distinguish between a missing
-property and a property with the value nil.
-The value is actually the tail of PLIST whose car is PROP. */)
- (Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
-{
- Lisp_Object tail = plist;
- if (NILP (predicate))
- predicate = Qeq;
- FOR_EACH_TAIL (tail)
- {
- if (!NILP (call2 (predicate, XCAR (tail), prop)))
- return tail;
- tail = XCDR (tail);
- if (! CONSP (tail))
- break;
- }
- CHECK_TYPE (NILP (tail), Qplistp, plist);
- return Qnil;
-}
-
-/* plist_member isn't used much in the Emacs sources, so just provide
- a shim so that the function name follows the same pattern as
- plist_get/plist_put. */
-Lisp_Object
-plist_member (Lisp_Object plist, Lisp_Object prop)
-{
- return Fplist_member (plist, prop, Qnil);
-}
-
DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
doc: /* In WIDGET, set PROPERTY to VALUE.
The value can later be retrieved with `widget-get'. */)
diff --git a/src/frame.c b/src/frame.c
index 91b9bec82c..f076a5ba54 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -1503,17 +1503,7 @@ do_switch_frame (Lisp_Object frame, int for_deletion,
Lisp_Object norecord)
sf->select_mini_window_flag = MINI_WINDOW_P (XWINDOW (sf->selected_window));
- selected_frame = frame;
-
- move_minibuffers_onto_frame (sf, for_deletion);
-
- if (f->select_mini_window_flag
- && !NILP (Fminibufferp (XWINDOW (f->minibuffer_window)->contents, Qt)))
- f->selected_window = f->minibuffer_window;
- f->select_mini_window_flag = false;
-
- if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
- last_nonminibuf_frame = XFRAME (selected_frame);
+ move_minibuffers_onto_frame (sf, frame, for_deletion);
/* If the selected window in the target frame is its mini-window, we move
to a different window, the most recently used one, unless there is a
@@ -1528,6 +1518,20 @@ do_switch_frame (Lisp_Object frame, int for_deletion,
Lisp_Object norecord)
Fset_frame_selected_window (frame, w, Qnil);
}
+ /* After setting `selected_frame`, we're temporarily in an inconsistent
+ state where (selected-window) != (frame-selected-window). Until this
+ invariant is restored we should be very careful not to run ELisp code.
+ (bug#58343) */
+ selected_frame = frame;
+
+ if (f->select_mini_window_flag
+ && !NILP (Fminibufferp (XWINDOW (f->minibuffer_window)->contents, Qt)))
+ f->selected_window = f->minibuffer_window;
+ f->select_mini_window_flag = false;
+
+ if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
+ last_nonminibuf_frame = XFRAME (selected_frame);
+
Fselect_window (f->selected_window, norecord);
/* We want to make sure that the next event generates a frame-switch
@@ -2110,7 +2114,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
else
/* Ensure any minibuffers on FRAME are moved onto the selected
frame. */
- move_minibuffers_onto_frame (f, true);
+ move_minibuffers_onto_frame (f, selected_frame, true);
/* Don't let echo_area_window to remain on a deleted frame. */
if (EQ (f->minibuffer_window, echo_area_window))
diff --git a/src/haikuterm.c b/src/haikuterm.c
index 838eb128fa..4e32b74716 100644
--- a/src/haikuterm.c
+++ b/src/haikuterm.c
@@ -232,6 +232,9 @@ haiku_frame_up_to_date (struct frame *f)
be_evict_font_cache ();
up_to_date_count = 0;
}
+
+ /* Mark the frame as complete. */
+ FRAME_COMPLETE_P (f) = true;
unblock_input ();
}
@@ -265,6 +268,8 @@ haiku_clear_frame (struct frame *f)
mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f)));
+ FRAME_COMPLETE_P (f) = false;
+
block_input ();
BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f),
FRAME_PIXEL_HEIGHT (f));
@@ -1436,6 +1441,9 @@ haiku_clip_to_row (struct window *w, struct glyph_row
*row,
static void
haiku_update_begin (struct frame *f)
{
+ /* Mark the frame as incomplete so it is not flushed upon handling
+ input. */
+ FRAME_COMPLETE_P (f) = false;
}
static void
@@ -2959,6 +2967,10 @@ haiku_flush (struct frame *f)
if (FRAME_DIRTY_P (f) && !buffer_flipping_blocked_p ())
haiku_flip_buffers (f);
+ /* The frame is complete again as its contents were just
+ flushed. */
+ FRAME_COMPLETE_P (f) = true;
+
if (FRAME_VISIBLE_P (f) && !FRAME_TOOLTIP_P (f))
BWindow_Flush (FRAME_HAIKU_WINDOW (f));
}
@@ -3086,10 +3098,15 @@ haiku_make_fullscreen_consistent (struct frame *f)
static void
haiku_flush_dirty_back_buffer_on (struct frame *f)
{
- if (!FRAME_GARBAGED_P (f)
- && !buffer_flipping_blocked_p ()
- && FRAME_DIRTY_P (f))
- haiku_flip_buffers (f);
+ if (FRAME_GARBAGED_P (f)
+ || buffer_flipping_blocked_p ()
+ /* If the frame is not already up to date, do not flush buffers
+ on input, as that will result in flicker. */
+ || !FRAME_COMPLETE_P (f)
+ || !FRAME_DIRTY_P (f))
+ return;
+
+ haiku_flip_buffers (f);
}
/* N.B. that support for TYPE must be explicitly added to
@@ -3135,6 +3152,7 @@ haiku_read_socket (struct terminal *terminal, struct
input_event *hold_quit)
int button_or_motion_p, do_help;
enum haiku_event_type type;
struct input_event inev, inev2;
+ struct frame *mouse_frame;
message_count = 0;
button_or_motion_p = 0;
@@ -3252,9 +3270,13 @@ haiku_read_socket (struct terminal *terminal, struct
input_event *hold_quit)
|| !EQ (f->tool_bar_window, hlinfo->mouse_face_window)
|| !EQ (f->tab_bar_window, hlinfo->mouse_face_window)))
{
+ mouse_frame = hlinfo->mouse_face_mouse_frame;
+
clear_mouse_face (hlinfo);
hlinfo->mouse_face_hidden = true;
- haiku_flush_dirty_back_buffer_on (f);
+
+ if (mouse_frame)
+ haiku_flush_dirty_back_buffer_on (mouse_frame);
}
inev.code = b->keysym ? b->keysym : b->multibyte_char;
diff --git a/src/haikuterm.h b/src/haikuterm.h
index 86274fd42a..70e8cf948b 100644
--- a/src/haikuterm.h
+++ b/src/haikuterm.h
@@ -174,6 +174,10 @@ struct haiku_output
displayed yet. */
bool_bf dirty_p : 1;
+ /* Whether or not the frame is complete, i.e. safe to flush on
+ input. */
+ bool_bf complete_p : 1;
+
struct font *font;
/* The pending position we're waiting for. */
@@ -275,6 +279,7 @@ struct scroll_bar
#define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec))
#define FRAME_DIRTY_P(f) (FRAME_OUTPUT_DATA (f)->dirty_p)
+#define FRAME_COMPLETE_P(f) (FRAME_OUTPUT_DATA (f)->complete_p)
#define MAKE_FRAME_DIRTY(f) (FRAME_DIRTY_P (f) = 1)
#define FRAME_OUTPUT_DATA(f) ((f)->output_data.haiku)
#define FRAME_HAIKU_WINDOW(f) (FRAME_OUTPUT_DATA (f)->window)
diff --git a/src/lisp.h b/src/lisp.h
index 679c0d53bd..de8678564c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1578,10 +1578,15 @@ struct Lisp_String
{
struct
{
- ptrdiff_t size; /* MSB is used as the markbit. */
- ptrdiff_t size_byte; /* Set to -1 for unibyte strings,
- -2 for data in rodata,
- -3 for immovable unibyte strings. */
+ /* Number of characters in string; MSB is used as the mark bit. */
+ ptrdiff_t size;
+ /* If nonnegative, number of bytes in the string (which is multibyte).
+ If negative, the string is unibyte:
+ -1 for data normally allocated
+ -2 for data in rodata (C string constants)
+ -3 for data that must be immovable (used for bytecode) */
+ ptrdiff_t size_byte;
+
INTERVAL intervals; /* Text properties in this string. */
unsigned char *data;
} s;
@@ -4889,7 +4894,7 @@ extern void clear_regexp_cache (void);
extern Lisp_Object Vminibuffer_list;
extern Lisp_Object last_minibuf_string;
-extern void move_minibuffers_onto_frame (struct frame *, bool);
+extern void move_minibuffers_onto_frame (struct frame *, Lisp_Object, bool);
extern bool is_minibuffer (EMACS_INT, Lisp_Object);
extern EMACS_INT this_minibuffer_depth (Lisp_Object);
extern EMACS_INT minibuf_level;
diff --git a/src/menu.c b/src/menu.c
index c52e9258a1..a8cb942a19 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -24,6 +24,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "lisp.h"
#include "character.h"
#include "coding.h"
+#include "dispextern.h"
#include "keyboard.h"
#include "keymap.h"
#include "frame.h"
@@ -1391,6 +1392,17 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu)
run_hook (Qx_pre_popup_menu_hook);
+#ifdef HAVE_WINDOW_SYSTEM
+ /* Cancel the hourglass timer. Depending on how the show_menu_hook
+ is implemented, the hourglass window can either be mapped (or on
+ non-X systems, the hourglass cursor can be defined) either while
+ the menu is active, or while it is deactivated. Both situations
+ lead to annoying cursor and/or screen flicker and a failure to
+ detect input immediately after a popup menu generated by Custom
+ is unmapped. */
+ cancel_hourglass ();
+#endif
+
/* Display them in a menu, but not if F is the initial frame that
doesn't have its hooks set (e.g., in a batch session), because
such a frame cannot display menus. */
diff --git a/src/minibuf.c b/src/minibuf.c
index 2fc2afafcf..3a29c579a2 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -187,13 +187,15 @@ zip_minibuffer_stacks (Lisp_Object dest_window,
Lisp_Object source_window)
/* If `minibuffer_follows_selected_frame' is t, or we're about to
delete a frame which potentially "contains" minibuffers, move them
- from the old frame to the selected frame. This function is
+ from the old frame to the to-be-selected frame. This function is
intended to be called from `do_switch_frame' in frame.c. OF is the
- old frame, FOR_DELETION is true if OF is about to be deleted. */
+ old frame, FRAME is the to-be-selected frame, and FOR_DELETION is true
+ if OF is about to be deleted. */
void
-move_minibuffers_onto_frame (struct frame *of, bool for_deletion)
+move_minibuffers_onto_frame (struct frame *of, Lisp_Object frame,
+ bool for_deletion)
{
- struct frame *f = XFRAME (selected_frame);
+ struct frame *f = XFRAME (frame);
minibuf_window = f->minibuffer_window;
if (!(minibuf_level
@@ -206,7 +208,7 @@ move_minibuffers_onto_frame (struct frame *of, bool
for_deletion)
{
zip_minibuffer_stacks (f->minibuffer_window, of->minibuffer_window);
if (for_deletion && XFRAME (MB_frame) != of)
- MB_frame = selected_frame;
+ MB_frame = frame;
}
}
diff --git a/src/msdos.h b/src/msdos.h
index 24697bcf24..1b304cf02b 100644
--- a/src/msdos.h
+++ b/src/msdos.h
@@ -123,7 +123,6 @@ extern void x_set_menu_bar_lines (struct frame *,
Lisp_Object, Lisp_Object);
#define XGetGeometry(p1,p2,p3,p4,p5,p6,p7,p8,p9)
#define DisplayWidth(p1,p2) (SELECTED_FRAME()->text_cols)
#define DisplayHeight(p1,p2) (SELECTED_FRAME()->text_lines)
-#define XMenuSetAEQ (void)
#define XMenuSetFreeze (void)
#define XMenuRecompute (void)
#define XM_FAILURE -1
diff --git a/src/nsterm.m b/src/nsterm.m
index 82fe58e90e..1fc72d83f6 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -2479,7 +2479,7 @@ get_keysym_name (int keysym)
{
static char value[16];
NSTRACE ("get_keysym_name");
- sprintf (value, "%d", keysym);
+ snprintf (value, 16, "%d", keysym);
return value;
}
@@ -4263,7 +4263,7 @@ ns_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
{
unsigned int ch = glyph->u.glyphless.ch;
eassume (ch <= MAX_CHAR);
- sprintf (buf, "%0*X", ch < 0x10000 ? 4 : 6, ch);
+ snprintf (buf, 7, "%0*X", ch < 0x10000 ? 4 : 6, ch);
str = buf;
}
@@ -6116,17 +6116,20 @@ ns_term_shutdown (int sig)
- (void) terminate: (id)sender
{
+ struct input_event ie;
+ struct frame *f;
+
NSTRACE ("[EmacsApp terminate:]");
- struct frame *emacsframe = SELECTED_FRAME ();
+ f = SELECTED_FRAME ();
+ EVENT_INIT (ie);
- if (!emacs_event)
- return;
+ ie.kind = NS_NONKEY_EVENT;
+ ie.code = KEY_NS_POWER_OFF;
+ ie.arg = Qt; /* mark as non-key event */
+ XSETFRAME (ie.frame_or_window, f);
- emacs_event->kind = NS_NONKEY_EVENT;
- emacs_event->code = KEY_NS_POWER_OFF;
- emacs_event->arg = Qt; /* mark as non-key event */
- EV_TRAILER ((id)nil);
+ kbd_buffer_store_event (&ie);
}
static bool
@@ -8593,7 +8596,7 @@ ns_create_font_panel_buttons (id target, SEL select, SEL
cancel_action)
EmacsLayer *layer = (EmacsLayer *)[self layer];
[layer setContentsScale:[[notification object] backingScaleFactor]];
- [layer setColorSpace:[[[notification object] colorSpace] CGColorSpace]];
+ [layer setColorSpace:[(id) [[notification object] colorSpace] CGColorSpace]];
ns_clear_frame (emacsframe);
expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
diff --git a/src/pdumper.c b/src/pdumper.c
index 59e46aab28..83432ed3cc 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2067,7 +2067,7 @@ dump_interval_tree (struct dump_context *ctx,
static dump_off
dump_string (struct dump_context *ctx, const struct Lisp_String *string)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_String_C2CAF90352)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_String_03B2DF1C8E)
# error "Lisp_String changed. See CHECK_STRUCTS comment in config.h."
#endif
/* If we have text properties, write them _after_ the string so that
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 9b2c14c413..626560911f 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -3446,14 +3446,18 @@ static bool bcmp_translate (re_char *, re_char *,
ptrdiff_t,
/* Call before fetching a character with *d. This switches over to
string2 if necessary.
+ `reset' is executed before backtracking if there are no more characters.
Check re_match_2_internal for a discussion of why end_match_2 might
not be within string2 (but be equal to end_match_1 instead). */
-#define PREFETCH() \
+#define PREFETCH(reset)
\
while (d == dend) \
{ \
/* End of string2 => fail. */ \
if (dend == end_match_2) \
- goto fail; \
+ { \
+ reset; \
+ goto fail; \
+ } \
/* End of string1 => advance to string2. */ \
d = string2; \
dend = end_match_2; \
@@ -4252,7 +4256,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
int pat_charlen, buf_charlen;
int pat_ch, buf_ch;
- PREFETCH ();
+ PREFETCH (d = dfail);
if (multibyte)
pat_ch = string_char_and_length (p, &pat_charlen);
else
@@ -4280,7 +4284,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
int pat_charlen;
int pat_ch, buf_ch;
- PREFETCH ();
+ PREFETCH (d = dfail);
if (multibyte)
{
pat_ch = string_char_and_length (p, &pat_charlen);
@@ -4486,7 +4490,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
if (d2 == dend2) break;
/* If necessary, advance to next segment in data. */
- PREFETCH ();
+ PREFETCH (d = dfail);
/* How many characters left in this segment to match. */
dcnt = dend - d;
diff --git a/src/sqlite.c b/src/sqlite.c
index 54bfb7b6c6..1526e344e5 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -51,6 +51,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_bind_double,
(sqlite3_stmt*, int, double));
DEF_DLL_FN (SQLITE_API int, sqlite3_bind_null, (sqlite3_stmt*, int));
DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int, (sqlite3_stmt*, int, int));
DEF_DLL_FN (SQLITE_API const char*, sqlite3_errmsg, (sqlite3*));
+DEF_DLL_FN (SQLITE_API const char*, sqlite3_errstr, (int));
DEF_DLL_FN (SQLITE_API int, sqlite3_step, (sqlite3_stmt*));
DEF_DLL_FN (SQLITE_API int, sqlite3_changes, (sqlite3*));
DEF_DLL_FN (SQLITE_API int, sqlite3_column_count, (sqlite3_stmt*));
@@ -88,6 +89,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
# undef sqlite3_bind_null
# undef sqlite3_bind_int
# undef sqlite3_errmsg
+# undef sqlite3_errstr
# undef sqlite3_step
# undef sqlite3_changes
# undef sqlite3_column_count
@@ -112,6 +114,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
# define sqlite3_bind_null fn_sqlite3_bind_null
# define sqlite3_bind_int fn_sqlite3_bind_int
# define sqlite3_errmsg fn_sqlite3_errmsg
+# define sqlite3_errstr fn_sqlite3_errstr
# define sqlite3_step fn_sqlite3_step
# define sqlite3_changes fn_sqlite3_changes
# define sqlite3_column_count fn_sqlite3_column_count
@@ -139,6 +142,7 @@ load_dll_functions (HMODULE library)
LOAD_DLL_FN (library, sqlite3_bind_null);
LOAD_DLL_FN (library, sqlite3_bind_int);
LOAD_DLL_FN (library, sqlite3_errmsg);
+ LOAD_DLL_FN (library, sqlite3_errstr);
LOAD_DLL_FN (library, sqlite3_step);
LOAD_DLL_FN (library, sqlite3_changes);
LOAD_DLL_FN (library, sqlite3_column_count);
@@ -373,72 +377,6 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object
values)
return NULL;
}
-DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0,
- doc: /* Execute a non-select SQL statement.
-If VALUES is non-nil, it should be a vector or a list of values
-to bind when executing a statement like
-
- insert into foo values (?, ?, ...)
-
-Value is the number of affected rows. */)
- (Lisp_Object db, Lisp_Object query, Lisp_Object values)
-{
- check_sqlite (db, false);
- CHECK_STRING (query);
- if (!(NILP (values) || CONSP (values) || VECTORP (values)))
- xsignal1 (Qerror, build_string ("VALUES must be a list or a vector"));
-
- sqlite3 *sdb = XSQLITE (db)->db;
- Lisp_Object retval = Qnil;
- const char *errmsg = NULL;
- Lisp_Object encoded = encode_string (query);
- sqlite3_stmt *stmt = NULL;
-
- /* We only execute the first statement -- if there's several
- (separated by a semicolon), the subsequent statements won't be
- done. */
- int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), -1, &stmt, NULL);
- if (ret != SQLITE_OK)
- {
- if (stmt != NULL)
- {
- sqlite3_finalize (stmt);
- sqlite3_reset (stmt);
- }
-
- errmsg = sqlite3_errmsg (sdb);
- goto exit;
- }
-
- /* Bind ? values. */
- if (!NILP (values)) {
- const char *err = bind_values (sdb, stmt, values);
- if (err != NULL)
- {
- errmsg = err;
- goto exit;
- }
- }
-
- ret = sqlite3_step (stmt);
- sqlite3_finalize (stmt);
- if (ret != SQLITE_OK && ret != SQLITE_DONE)
- {
- errmsg = sqlite3_errmsg (sdb);
- goto exit;
- }
-
- retval = make_fixnum (sqlite3_changes (sdb));
-
- exit:
- if (errmsg != NULL)
- xsignal1 (ret == SQLITE_LOCKED || ret == SQLITE_BUSY?
- Qsqlite_locked_error: Qerror,
- build_string (errmsg));
-
- return retval;
-}
-
static Lisp_Object
row_to_value (sqlite3_stmt *stmt)
{
@@ -483,6 +421,94 @@ row_to_value (sqlite3_stmt *stmt)
return Fnreverse (values);
}
+static Lisp_Object
+sqlite_prepare_errmsg (int code, sqlite3 *sdb)
+{
+ Lisp_Object errmsg = build_string (sqlite3_errstr (code));
+ /* More details about what went wrong. */
+ const char *sql_error = sqlite3_errmsg (sdb);
+ if (sql_error)
+ return CALLN (Fformat, build_string ("%s (%s)"),
+ errmsg, build_string (sql_error));
+ else
+ return errmsg;
+}
+
+DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0,
+ doc: /* Execute a non-select SQL statement.
+If VALUES is non-nil, it should be a vector or a list of values
+to bind when executing a statement like
+
+ insert into foo values (?, ?, ...)
+
+Value is the number of affected rows. */)
+ (Lisp_Object db, Lisp_Object query, Lisp_Object values)
+{
+ check_sqlite (db, false);
+ CHECK_STRING (query);
+ if (!(NILP (values) || CONSP (values) || VECTORP (values)))
+ xsignal1 (Qerror, build_string ("VALUES must be a list or a vector"));
+
+ sqlite3 *sdb = XSQLITE (db)->db;
+ Lisp_Object errmsg = Qnil,
+ encoded = encode_string (query);
+ sqlite3_stmt *stmt = NULL;
+
+ /* We only execute the first statement -- if there's several
+ (separated by a semicolon), the subsequent statements won't be
+ done. */
+ int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), -1, &stmt, NULL);
+ if (ret != SQLITE_OK)
+ {
+ if (stmt != NULL)
+ {
+ sqlite3_finalize (stmt);
+ sqlite3_reset (stmt);
+ }
+
+ errmsg = sqlite_prepare_errmsg (ret, sdb);
+ goto exit;
+ }
+
+ /* Bind ? values. */
+ if (!NILP (values))
+ {
+ const char *err = bind_values (sdb, stmt, values);
+ if (err != NULL)
+ {
+ errmsg = build_string (err);
+ goto exit;
+ }
+ }
+
+ ret = sqlite3_step (stmt);
+
+ if (ret == SQLITE_ROW)
+ {
+ Lisp_Object data = Qnil;
+ do
+ data = Fcons (row_to_value (stmt), data);
+ while (sqlite3_step (stmt) == SQLITE_ROW);
+
+ sqlite3_finalize (stmt);
+ return Fnreverse (data);
+ }
+ else if (ret == SQLITE_OK || ret == SQLITE_DONE)
+ {
+ Lisp_Object rows = make_fixnum (sqlite3_changes (sdb));
+ sqlite3_finalize (stmt);
+ return rows;
+ }
+ else
+ errmsg = build_string (sqlite3_errmsg (sdb));
+
+ exit:
+ sqlite3_finalize (stmt);
+ xsignal1 (ret == SQLITE_LOCKED || ret == SQLITE_BUSY?
+ Qsqlite_locked_error: Qerror,
+ errmsg);
+}
+
static Lisp_Object
column_names (sqlite3_stmt *stmt)
{
@@ -517,9 +543,8 @@ which means that we return a set object that can be queried
with
xsignal1 (Qerror, build_string ("VALUES must be a list or a vector"));
sqlite3 *sdb = XSQLITE (db)->db;
- Lisp_Object retval = Qnil;
- const char *errmsg = NULL;
- Lisp_Object encoded = encode_string (query);
+ Lisp_Object retval = Qnil, errmsg = Qnil,
+ encoded = encode_string (query);
sqlite3_stmt *stmt = NULL;
int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), SBYTES (encoded),
@@ -528,7 +553,7 @@ which means that we return a set object that can be queried
with
{
if (stmt)
sqlite3_finalize (stmt);
-
+ errmsg = sqlite_prepare_errmsg (ret, sdb);
goto exit;
}
@@ -539,7 +564,7 @@ which means that we return a set object that can be queried
with
if (err != NULL)
{
sqlite3_finalize (stmt);
- errmsg = err;
+ errmsg = build_string (err);
goto exit;
}
}
@@ -553,7 +578,7 @@ which means that we return a set object that can be queried
with
/* Return the data directly. */
Lisp_Object data = Qnil;
- while ((ret = sqlite3_step (stmt)) == SQLITE_ROW)
+ while (sqlite3_step (stmt) == SQLITE_ROW)
data = Fcons (row_to_value (stmt), data);
if (EQ (return_type, Qfull))
@@ -563,8 +588,8 @@ which means that we return a set object that can be queried
with
sqlite3_finalize (stmt);
exit:
- if (errmsg != NULL)
- xsignal1 (Qerror, build_string (errmsg));
+ if (! NILP (errmsg))
+ xsignal1 (Qerror, errmsg);
return retval;
}
diff --git a/src/sysdep.c b/src/sysdep.c
index abb385d138..736723bdf3 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -2432,7 +2432,7 @@ emacs_pipe (int fd[2])
/* Approximate posix_close and POSIX_CLOSE_RESTART well enough for Emacs.
For the background behind this mess, please see Austin Group defect 529
- <http://austingroupbugs.net/view.php?id=529>. */
+ <https://austingroupbugs.net/view.php?id=529>. */
#ifndef POSIX_CLOSE_RESTART
# define POSIX_CLOSE_RESTART 1
diff --git a/src/textprop.c b/src/textprop.c
index c91a2b729c..c22b579af2 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -2389,15 +2389,7 @@ returned. */);
DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks,
doc: /* If non-nil, don't run `point-left' and `point-entered'
text properties.
-This also inhibits the use of the `intangible' text property.
-
-This variable is obsolete since Emacs-25.1. Use `cursor-intangible-mode'
-or `cursor-sensor-mode' instead. */);
- /* FIXME: We should make-obsolete-variable, but that signals too many
- warnings in code which does (let ((inhibit-point-motion-hooks t)) ...)
- Ideally, make-obsolete-variable should let us specify that only the nil
- value is obsolete, but that requires too many changes in bytecomp.el,
- so for now we'll keep it "obsolete via the docstring". */
+This also inhibits the use of the `intangible' text property. */);
Vinhibit_point_motion_hooks = Qt;
DEFVAR_LISP ("text-property-default-nonsticky",
diff --git a/src/widget.c b/src/widget.c
index 5a75cdaca8..aaab33b6d8 100644
--- a/src/widget.c
+++ b/src/widget.c
@@ -195,7 +195,7 @@ round_size_to_char (EmacsFrame ew, Dimension in_width,
Dimension in_height,
out_width, out_height);
}
-static Widget
+static WMShellWidget
get_wm_shell (Widget w)
{
Widget wmshell;
@@ -204,7 +204,7 @@ get_wm_shell (Widget w)
wmshell && !XtIsWMShell (wmshell);
wmshell = XtParent (wmshell));
- return wmshell;
+ return (WMShellWidget) wmshell;
}
#if 0 /* Currently not used. */
@@ -269,8 +269,8 @@ set_frame_size (EmacsFrame ew)
(f, build_string ("set_frame_size"));
}
-static void
-update_wm_hints (Widget wmshell, EmacsFrame ew)
+static bool
+update_wm_hints (WMShellWidget wmshell, EmacsFrame ew)
{
int cw;
int ch;
@@ -280,6 +280,12 @@ update_wm_hints (Widget wmshell, EmacsFrame ew)
int char_height;
int base_width;
int base_height;
+ char buffer[sizeof wmshell->wm.size_hints];
+ char *hints_ptr;
+
+ /* Copy the old size hints to the buffer. */
+ memcpy (buffer, &wmshell->wm.size_hints,
+ sizeof wmshell->wm.size_hints);
pixel_to_char_size (ew, ew->core.width, ew->core.height,
&char_width, &char_height);
@@ -292,27 +298,29 @@ update_wm_hints (Widget wmshell, EmacsFrame ew)
base_height = (wmshell->core.height - ew->core.height
+ (rounded_height - (char_height * ch)));
- /* Ensure that Xt actually sets window manager hint flags specified
- by the caller by making sure XtNminWidth (a relatively harmless
- resource) always changes each time this function is invoked. */
- ew->emacs_frame.size_switch = !ew->emacs_frame.size_switch;
-
- XtVaSetValues (wmshell,
+ XtVaSetValues ((Widget) wmshell,
XtNbaseWidth, (XtArgVal) base_width,
XtNbaseHeight, (XtArgVal) base_height,
XtNwidthInc, (XtArgVal) (frame_resize_pixelwise ? 1 : cw),
XtNheightInc, (XtArgVal) (frame_resize_pixelwise ? 1 : ch),
- XtNminWidth, (XtArgVal) (base_width
- + ew->emacs_frame.size_switch),
- XtNminHeight, (XtArgVal) (base_height
- + ew->emacs_frame.size_switch),
+ XtNminWidth, (XtArgVal) base_width,
+ XtNminHeight, (XtArgVal) base_height,
NULL);
+
+ /* Return if size hints really changed. If they did not, then Xt
+ probably didn't set them either (or take the flags into
+ account.) */
+ hints_ptr = (char *) &wmshell->wm.size_hints;
+
+ /* Skip flags, which is unsigned long. */
+ return memcmp (hints_ptr + sizeof (long), buffer + sizeof (long),
+ sizeof wmshell->wm.wm_hints - sizeof (long));
}
-void
+bool
widget_update_wm_size_hints (Widget widget, Widget frame)
{
- update_wm_hints (widget, (EmacsFrame) frame);
+ return update_wm_hints ((WMShellWidget) widget, (EmacsFrame) frame);
}
static void
@@ -357,8 +365,6 @@ EmacsFrameInitialize (Widget request, Widget new,
exit (1);
}
- ew->emacs_frame.size_switch = 1;
-
update_from_various_frame_slots (ew);
set_frame_size (ew);
}
diff --git a/src/widget.h b/src/widget.h
index 2906d5ff9e..cf83cb1078 100644
--- a/src/widget.h
+++ b/src/widget.h
@@ -97,6 +97,6 @@ extern struct _DisplayContext *display_context;
/* Special entry points */
void EmacsFrameSetCharSize (Widget, int, int);
void widget_store_internal_border (Widget widget);
-void widget_update_wm_size_hints (Widget widget, Widget frame);
+bool widget_update_wm_size_hints (Widget widget, Widget frame);
#endif /* _EmacsFrame_h */
diff --git a/src/widgetprv.h b/src/widgetprv.h
index fe960326b0..3a4d9206ff 100644
--- a/src/widgetprv.h
+++ b/src/widgetprv.h
@@ -49,9 +49,6 @@ typedef struct {
Boolean visual_bell; /* flash instead of beep */
int bell_volume; /* how loud is beep */
- int size_switch; /* hack to make setting size
- hints work correctly */
-
/* private state */
} EmacsFramePart;
diff --git a/src/window.c b/src/window.c
index da80fabe33..f116b9a9d7 100644
--- a/src/window.c
+++ b/src/window.c
@@ -52,6 +52,7 @@ static ptrdiff_t get_leaf_windows (struct window *, struct
window **,
ptrdiff_t);
static void window_scroll_pixel_based (Lisp_Object, int, bool, bool);
static void window_scroll_line_based (Lisp_Object, int, bool, bool);
+static void window_scroll_for_long_lines (struct window *, int, bool);
static void foreach_window (struct frame *,
bool (* fn) (struct window *, void *),
void *);
@@ -5440,12 +5441,13 @@ window_wants_mode_line (struct window *w)
* Return 1 if window W wants a header line and is high enough to
* accommodate it, 0 otherwise.
*
- * W wants a header line if it's a leaf window and neither a minibuffer
- * nor a pseudo window. Moreover, its 'window-mode-line-format'
- * parameter must not be 'none' and either that parameter or W's
- * buffer's 'mode-line-format' value must be non-nil. Finally, W must
- * be higher than its frame's canonical character height and be able to
- * accommodate a mode line too if necessary (the mode line prevails).
+ * W wants a header line if it's a leaf window and neither a
+ * minibuffer nor a pseudo window. Moreover, its
+ * 'window-header-line-format' parameter must not be 'none' and either
+ * that parameter or W's buffer's 'header-line-format' value must be
+ * non-nil. Finally, W must be higher than its frame's canonical
+ * character height and be able to accommodate a mode line too if
+ * necessary (the mode line prevails).
*/
bool
window_wants_header_line (struct window *w)
@@ -5473,9 +5475,9 @@ window_wants_header_line (struct window *w)
* accommodate it, 0 otherwise.
*
* W wants a tab line if it's a leaf window and neither a minibuffer
- * nor a pseudo window. Moreover, its 'window-mode-line-format'
+ * nor a pseudo window. Moreover, its 'window-tab-line-format'
* parameter must not be 'none' and either that parameter or W's
- * buffer's 'mode-line-format' value must be non-nil. Finally, W must
+ * buffer's 'tab-line-format' value must be non-nil. Finally, W must
* be higher than its frame's canonical character height and be able
* to accommodate a mode line and a header line too if necessary (the
* mode line and a header line prevail).
@@ -5536,19 +5538,40 @@ window_internal_height (struct window *w)
static void
window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror)
{
+ struct window *w = XWINDOW (window);
+ struct buffer *b = XBUFFER (w->contents);
+ bool long_lines_truncated =
+ b->long_line_optimizations_p && !NILP (BVAR (b, truncate_lines));
specpdl_ref count = SPECPDL_INDEX ();
n = clip_to_bounds (INT_MIN, n, INT_MAX);
- wset_redisplay (XWINDOW (window));
+ wset_redisplay (w);
+
+ /* Does this window's buffer have very long and truncated lines? */
+ if (b->long_line_optimizations_p
+ && !long_lines_truncated
+ && !NILP (Vtruncate_partial_width_windows)
+ && w->total_cols < FRAME_COLS (XFRAME (WINDOW_FRAME (w))))
+ {
+ if (FIXNUMP (Vtruncate_partial_width_windows))
+ long_lines_truncated =
+ w->total_cols < XFIXNAT (Vtruncate_partial_width_windows);
+ else
+ long_lines_truncated = true;
+ }
- if (whole && fast_but_imprecise_scrolling)
+ if (whole && (fast_but_imprecise_scrolling || long_lines_truncated))
specbind (Qfontification_functions, Qnil);
- /* On GUI frames, use the pixel-based version which is much slower
- than the line-based one but can handle varying line heights. */
- if (FRAME_WINDOW_P (XFRAME (XWINDOW (window)->frame)))
+ if (whole && long_lines_truncated)
+ window_scroll_for_long_lines (w, n, noerror);
+ else if (FRAME_WINDOW_P (XFRAME (XWINDOW (window)->frame)))
{
+
+ /* On GUI frames, use the pixel-based version which is much
+ slower than the line-based one, but can handle varying
+ line heights. */
record_unwind_protect_void (unwind_display_working_on_window);
display_working_on_window_p = true;
window_scroll_pixel_based (window, n, whole, noerror);
@@ -5598,6 +5621,71 @@ sanitize_next_screen_context_lines (void)
return clip_to_bounds (0, next_screen_context_lines, 1000000);
}
+/* Implementation of window_scroll for very long and truncated lines.
+ This is a simplified version, it only handles WHOLE window scrolls,
+ and doesn't honor scroll-preserve-screen-position nor scroll-margin. */
+static void
+window_scroll_for_long_lines (struct window *w, int n, bool noerror)
+{
+ ptrdiff_t startpos = marker_position (w->start);
+ ptrdiff_t startbyte = marker_byte_position (w->start);
+ int nscls = sanitize_next_screen_context_lines ();
+ register int ht = window_internal_height (w);
+
+ n *= max (1, ht - nscls);
+
+ /* If point is not visible in window, bring it inside window. */
+ struct position pos;
+ int rtop, rbot, dummy_rowh, dummy_vpos, dummy_x, dummy_y;
+ if (!(PT >= startpos
+ && PT <= ZV
+ && startpos <= ZV
+ && pos_visible_p (w, PT, &dummy_x, &dummy_y, &rtop, &rbot, &dummy_rowh,
+ &dummy_vpos)
+ && !rtop && !rbot))
+ {
+ pos = *vmotion (PT, PT_BYTE, - (ht / 2), w);
+ startpos = pos.bufpos;
+ startbyte = pos.bytepos;
+ }
+ SET_PT_BOTH (startpos, startbyte);
+
+ bool lose = n < 0 && PT == BEGV;
+ pos = *vmotion (PT, PT_BYTE, n, w);
+ if (lose)
+ {
+ if (noerror)
+ return;
+ else
+ xsignal0 (Qbeginning_of_buffer);
+ }
+
+ bool bolp = pos.bufpos == BEGV || FETCH_BYTE (pos.bytepos - 1) == '\n';
+ if (pos.bufpos < ZV)
+ {
+ set_marker_restricted_both (w->start, w->contents,
+ pos.bufpos, pos.bytepos);
+ w->start_at_line_beg = bolp;
+ wset_update_mode_line (w);
+ /* Set force_start so that redisplay_window will run
+ the window-scroll-functions. */
+ w->force_start = true;
+ SET_PT_BOTH (pos.bufpos, pos.bytepos);
+ if (n > 0)
+ pos = *vmotion (PT, PT_BYTE, ht / 2, w);
+ else if (n < 0)
+ pos = *vmotion (PT, PT_BYTE, - (ht / 2), w);
+ SET_PT_BOTH (pos.bufpos, pos.bytepos);
+ }
+ else
+ {
+ if (noerror)
+ return;
+ else
+ xsignal0 (Qend_of_buffer);
+ }
+}
+
/* Implementation of window_scroll that works based on pixel line
heights. See the comment of window_scroll for parameter
descriptions. */
diff --git a/src/xdisp.c b/src/xdisp.c
index 9534e27843..1f7ac269e4 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -20165,7 +20165,20 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
from point. */
centering_position = window_box_height (w) / 2;
}
- move_it_vertically_backward (&it, centering_position);
+ if (current_buffer->long_line_optimizations_p
+ && it.line_wrap == TRUNCATE)
+ {
+ /* For very long and truncated lines, go back using a simplified
+ method, which ignored any inaccuracies due to line-height
+ differences, display properties/overlays, etc. */
+ int nlines = centering_position / frame_line_height;
+
+ while (nlines-- && IT_CHARPOS (it) > BEGV)
+ back_to_previous_visible_line_start (&it);
+ reseat_1 (&it, it.current.pos, true);
+ }
+ else
+ move_it_vertically_backward (&it, centering_position);
eassert (IT_CHARPOS (it) >= BEGV);
@@ -34899,7 +34912,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
struct buffer *b;
/* When a menu is active, don't highlight because this looks odd. */
-#if defined (USE_X_TOOLKIT) || (defined (USE_GTK) && !defined (HAVE_PGTK)) ||
defined (HAVE_NS) || defined (MSDOS)
+#if defined (HAVE_X_WINDOWS) || defined (HAVE_NS) || defined (MSDOS)
if (popup_activated ())
return;
#endif
diff --git a/src/xfns.c b/src/xfns.c
index 8cea93c669..e8732986eb 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -4179,11 +4179,15 @@ x_window (struct frame *f)
{
/* XIM server might require some X events. */
unsigned long fevent = NoEventMask;
- XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
- attributes.event_mask |= fevent;
- attribute_mask = CWEventMask;
- XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- attribute_mask, &attributes);
+
+ if (fevent)
+ {
+ XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
+ attributes.event_mask |= fevent;
+ attribute_mask = CWEventMask;
+ XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ attribute_mask, &attributes);
+ }
}
}
#endif /* HAVE_X_I18N */
@@ -8439,7 +8443,17 @@ compute_tip_xy (struct frame *f, Lisp_Object parms,
Lisp_Object dx,
unblock_input ();
XSETFRAME (frame, f);
- attributes = Fx_display_monitor_attributes_list (frame);
+
+#if defined HAVE_XRANDR || defined USE_GTK
+ if (!NILP (FRAME_DISPLAY_INFO (f)->last_monitor_attributes_list))
+ /* Use cached values if available to avoid fetching the
+ monitor list from the X server. If XRandR is not
+ available, then fetching the attributes will probably not
+ sync anyway, and will thus be relatively harmless. */
+ attributes = FRAME_DISPLAY_INFO (f)->last_monitor_attributes_list;
+ else
+#endif
+ attributes = Fx_display_monitor_attributes_list (frame);
/* Try to determine the monitor where the mouse pointer is and
its geometry. See bug#22549. */
@@ -8689,9 +8703,6 @@ Text larger than the specified size is clipped. */)
int old_windows_or_buffers_changed = windows_or_buffers_changed;
specpdl_ref count = SPECPDL_INDEX ();
Lisp_Object window, size, tip_buf;
- Window child;
- XWindowAttributes child_attrs;
- int dest_x_return, dest_y_return;
bool displayed;
#ifdef ENABLE_CHECKING
struct glyph_row *row, *end;
@@ -8942,41 +8953,6 @@ Text larger than the specified size is clipped. */)
/* Show tooltip frame. */
block_input ();
- /* If the display is composited, then WM_TRANSIENT_FOR must be set
- as well, or else the compositing manager won't display
- decorations correctly, even though the tooltip window is override
- redirect. See
- https://specifications.freedesktop.org/wm-spec/1.4/ar01s08.html
-
- Perhaps WM_TRANSIENT_FOR should be used in place of
- override-redirect anyway. The ICCCM only recommends
- override-redirect if the pointer will be grabbed. */
-
- if (XTranslateCoordinates (FRAME_X_DISPLAY (f),
- FRAME_DISPLAY_INFO (f)->root_window,
- FRAME_DISPLAY_INFO (f)->root_window,
- root_x, root_y, &dest_x_return,
- &dest_y_return, &child)
- && child != None)
- {
- /* But only if the child is not override-redirect, which can
- happen if the pointer is above a menu. */
-
- if (XGetWindowAttributes (FRAME_X_DISPLAY (f),
- child, &child_attrs)
- || child_attrs.override_redirect)
- XDeleteProperty (FRAME_X_DISPLAY (tip_f),
- FRAME_X_WINDOW (tip_f),
- FRAME_DISPLAY_INFO (tip_f)->Xatom_wm_transient_for);
- else
- XSetTransientForHint (FRAME_X_DISPLAY (tip_f),
- FRAME_X_WINDOW (tip_f), child);
- }
- else
- XDeleteProperty (FRAME_X_DISPLAY (tip_f),
- FRAME_X_WINDOW (tip_f),
- FRAME_DISPLAY_INFO (tip_f)->Xatom_wm_transient_for);
-
#ifndef USE_XCB
XMoveResizeWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f),
root_x, root_y, width, height);
@@ -9448,13 +9424,21 @@ usual X keysyms. Value is `lambda' if we cannot
determine if both keys are
present and mapped to the usual X keysyms. */)
(Lisp_Object frame)
{
+#ifdef HAVE_XKB
+ XkbDescPtr kb;
+ struct frame *f;
+ Display *dpy;
+ Lisp_Object have_keys;
+ int delete_keycode, backspace_keycode, i;
+#endif
+
#ifndef HAVE_XKB
return Qlambda;
#else
- XkbDescPtr kb;
- struct frame *f = decode_window_system_frame (frame);
- Display *dpy = FRAME_X_DISPLAY (f);
- Lisp_Object have_keys;
+ delete_keycode = 0;
+ backspace_keycode = 0;
+ f = decode_window_system_frame (frame);
+ dpy = FRAME_X_DISPLAY (f);
if (!FRAME_DISPLAY_INFO (f)->supports_xkb)
return Qlambda;
@@ -9470,50 +9454,39 @@ present and mapped to the usual X keysyms. */)
XK_Delete are mapped to any key. But if any of those are mapped to
some non-intuitive key combination (Meta-Shift-Ctrl-whatever) and the
user doesn't know about it, it is better to return false here.
- It is more obvious to the user what to do if she/he has two keys
+ It is more obvious to the user what to do if there are two keys
clearly marked with names/symbols and one key does something not
- expected (i.e. she/he then tries the other).
+ expected (and the user then tries the other).
The cases where Backspace/Delete is mapped to some other key combination
are rare, and in those cases, normal-erase-is-backspace can be turned on
manually. */
have_keys = Qnil;
- kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
- if (kb)
+ kb = FRAME_DISPLAY_INFO (f)->xkb_desc;
+ if (kb && kb->names)
{
- int delete_keycode = 0, backspace_keycode = 0, i;
-
- if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
+ for (i = kb->min_key_code; (i < kb->max_key_code
+ && (delete_keycode == 0
+ || backspace_keycode == 0));
+ ++i)
{
- for (i = kb->min_key_code;
- (i < kb->max_key_code
- && (delete_keycode == 0 || backspace_keycode == 0));
- ++i)
- {
- /* The XKB symbolic key names can be seen most easily in
- the PS file generated by `xkbprint -label name
- $DISPLAY'. */
- if (memcmp ("DELE", kb->names->keys[i].name, 4) == 0)
- delete_keycode = i;
- else if (memcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
- backspace_keycode = i;
- }
-
- XkbFreeNames (kb, 0, True);
+ /* The XKB symbolic key names can be seen most easily in
+ the PS file generated by `xkbprint -label name
+ $DISPLAY'. */
+ if (!memcmp ("DELE", kb->names->keys[i].name, 4))
+ delete_keycode = i;
+ else if (!memcmp ("BKSP", kb->names->keys[i].name, 4))
+ backspace_keycode = i;
}
- /* As of libX11-1.6.2, XkbGetMap manual says that you should use
- XkbFreeClientMap to free the data returned by XkbGetMap. But
- this function just frees the data referenced from KB and not
- KB itself. To free KB as well, call XkbFreeKeyboard. */
- XkbFreeKeyboard (kb, XkbAllMapComponentsMask, True);
-
- if (delete_keycode
- && backspace_keycode
+ if (delete_keycode && backspace_keycode
&& XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
&& XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
have_keys = Qt;
}
+ else
+ /* The keyboard names couldn't be obtained for some reason. */
+ have_keys = Qlambda;
unblock_input ();
return have_keys;
#endif
diff --git a/src/xmenu.c b/src/xmenu.c
index 1452b3c6d1..756842c2fe 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -294,10 +294,13 @@ x_menu_translate_generic_event (XEvent *event)
#endif
#if !defined USE_X_TOOLKIT && !defined USE_GTK
-static void
-x_menu_expose_event (XEvent *event)
+static int
+x_menu_dispatch_event (XEvent *event)
{
x_dispatch_event (event, event->xexpose.display);
+
+ /* The return doesn't really matter. */
+ return 0;
}
#endif
#endif /* ! MSDOS */
@@ -1521,26 +1524,15 @@ create_and_show_popup_menu (struct frame *f,
widget_value *first_wv,
if (use_pos_func)
{
- Window dummy_window;
-
/* Not invoked by a click. pop up at x/y. */
pos_func = menu_position_func;
/* Adjust coordinates to be root-window-relative. */
block_input ();
- XTranslateCoordinates (FRAME_X_DISPLAY (f),
-
- /* From-window, to-window. */
- FRAME_X_WINDOW (f),
- FRAME_DISPLAY_INFO (f)->root_window,
-
- /* From-position, to-position. */
- x, y, &x, &y,
-
- /* Child of win. */
- &dummy_window);
+ x_translate_coordinates_to_root (f, x, y, &x, &y);
#ifdef HAVE_GTK3
- /* Use window scaling factor to adjust position for hidpi screens. */
+ /* Use window scaling factor to adjust position for scaled
+ outputs. */
x /= xg_get_scale (f);
y /= xg_get_scale (f);
#endif
@@ -1743,7 +1735,6 @@ create_and_show_popup_menu (struct frame *f, widget_value
*first_wv,
XButtonPressedEvent *event = &(dummy.xbutton);
LWLIB_ID menu_id;
Widget menu;
- Window dummy_window;
#if defined HAVE_XINPUT2 && defined USE_MOTIF
XEvent property_dummy;
Atom property_atom;
@@ -1775,17 +1766,7 @@ create_and_show_popup_menu (struct frame *f,
widget_value *first_wv,
/* Adjust coordinates to be root-window-relative. */
block_input ();
x += FRAME_LEFT_SCROLL_BAR_AREA_WIDTH (f);
- XTranslateCoordinates (FRAME_X_DISPLAY (f),
-
- /* From-window, to-window. */
- FRAME_X_WINDOW (f),
- FRAME_DISPLAY_INFO (f)->root_window,
-
- /* From-position, to-position. */
- x, y, &x, &y,
-
- /* Child of win. */
- &dummy_window);
+ x_translate_coordinates_to_root (f, x, y, &x, &y);
unblock_input ();
event->x_root = x;
@@ -2559,6 +2540,8 @@ pop_down_menu (void *arg)
}
#endif
+ /* Decrement the popup_activated_flag. */
+ popup_activated_flag = 0;
#endif /* HAVE_X_WINDOWS */
unblock_input ();
@@ -2569,9 +2552,6 @@ Lisp_Object
x_menu_show (struct frame *f, int x, int y, int menuflags,
Lisp_Object title, const char **error_name)
{
-#ifdef HAVE_X_WINDOWS
- Window dummy_window;
-#endif
Window root;
XMenu *menu;
int pane, selidx, lpane, status;
@@ -2620,17 +2600,7 @@ x_menu_show (struct frame *f, int x, int y, int
menuflags,
inhibit_garbage_collection ();
#ifdef HAVE_X_WINDOWS
- XTranslateCoordinates (FRAME_X_DISPLAY (f),
-
- /* From-window, to-window. */
- FRAME_X_WINDOW (f),
- FRAME_DISPLAY_INFO (f)->root_window,
-
- /* From-position, to-position. */
- x, y, &x, &y,
-
- /* Child of win. */
- &dummy_window);
+ x_translate_coordinates_to_root (f, x, y, &x, &y);
#else
/* MSDOS without X support. */
x += f->left_pos;
@@ -2782,21 +2752,22 @@ x_menu_show (struct frame *f, int x, int y, int
menuflags,
y += 1.5 * height/ (maxlines + 2);
}
- XMenuSetAEQ (menu, true);
XMenuSetFreeze (menu, true);
pane = selidx = 0;
#ifndef MSDOS
DEFER_SELECTIONS;
- XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f));
+ XMenuActivateSetWaitFunction (x_menu_wait_for_event,
+ FRAME_X_DISPLAY (f));
+ XMenuEventHandler (x_menu_dispatch_event);
+
/* When the input extension is in use, the owner_events grab will
report extension events on frames, which the XMenu library does
not normally understand. */
#ifdef HAVE_XINPUT2
XMenuActivateSetTranslateFunction (x_menu_translate_generic_event);
#endif
- XMenuActivateSetExposeFunction (x_menu_expose_event);
#endif
record_unwind_protect_ptr (pop_down_menu,
@@ -2822,6 +2793,12 @@ x_menu_show (struct frame *f, int x, int y, int
menuflags,
}
#endif
+#ifdef HAVE_X_WINDOWS
+ /* Increment the popup flag; this prevents nested popups from being
+ displayed by user Lisp code in help-echo callbacks, and also
+ prevents mouse face from being displayed. */
+ popup_activated_flag = 1;
+#endif
status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx,
x, y, ButtonReleaseMask, &datap,
menu_help_callback);
diff --git a/src/xselect.c b/src/xselect.c
index 66782d4172..498c28af53 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -2376,12 +2376,19 @@ On Nextstep, TERMINAL is unused. */)
{
Window owner;
Atom atom;
+#ifdef HAVE_XFIXES
+ Window temp_owner;
+#endif
struct frame *f = frame_for_x_selection (terminal);
struct x_display_info *dpyinfo;
CHECK_SYMBOL (selection);
- if (NILP (selection)) selection = QPRIMARY;
- if (EQ (selection, Qt)) selection = QSECONDARY;
+
+ if (NILP (selection))
+ selection = QPRIMARY;
+
+ if (EQ (selection, Qt))
+ selection = QSECONDARY;
if (!f)
return Qnil;
@@ -2392,10 +2399,22 @@ On Nextstep, TERMINAL is unused. */)
return Qt;
atom = symbol_to_x_atom (dpyinfo, selection);
- if (atom == 0) return Qnil;
+
+ if (!atom)
+ return Qnil;
+
+#ifdef HAVE_XFIXES
+ /* See if this information can be obtained without a roundtrip. */
+ temp_owner = x_find_selection_owner (dpyinfo, atom);
+
+ if (temp_owner != X_INVALID_WINDOW)
+ return (temp_owner != None ? Qt : Qnil);
+#endif
+
block_input ();
owner = XGetSelectionOwner (dpyinfo->display, atom);
unblock_input ();
+
return (owner ? Qt : Qnil);
}
diff --git a/src/xterm.c b/src/xterm.c
index 1d58e80f00..205c948c46 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -1425,9 +1425,6 @@ struct x_client_list_window
/* The width and height of the window. */
int width, height;
- /* Whether or not the window is mapped. */
- bool mapped_p;
-
/* A bitmask describing events Emacs was listening for from the
window before some extra events were added in
`x_dnd_compute_toplevels'. */
@@ -1439,9 +1436,6 @@ struct x_client_list_window
/* The next window in this list. */
struct x_client_list_window *next;
- /* The Motif protocol style of this window, if any. */
- uint8_t xm_protocol_style;
-
/* The extents of the frame window in each direction. */
int frame_extents_left;
int frame_extents_right;
@@ -1452,18 +1446,24 @@ struct x_client_list_window
/* The border width of this window. */
int border_width;
- /* The rectangles making up the input shape. */
- XRectangle *input_rects;
-
/* The number of rectangles composing the input shape. */
int n_input_rects;
+ /* The rectangles making up the input shape. */
+ XRectangle *input_rects;
+
/* The rectangles making up the bounding shape. */
XRectangle *bounding_rects;
/* The number of rectangles composing the bounding shape. */
int n_bounding_rects;
#endif
+
+ /* The Motif protocol style of this window, if any. */
+ uint8_t xm_protocol_style;
+
+ /* Whether or not the window is mapped. */
+ bool mapped_p;
};
/* List of all toplevels in stacking order, from top to bottom. */
@@ -5139,24 +5139,20 @@ x_update_opaque_region (struct frame *f, XEvent
*configure)
if (!FRAME_DISPLAY_INFO (f)->alpha_bits)
return;
- block_input ();
if (f->alpha_background < 1.0)
- XChangeProperty (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
+ XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region,
XA_CARDINAL, 32, PropModeReplace,
NULL, 0);
#ifndef HAVE_GTK3
else
- XChangeProperty (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
+ XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region,
XA_CARDINAL, 32, PropModeReplace,
(unsigned char *) &opaque_region, 4);
#else
else if (FRAME_TOOLTIP_P (f))
- XChangeProperty (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
+ XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region,
XA_CARDINAL, 32, PropModeReplace,
(unsigned char *) &opaque_region, 4);
@@ -5174,7 +5170,6 @@ x_update_opaque_region (struct frame *f, XEvent
*configure)
}
}
#endif
- unblock_input ();
}
@@ -7049,6 +7044,13 @@ x_update_begin (struct frame *f)
#else
/* Nothing to do. */
#endif
+
+#ifdef HAVE_XDBE
+ if (FRAME_X_DOUBLE_BUFFERED_P (f))
+ /* The frame is no longer complete, as it is in the midst of an
+ update. */
+ FRAME_X_COMPLETE_P (f) = false;
+#endif
}
/* Draw a vertical window border from (x,y0) to (x,y1) */
@@ -7144,8 +7146,6 @@ show_back_buffer (struct frame *f)
cairo_t *cr;
#endif
- block_input ();
-
if (FRAME_X_DOUBLE_BUFFERED_P (f))
{
#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME
@@ -7174,8 +7174,6 @@ show_back_buffer (struct frame *f)
}
FRAME_X_NEED_BUFFER_FLIP (f) = false;
-
- unblock_input ();
}
#endif
@@ -7199,6 +7197,10 @@ x_flip_and_flush (struct frame *f)
#ifdef HAVE_XDBE
if (FRAME_X_NEED_BUFFER_FLIP (f))
show_back_buffer (f);
+
+ /* The frame is complete again as its contents were just
+ flushed. */
+ FRAME_X_COMPLETE_P (f) = true;
#endif
x_flush (f);
unblock_input ();
@@ -7249,6 +7251,9 @@ XTframe_up_to_date (struct frame *f)
if (!buffer_flipping_blocked_p ()
&& FRAME_X_NEED_BUFFER_FLIP (f))
show_back_buffer (f);
+
+ /* The frame is now complete, as its contents have been drawn. */
+ FRAME_X_COMPLETE_P (f) = true;
#endif
#ifdef HAVE_XSYNC
@@ -7283,8 +7288,12 @@ XTframe_up_to_date (struct frame *f)
static void
XTbuffer_flipping_unblocked_hook (struct frame *f)
{
+ block_input ();
+
if (FRAME_X_NEED_BUFFER_FLIP (f))
show_back_buffer (f);
+
+ unblock_input ();
}
#endif
@@ -7313,8 +7322,6 @@ x_clear_under_internal_border (struct frame *f)
: INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
- block_input ();
-
if (face)
{
unsigned long color = face->background;
@@ -7335,8 +7342,6 @@ x_clear_under_internal_border (struct frame *f)
x_clear_area (f, width - border, 0, border, height);
x_clear_area (f, 0, height - border, width, border);
}
-
- unblock_input ();
}
}
@@ -7384,7 +7389,6 @@ x_after_update_window_line (struct window *w, struct
glyph_row *desired_row)
: INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
- block_input ();
if (face)
{
unsigned long color = face->background;
@@ -7402,7 +7406,6 @@ x_after_update_window_line (struct window *w, struct
glyph_row *desired_row)
x_clear_area (f, 0, y, width, height);
x_clear_area (f, FRAME_PIXEL_WIDTH (f) - width, y, width, height);
}
- unblock_input ();
}
}
#endif
@@ -7601,11 +7604,27 @@ static void x_check_font (struct frame *, struct font
*);
user time. We don't sanitize timestamps from events sent by the X
server itself because some Lisp might have set the user time to a
ridiculously large value, and this way a more reasonable timestamp
- can be obtained upon the next event. */
+ can be obtained upon the next event.
+
+ Alternatively, the server time could've overflowed.
+
+ SET_PROPERTY specifies whether or not to change the user time
+ property for the active frame. The important thing is to not set
+ the last user time upon leave events; on Metacity and GNOME Shell,
+ mapping a new frame on top of the old frame potentially causes
+ crossing events to be sent to the old frame if it contains the
+ pointer, as the new frame will initially stack above the old frame.
+ If _NET_WM_USER_TIME is changed at that point, then GNOME may get
+ notified about the user time change on the old frame before it
+ tries to focus the new frame, which will make it consider the new
+ frame (whose user time property will not have been updated at that
+ point, due to not being focused) as having been mapped
+ out-of-order, and lower the new frame, which is typically not what
+ users want. */
static void
x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time,
- bool send_event)
+ bool send_event, bool set_property)
{
#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME
uint_fast64_t monotonic_time;
@@ -7678,7 +7697,8 @@ x_display_set_last_user_time (struct x_display_info
*dpyinfo, Time time,
#ifndef USE_GTK
/* Don't waste bandwidth if the time hasn't actually changed. */
- if (focus_frame && old_time != dpyinfo->last_user_time)
+ if (focus_frame && old_time != dpyinfo->last_user_time
+ && set_property)
{
time = dpyinfo->last_user_time;
@@ -7715,16 +7735,38 @@ x_set_gtk_user_time (struct frame *f, Time time)
#endif
+#if !defined USE_GTK || defined HAVE_XFIXES
+
+/* Create and return a special window for receiving events such as
+ selection notify events, and reporting user time. The window is an
+ 1x1 unmapped override-redirect InputOnly window at -1, -1 relative
+ to the parent, which should prevent it from doing anything. */
+
+static Window
+x_create_special_window (struct x_display_info *dpyinfo,
+ Window parent_window)
+{
+ XSetWindowAttributes attrs;
+
+ attrs.override_redirect = True;
+
+ return XCreateWindow (dpyinfo->display, parent_window,
+ -1, -1, 1, 1, 0, CopyFromParent, InputOnly,
+ CopyFromParent, CWOverrideRedirect, &attrs);
+}
+
+#endif
+
/* Not needed on GTK because GTK handles reporting the user time
itself. */
#ifndef USE_GTK
+
static void
x_update_frame_user_time_window (struct frame *f)
{
struct x_output *output;
struct x_display_info *dpyinfo;
- XSetWindowAttributes attrs;
output = FRAME_X_OUTPUT (f);
dpyinfo = FRAME_DISPLAY_INFO (f);
@@ -7766,12 +7808,16 @@ x_update_frame_user_time_window (struct frame *f)
if (output->user_time_window == FRAME_OUTER_WINDOW (f)
|| output->user_time_window == None)
{
- memset (&attrs, 0, sizeof attrs);
+ /* Create a "user time" window that is used to report user
+ activity on a given frame. This is used in preference to
+ _NET_WM_USER_TIME, as using a separate window allows the
+ window manager to express interest in other properties
+ while only reading the user time when necessary, thereby
+ improving battery life by not involving the window
+ manager in each key press. */
output->user_time_window
- = XCreateWindow (dpyinfo->display, FRAME_X_WINDOW (f),
- -1, -1, 1, 1, 0, 0, InputOnly,
- CopyFromParent, 0, &attrs);
+ = x_create_special_window (dpyinfo, FRAME_X_WINDOW (f));
XDeleteProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f),
dpyinfo->Xatom_net_wm_user_time);
@@ -7782,13 +7828,14 @@ x_update_frame_user_time_window (struct frame *f)
}
}
}
+
#endif
void
x_set_last_user_time_from_lisp (struct x_display_info *dpyinfo,
Time time)
{
- x_display_set_last_user_time (dpyinfo, time, true);
+ x_display_set_last_user_time (dpyinfo, time, true, true);
}
@@ -9595,31 +9642,49 @@ x_draw_glyph_string_box (struct glyph_string *s)
#ifndef USE_CAIRO
+
static void
x_composite_image (struct glyph_string *s, Pixmap dest,
+#ifdef HAVE_XRENDER
+ Picture destination,
+#endif
int srcX, int srcY, int dstX, int dstY,
int width, int height)
{
- Display *display = FRAME_X_DISPLAY (s->f);
+ Display *display;
#ifdef HAVE_XRENDER
- if (s->img->picture && FRAME_X_PICTURE_FORMAT (s->f))
- {
- Picture destination;
- XRenderPictFormat *default_format;
- XRenderPictureAttributes attr UNINIT;
+ XRenderPictFormat *default_format;
+ XRenderPictureAttributes attr UNINIT;
+#endif
- default_format = FRAME_X_PICTURE_FORMAT (s->f);
- destination = XRenderCreatePicture (display, dest,
- default_format, 0, &attr);
+ display = FRAME_X_DISPLAY (s->f);
- XRenderComposite (display, s->img->mask_picture ? PictOpOver : PictOpSrc,
- s->img->picture, s->img->mask_picture, destination,
- srcX, srcY,
- srcX, srcY,
- dstX, dstY,
- width, height);
+#ifdef HAVE_XRENDER
+ if (s->img->picture && FRAME_X_PICTURE_FORMAT (s->f))
+ {
+ if (destination == None)
+ {
+ /* The destination picture was not specified. This means we
+ have to create a picture representing the */
+ default_format = FRAME_X_PICTURE_FORMAT (s->f);
+ destination = XRenderCreatePicture (display, dest,
+ default_format, 0, &attr);
+
+ XRenderComposite (display, (s->img->mask_picture
+ ? PictOpOver : PictOpSrc),
+ s->img->picture, s->img->mask_picture,
+ destination, srcX, srcY, srcX, srcY,
+ dstX, dstY, width, height);
+
+ XRenderFreePicture (display, destination);
+ }
+ else
+ XRenderComposite (display, (s->img->mask_picture
+ ? PictOpOver : PictOpSrc),
+ s->img->picture, s->img->mask_picture,
+ destination, srcX, srcY, srcX, srcY,
+ dstX, dstY, width, height);
- XRenderFreePicture (display, destination);
return;
}
#endif
@@ -9629,6 +9694,7 @@ x_composite_image (struct glyph_string *s, Pixmap dest,
srcX, srcY,
width, height, dstX, dstY);
}
+
#endif /* !USE_CAIRO */
@@ -9707,6 +9773,9 @@ x_draw_image_foreground (struct glyph_string *s)
image_rect.height = s->slice.height;
if (gui_intersect_rectangles (&clip_rect, &image_rect, &r))
x_composite_image (s, FRAME_X_DRAWABLE (s->f),
+#ifdef HAVE_XRENDER
+ FRAME_X_PICTURE (s->f),
+#endif
s->slice.x + r.x - x, s->slice.y + r.y - y,
r.x, r.y, r.width, r.height);
}
@@ -9720,7 +9789,12 @@ x_draw_image_foreground (struct glyph_string *s)
image_rect.width = s->slice.width;
image_rect.height = s->slice.height;
if (gui_intersect_rectangles (&clip_rect, &image_rect, &r))
- x_composite_image (s, FRAME_X_DRAWABLE (s->f), s->slice.x + r.x -
x, s->slice.y + r.y - y,
+ x_composite_image (s, FRAME_X_DRAWABLE (s->f),
+#ifdef HAVE_XRENDER
+ FRAME_X_PICTURE (s->f),
+#endif
+ s->slice.x + r.x - x,
+ s->slice.y + r.y - y,
r.x, r.y, r.width, r.height);
/* When the image has a mask, we can expect that at
@@ -9886,8 +9960,11 @@ x_draw_image_foreground_1 (struct glyph_string *s,
Pixmap pixmap)
XChangeGC (display, s->gc, mask, &xgcv);
x_composite_image (s, pixmap,
- s->slice.x, s->slice.y,
- x, y, s->slice.width, s->slice.height);
+#ifdef HAVE_XRENDER
+ None,
+#endif
+ s->slice.x, s->slice.y, x, y,
+ s->slice.width, s->slice.height);
XSetClipMask (display, s->gc, None);
}
else
@@ -10768,6 +10845,7 @@ x_clear_frame (struct frame *f)
/* We have to clear the scroll bars. If we have changed colors or
something like that, then they should be notified. */
x_scroll_bar_clear (f);
+
unblock_input ();
}
@@ -10781,6 +10859,16 @@ x_show_hourglass (struct frame *f)
if (dpy)
{
struct x_output *x = FRAME_X_OUTPUT (f);
+
+ /* If the hourglass window is mapped inside a popup menu, input
+ could be lost if the menu is popped down and the grab is
+ relinquished, but the hourglass window is still up. Just
+ avoid displaying the hourglass at all while popups are
+ active. */
+
+ if (popup_activated ())
+ return;
+
#ifdef USE_X_TOOLKIT
if (x->widget)
#else
@@ -10819,7 +10907,7 @@ x_show_hourglass (struct frame *f)
(xcb_window_t) x->hourglass_window,
parent, 0, 0, FRAME_PIXEL_WIDTH (f),
FRAME_PIXEL_HEIGHT (f), 0,
- XCB_WINDOW_CLASS_INPUT_OUTPUT,
+ XCB_WINDOW_CLASS_INPUT_ONLY,
XCB_COPY_FROM_PARENT, XCB_CW_CURSOR,
&cursor);
#endif
@@ -12758,11 +12846,21 @@ xi_focus_handle_for_device (struct x_display_info
*dpyinfo,
switch (event->evtype)
{
case XI_FocusIn:
+ /* The last-focus-change time of the device changed, so update the
+ frame's user time. */
+ x_display_set_last_user_time (dpyinfo, event->time,
+ event->send_event, true);
+
device->focus_frame = mentioned_frame;
device->focus_frame_time = event->time;
break;
case XI_FocusOut:
+ /* The last-focus-change time of the device changed, so update the
+ frame's user time. */
+ x_display_set_last_user_time (dpyinfo, event->time,
+ event->send_event, false);
+
device->focus_frame = NULL;
/* So, unfortunately, the X Input Extension is implemented such
@@ -13596,6 +13694,43 @@ x_translate_coordinates (struct frame *f, int root_x,
int root_y,
}
}
+/* Translate the given coordinates from the edit window of FRAME,
+ taking into account any cached root window offsets. This is mainly
+ used from the popup menu code. */
+
+void
+x_translate_coordinates_to_root (struct frame *f, int x, int y,
+ int *x_out, int *y_out)
+{
+ struct x_output *output;
+ Window dummy;
+
+ output = FRAME_X_OUTPUT (f);
+
+ if (output->window_offset_certain_p)
+ {
+ /* Use the cached root window offset. */
+ *x_out = x + output->root_x;
+ *y_out = y + output->root_y;
+
+ return;
+ }
+
+ /* Otherwise, do the transform manually and compute and cache the
+ root window position. */
+ if (!XTranslateCoordinates (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ FRAME_DISPLAY_INFO (f)->root_window,
+ x, y, x_out, y_out, &dummy))
+ *x_out = 0, *y_out = 0;
+ else
+ {
+ /* Cache the root window offset of the edit window. */
+ output->window_offset_certain_p = true;
+ output->root_x = *x_out - x;
+ output->root_y = *y_out - y;
+ }
+}
+
/* The same, but for an XIDeviceEvent. */
#ifdef HAVE_XINPUT2
@@ -14143,7 +14278,8 @@ XTmouse_position (struct frame **fp, int insist,
Lisp_Object *bar_window,
< dpyinfo->last_mouse_movement_time))
x_display_set_last_user_time (dpyinfo,
dpyinfo->last_mouse_movement_time,
-
dpyinfo->last_mouse_movement_time_send_event);
+
dpyinfo->last_mouse_movement_time_send_event,
+ true);
if ((!f1 || FRAME_TOOLTIP_P (f1))
&& (EQ (track_mouse, Qdropping)
@@ -14759,7 +14895,8 @@ xg_scroll_callback (GtkRange *range, GtkScrollType
scroll,
dpyinfo = FRAME_DISPLAY_INFO (f);
if (time != GDK_CURRENT_TIME)
- x_display_set_last_user_time (dpyinfo, time, true);
+ x_display_set_last_user_time (dpyinfo, time, true,
+ true);
switch (scroll)
{
@@ -16983,18 +17120,21 @@ x_net_wm_state (struct frame *f, Window window)
/* Flip back buffers on F if it has undrawn content. */
-#ifdef HAVE_XDBE
static void
-flush_dirty_back_buffer_on (struct frame *f)
+x_flush_dirty_back_buffer_on (struct frame *f)
{
- block_input ();
- if (!FRAME_GARBAGED_P (f)
- && !buffer_flipping_blocked_p ()
- && FRAME_X_NEED_BUFFER_FLIP (f))
- show_back_buffer (f);
- unblock_input ();
-}
+#ifdef HAVE_XDBE
+ if (FRAME_GARBAGED_P (f)
+ || buffer_flipping_blocked_p ()
+ /* If the frame is not already up to date, do not flush buffers
+ on input, as that will result in flicker. */
+ || !FRAME_X_COMPLETE_P (f)
+ || !FRAME_X_NEED_BUFFER_FLIP (f))
+ return;
+
+ show_back_buffer (f);
#endif
+}
#ifdef HAVE_GTK3
void
@@ -17748,6 +17888,46 @@ x_handle_wm_state (struct frame *f, struct input_event
*ie)
XFree (data);
}
+#ifdef HAVE_XFIXES
+
+static bool
+x_handle_selection_monitor_event (struct x_display_info *dpyinfo,
+ const XEvent *event)
+{
+ XFixesSelectionNotifyEvent *notify;
+ int i;
+
+ notify = (XFixesSelectionNotifyEvent *) event;
+
+ if (notify->window != dpyinfo->selection_tracking_window)
+ return false;
+
+ for (i = 0; i < dpyinfo->n_monitored_selections; ++i)
+ {
+ /* We don't have to keep track of timestamps here. */
+ if (notify->selection == dpyinfo->monitored_selections[i].name)
+ dpyinfo->monitored_selections[i].owner = notify->owner;
+ }
+
+ return true;
+}
+
+Window
+x_find_selection_owner (struct x_display_info *dpyinfo, Atom selection)
+{
+ int i;
+
+ for (i = 0; i < dpyinfo->n_monitored_selections; ++i)
+ {
+ if (selection == dpyinfo->monitored_selections[i].name)
+ return dpyinfo->monitored_selections[i].owner;
+ }
+
+ return X_INVALID_WINDOW;
+}
+
+#endif
+
/* Handles the XEvent EVENT on display DPYINFO.
*FINISH is X_EVENT_GOTO_OUT if caller should stop reading events.
@@ -17774,7 +17954,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
Time gen_help_time UNINIT;
#endif
ptrdiff_t nbytes = 0;
- struct frame *any, *f = NULL;
+ struct frame *any, *f = NULL, *mouse_frame;
Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight;
/* This holds the state XLookupString needs to implement dead keys
and other tricks known as "compose processing". _X Window System_
@@ -17795,7 +17975,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (dpyinfo->display);
#endif
int dx, dy;
+
+ /* Avoid warnings when SAFE_ALLOCA is not actually used. */
+#if defined HAVE_XINPUT2 || defined HAVE_XKB || defined HAVE_X_I18N
USE_SAFE_ALLOCA;
+#endif
/* This function is not reentrant, so input should be blocked before
it is called. */
@@ -18077,6 +18261,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
/* Not certain about handling scroll bars here */
#endif
+ /* Set the provided time as the user time, which is
+ required for SetInputFocus to work correctly after
+ taking the input focus. */
+ x_display_set_last_user_time (dpyinfo, event->xclient.data.l[1],
+ true, true);
goto done;
}
@@ -19064,7 +19253,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
case KeyPress:
x_display_set_last_user_time (dpyinfo, event->xkey.time,
- event->xkey.send_event);
+ event->xkey.send_event,
+ true);
ignore_next_mouse_click_timeout = 0;
coding = Qlatin_1;
@@ -19092,9 +19282,14 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| !EQ (f->tab_bar_window, hlinfo->mouse_face_window))
)
{
- clear_mouse_face (hlinfo);
- hlinfo->mouse_face_hidden = true;
- }
+ mouse_frame = hlinfo->mouse_face_mouse_frame;
+
+ clear_mouse_face (hlinfo);
+ hlinfo->mouse_face_hidden = true;
+
+ if (mouse_frame)
+ x_flush_dirty_back_buffer_on (mouse_frame);
+ }
#if defined USE_MOTIF && defined USE_TOOLKIT_SCROLL_BARS
if (f == 0)
@@ -19543,7 +19738,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
case EnterNotify:
x_display_set_last_user_time (dpyinfo, event->xcrossing.time,
- event->xcrossing.send_event);
+ event->xcrossing.send_event, false);
#ifdef HAVE_XINPUT2
/* For whatever reason, the X server continues to deliver
@@ -19574,6 +19769,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
clear_mouse_face (hlinfo);
hlinfo->mouse_face_mouse_frame = 0;
+ x_flush_dirty_back_buffer_on (xvw->frame);
}
if (any_help_event_p)
@@ -19666,7 +19862,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
case LeaveNotify:
x_display_set_last_user_time (dpyinfo, event->xcrossing.time,
- event->xcrossing.send_event);
+ event->xcrossing.send_event, false);
#ifdef HAVE_XINPUT2
/* For whatever reason, the X server continues to deliver
@@ -19677,7 +19873,20 @@ handle_one_xevent (struct x_display_info *dpyinfo,
the input extension is enabled. (bug#57468) */
if (dpyinfo->supports_xi2)
- goto OTHER;
+ {
+#if !defined USE_X_TOOLKIT && (!defined USE_GTK || defined HAVE_GTK3)
+ goto OTHER;
+#else
+ /* Unfortunately, X toolkit popups generate LeaveNotify
+ events due to the core grabs they acquire (and our
+ releasing of the device grab). This leads to the mouse
+ face persisting if a popup is activated by clicking on a
+ button, and then dismissed by releasing the mouse button
+ outside the frame, in which case no XI_Enter event is
+ generated for the grab. */
+ goto just_clear_mouse_face;
+#endif
+ }
#endif
#ifdef HAVE_XWIDGETS
@@ -19695,6 +19904,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (x_top_window_to_frame (dpyinfo, event->xcrossing.window))
x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+#if defined HAVE_XINPUT2 \
+ && (defined USE_X_TOOLKIT || (defined USE_GTK && !defined HAVE_GTK3))
+ just_clear_mouse_face:
+#endif
+
#if defined USE_X_TOOLKIT
/* If the mouse leaves the edit widget, then any mouse highlight
should be cleared. */
@@ -19727,6 +19941,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
certainly no longer on any text in the frame. */
clear_mouse_face (hlinfo);
hlinfo->mouse_face_mouse_frame = 0;
+ x_flush_dirty_back_buffer_on (f);
}
/* Generate a nil HELP_EVENT to cancel a help-echo.
@@ -19784,7 +19999,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
help_echo_string = Qnil;
if (hlinfo->mouse_face_hidden)
- {
+ {
hlinfo->mouse_face_hidden = false;
clear_mouse_face (hlinfo);
}
@@ -20115,6 +20330,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (!NILP (help_echo_string)
|| !NILP (previous_help_echo_string))
do_help = 1;
+
+ if (f)
+ x_flush_dirty_back_buffer_on (f);
goto OTHER;
}
@@ -20411,7 +20629,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
int old_left = f->left_pos;
int old_top = f->top_pos;
- Lisp_Object frame = Qnil;
+ Lisp_Object frame;
XSETFRAME (frame, f);
@@ -20481,7 +20699,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
if (event->xbutton.type == ButtonPress)
x_display_set_last_user_time (dpyinfo, event->xbutton.time,
- event->xbutton.send_event);
+ event->xbutton.send_event, true);
#ifdef HAVE_XWIDGETS
struct xwidget_view *xvw = xwidget_view_from_window
(event->xbutton.window);
@@ -20533,7 +20751,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (event->type == ButtonPress)
{
x_display_set_last_user_time (dpyinfo, event->xbutton.time,
- event->xbutton.send_event);
+ event->xbutton.send_event, true);
dpyinfo->grabbed |= (1 << event->xbutton.button);
dpyinfo->last_mouse_frame = f;
@@ -20781,9 +20999,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
tab_bar_p = EQ (window, f->tab_bar_window);
if (tab_bar_p)
- tab_bar_arg = handle_tab_bar_click
- (f, x, y, event->xbutton.type == ButtonPress,
- x_x_to_emacs_modifiers (dpyinfo, event->xbutton.state));
+ {
+ tab_bar_arg = handle_tab_bar_click
+ (f, x, y, event->xbutton.type == ButtonPress,
+ x_x_to_emacs_modifiers (dpyinfo, event->xbutton.state));
+ x_flush_dirty_back_buffer_on (f);
+ }
}
#if ! defined (USE_GTK)
@@ -20801,9 +21022,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| f->last_tool_bar_item != -1));
if (tool_bar_p && event->xbutton.button < 4)
- handle_tool_bar_click
- (f, x, y, event->xbutton.type == ButtonPress,
- x_x_to_emacs_modifiers (dpyinfo, event->xbutton.state));
+ {
+ handle_tool_bar_click
+ (f, x, y, event->xbutton.type == ButtonPress,
+ x_x_to_emacs_modifiers (dpyinfo, event->xbutton.state));
+ x_flush_dirty_back_buffer_on (f);
+ }
}
#endif /* !USE_GTK */
@@ -21090,7 +21314,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
ev.send_event = enter->send_event;
x_display_set_last_user_time (dpyinfo, enter->time,
- enter->send_event);
+ enter->send_event, false);
#ifdef USE_MOTIF
use_copy = true;
@@ -21276,7 +21500,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
x_display_set_last_user_time (dpyinfo, leave->time,
- leave->send_event);
+ leave->send_event, false);
#ifdef HAVE_XWIDGETS
{
@@ -21342,6 +21566,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
certainly no longer on any text in the frame. */
clear_mouse_face (hlinfo);
hlinfo->mouse_face_mouse_frame = 0;
+ x_flush_dirty_back_buffer_on (f);
}
/* Generate a nil HELP_EVENT to cancel a help-echo.
@@ -21551,7 +21776,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
state = xi_convert_event_state (xev);
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
if (found_valuator)
xwidget_scroll (xv, xev->event_x, xev->event_y,
@@ -21571,7 +21796,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (found_valuator)
{
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
#if defined USE_GTK && !defined HAVE_GTK3
@@ -22017,6 +22242,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
do_help = 1;
}
+
+ if (f)
+ x_flush_dirty_back_buffer_on (f);
goto XI_OTHER;
}
@@ -22062,7 +22290,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (xev->evtype == XI_ButtonPress)
{
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
dpyinfo->grabbed |= (1 << xev->detail);
dpyinfo->last_mouse_frame = f;
@@ -22105,7 +22333,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (xev->flags & XIPointerEmulated)
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event,
true);
#endif
x_dnd_note_self_wheel (dpyinfo,
x_dnd_last_seen_window,
@@ -22341,7 +22569,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (xev->evtype == XI_ButtonPress)
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
source = xi_device_from_id (dpyinfo, xev->sourceid);
device = xi_device_from_id (dpyinfo, xev->deviceid);
@@ -22536,9 +22764,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
tab_bar_p = EQ (window, f->tab_bar_window);
if (tab_bar_p)
- tab_bar_arg = handle_tab_bar_click
- (f, x, y, xev->evtype == XI_ButtonPress,
- x_x_to_emacs_modifiers (dpyinfo, bv.state));
+ {
+ tab_bar_arg = handle_tab_bar_click
+ (f, x, y, xev->evtype == XI_ButtonPress,
+ x_x_to_emacs_modifiers (dpyinfo, bv.state));
+ x_flush_dirty_back_buffer_on (f);
+ }
}
#if ! defined (USE_GTK)
@@ -22563,10 +22794,13 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| f->last_tool_bar_item != -1));
if (tool_bar_p && xev->detail < 4)
- handle_tool_bar_click_with_device
- (f, x, y, xev->evtype == XI_ButtonPress,
- x_x_to_emacs_modifiers (dpyinfo, bv.state),
- source ? source->name : Qt);
+ {
+ handle_tool_bar_click_with_device
+ (f, x, y, xev->evtype == XI_ButtonPress,
+ x_x_to_emacs_modifiers (dpyinfo, bv.state),
+ source ? source->name : Qt);
+ x_flush_dirty_back_buffer_on (f);
+ }
}
#endif /* !USE_GTK */
@@ -22720,7 +22954,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
ignore_next_mouse_click_timeout = 0;
f = x_any_window_to_frame (dpyinfo, xev->event);
@@ -22863,8 +23097,13 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| !EQ (f->tab_bar_window, hlinfo->mouse_face_window))
)
{
+ mouse_frame = hlinfo->mouse_face_mouse_frame;
+
clear_mouse_face (hlinfo);
hlinfo->mouse_face_hidden = true;
+
+ if (mouse_frame)
+ x_flush_dirty_back_buffer_on (mouse_frame);
}
if (f != 0)
@@ -23243,7 +23482,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
/* Handle all disabled devices now, to prevent
things happening out-of-order later. */
- if (ndevices)
+ if (n_disabled)
{
xi_disable_devices (dpyinfo, disabled, n_disabled);
n_disabled = 0;
@@ -23359,7 +23598,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
device = xi_device_from_id (dpyinfo, xev->deviceid);
source = xi_device_from_id (dpyinfo, xev->sourceid);
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
if (!device)
goto XI_OTHER;
@@ -23457,7 +23696,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
device = xi_device_from_id (dpyinfo, xev->deviceid);
source = xi_device_from_id (dpyinfo, xev->sourceid);
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
if (!device)
goto XI_OTHER;
@@ -23504,7 +23743,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
device = xi_device_from_id (dpyinfo, xev->deviceid);
source = xi_device_from_id (dpyinfo, xev->sourceid);
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
if (!device)
goto XI_OTHER;
@@ -23545,7 +23784,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
device = xi_device_from_id (dpyinfo, pev->deviceid);
source = xi_device_from_id (dpyinfo, pev->sourceid);
x_display_set_last_user_time (dpyinfo, pev->time,
- pev->send_event);
+ pev->send_event, true);
if (!device)
goto XI_OTHER;
@@ -23648,12 +23887,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
| XkbModifierMapMask
| XkbVirtualModsMask),
dpyinfo->xkb_desc) == Success)
- XkbGetNames (dpyinfo->display,
- XkbGroupNamesMask | XkbVirtualModNamesMask,
+ XkbGetNames (dpyinfo->display, XkbAllNamesMask,
dpyinfo->xkb_desc);
else
{
- XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask,
True);
+ XkbFreeKeyboard (dpyinfo->xkb_desc,
+ XkbAllComponentsMask, True);
dpyinfo->xkb_desc = NULL;
}
}
@@ -23667,8 +23906,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
XkbUseCoreKbd);
if (dpyinfo->xkb_desc)
- XkbGetNames (dpyinfo->display,
- XkbGroupNamesMask | XkbVirtualModNamesMask,
+ XkbGetNames (dpyinfo->display, XkbAllNamesMask,
dpyinfo->xkb_desc);
}
@@ -23958,6 +24196,17 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (inev.ie.kind != NO_EVENT)
x_dnd_update_tooltip_now ();
}
+#endif
+#ifdef HAVE_XFIXES
+ if (dpyinfo->xfixes_supported_p
+ && event->type == (dpyinfo->xfixes_event_base
+ + XFixesSelectionNotify)
+ && x_handle_selection_monitor_event (dpyinfo, event))
+ /* GTK 3 crashes if an XFixesSelectionNotify arrives with a
+ window other than the root window, because it wants to know
+ the screen in order to determine the compositing manager
+ selection name. (bug#58584) */
+ *finish = X_EVENT_DROP;
#endif
OTHER:
#ifdef USE_X_TOOLKIT
@@ -24028,19 +24277,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
count++;
}
- /* Sometimes event processing draws to either F or ANY outside
- redisplay. To ensure that these changes become visible, draw
- them here. */
-
-#ifdef HAVE_XDBE
- if (f)
- flush_dirty_back_buffer_on (f);
-
- if (any && any != f)
- flush_dirty_back_buffer_on (any);
+#if defined HAVE_XINPUT2 || defined HAVE_XKB || defined HAVE_X_I18N
+ SAFE_FREE ();
#endif
- SAFE_FREE ();
return count;
}
@@ -24063,7 +24303,12 @@ x_dispatch_event (XEvent *event, Display *display)
dpyinfo = x_display_info_for_display (display);
if (dpyinfo)
- handle_one_xevent (dpyinfo, event, &finish, 0);
+ {
+ /* Block input before calling x_dispatch_event. */
+ block_input ();
+ handle_one_xevent (dpyinfo, event, &finish, 0);
+ unblock_input ();
+ }
return finish;
}
@@ -25511,6 +25756,47 @@ x_new_font (struct frame *f, Lisp_Object font_object,
int fontset)
#ifdef HAVE_X11R6
+/* HAVE_X11R6 means Xlib conforms to the R6 specification or later.
+ HAVE_X11R6_XIM, OTOH, means that Emacs should try to use R6-style
+ callback driven input method initialization. They are separate
+ because Sun apparently ships buggy Xlib with some versions of
+ Solaris... */
+
+#ifdef HAVE_X11R6_XIM
+
+/* If preedit text is set on F, cancel preedit, free the text, and
+ generate the appropriate events to cancel the preedit display.
+
+ This is mainly useful when the connection to the IM server is
+ dropped during preconversion. */
+
+static void
+x_maybe_clear_preedit (struct frame *f)
+{
+ struct x_output *output;
+ struct input_event ie;
+
+ output = FRAME_X_OUTPUT (f);
+
+ if (!output->preedit_chars)
+ return;
+
+ EVENT_INIT (ie);
+ ie.kind = PREEDIT_TEXT_EVENT;
+ ie.arg = Qnil;
+ XSETFRAME (ie.frame_or_window, f);
+ XSETINT (ie.x, 0);
+ XSETINT (ie.y, 0);
+ kbd_buffer_store_event (&ie);
+
+ xfree (output->preedit_chars);
+
+ output->preedit_size = 0;
+ output->preedit_active = false;
+ output->preedit_chars = NULL;
+ output->preedit_caret = 0;
+}
+
/* XIM destroy callback function, which is called whenever the
connection to input method XIM dies. CLIENT_DATA contains a
pointer to the x_display_info structure corresponding to XIM. */
@@ -25531,6 +25817,9 @@ xim_destroy_callback (XIM xim, XPointer client_data,
XPointer call_data)
{
FRAME_XIC (f) = NULL;
xic_free_xfontset (f);
+
+ /* Free the preedit text if necessary. */
+ x_maybe_clear_preedit (f);
}
}
@@ -25540,6 +25829,8 @@ xim_destroy_callback (XIM xim, XPointer client_data,
XPointer call_data)
unblock_input ();
}
+#endif
+
#endif /* HAVE_X11R6 */
/* Open the connection to the XIM server on display DPYINFO.
@@ -26901,6 +27192,64 @@ xembed_request_focus (struct frame *f)
XEMBED_REQUEST_FOCUS, 0, 0, 0);
}
+static Bool
+server_timestamp_predicate (Display *display, XEvent *xevent,
+ XPointer arg)
+{
+ XID *args = (XID *) arg;
+
+ if (xevent->type == PropertyNotify
+ && xevent->xproperty.window == args[0]
+ && xevent->xproperty.atom == args[1])
+ return True;
+
+ return False;
+}
+
+/* Get the server time. The X server is guaranteed to deliver the
+ PropertyNotify event, so there is no reason to use x_if_event. */
+
+static Time
+x_get_server_time (struct frame *f)
+{
+ Atom property_atom;
+ XEvent property_dummy;
+ struct x_display_info *dpyinfo;
+ XID client_data[2];
+#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME
+ uint_fast64_t current_monotonic_time;
+#endif
+
+ /* If the server time is the same as the monotonic time, avoid a
+ roundtrip by using that instead. */
+
+#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME
+ if (FRAME_DISPLAY_INFO (f)->server_time_monotonic_p)
+ {
+ current_monotonic_time = x_sync_current_monotonic_time ();
+
+ if (current_monotonic_time)
+ /* Truncate the time to CARD32. */
+ return (current_monotonic_time / 1000) & X_ULONG_MAX;
+ }
+#endif
+
+ dpyinfo = FRAME_DISPLAY_INFO (f);
+ property_atom = dpyinfo->Xatom_EMACS_SERVER_TIME_PROP;
+ client_data[0] = FRAME_OUTER_WINDOW (f);
+ client_data[1] = property_atom;
+
+ XChangeProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f),
+ property_atom, XA_ATOM, 32,
+ PropModeReplace,
+ (unsigned char *) &property_atom, 1);
+
+ XIfEvent (dpyinfo->display, &property_dummy,
+ server_timestamp_predicate, (XPointer) client_data);
+
+ return property_dummy.xproperty.time;
+}
+
/* Activate frame with Extended Window Manager Hints */
static void
@@ -26908,6 +27257,7 @@ x_ewmh_activate_frame (struct frame *f)
{
XEvent msg;
struct x_display_info *dpyinfo;
+ Time time;
dpyinfo = FRAME_DISPLAY_INFO (f);
@@ -26928,6 +27278,43 @@ x_ewmh_activate_frame (struct frame *f)
msg.xclient.data.l[3] = 0;
msg.xclient.data.l[4] = 0;
+ /* No frame is currently focused on that display, so apply any
+ bypass for focus stealing prevention that the user has
+ specified. */
+ if (!dpyinfo->x_focus_frame)
+ {
+ if (EQ (Vx_allow_focus_stealing, Qimitate_pager))
+ msg.xclient.data.l[0] = 2;
+ else if (EQ (Vx_allow_focus_stealing, Qnewer_time))
+ {
+ block_input ();
+ time = x_get_server_time (f);
+#ifdef USE_GTK
+ x_set_gtk_user_time (f, time);
+#endif
+ /* Temporarily override dpyinfo->x_focus_frame so the
+ user time property is set on the right window. */
+ dpyinfo->x_focus_frame = f;
+ x_display_set_last_user_time (dpyinfo, time, true, true);
+ dpyinfo->x_focus_frame = NULL;
+ unblock_input ();
+
+ msg.xclient.data.l[1] = time;
+ }
+ else if (EQ (Vx_allow_focus_stealing, Qraise_and_focus))
+ {
+ time = x_get_server_time (f);
+
+ x_ignore_errors_for_next_request (dpyinfo);
+ XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ RevertToParent, time);
+ XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
+ x_stop_ignoring_errors (dpyinfo);
+
+ return;
+ }
+ }
+
XSendEvent (dpyinfo->display, dpyinfo->root_window,
False, (SubstructureRedirectMask
| SubstructureNotifyMask), &msg);
@@ -26961,6 +27348,7 @@ static void
x_focus_frame (struct frame *f, bool noactivate)
{
struct x_display_info *dpyinfo;
+ Time time;
dpyinfo = FRAME_DISPLAY_INFO (f);
@@ -26985,8 +27373,31 @@ x_focus_frame (struct frame *f, bool noactivate)
/* Ignore any BadMatch error this request might result in. */
x_ignore_errors_for_next_request (dpyinfo);
- XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- RevertToParent, CurrentTime);
+ if (NILP (Vx_no_window_manager))
+ {
+ /* Use the last user time. It is invalid to use CurrentTime
+ according to the ICCCM:
+
+ Clients that use a SetInputFocus request must set the
+ time field to the timestamp of the event that caused
+ them to make the attempt. [...] Note that clients must
+ not use CurrentTime in the time field. */
+ time = dpyinfo->last_user_time;
+
+ /* Unless the focus doesn't belong to Emacs anymore and
+ `x-allow-focus-stealing' is set to Qnewer_time. */
+ if (EQ (Vx_allow_focus_stealing, Qnewer_time)
+ && !dpyinfo->x_focus_frame)
+ time = x_get_server_time (f);
+
+ XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ RevertToParent, time);
+ }
+ else
+ XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ /* But when no window manager is in use, we
+ don't care. */
+ RevertToParent, CurrentTime);
x_stop_ignoring_errors (dpyinfo);
}
}
@@ -27930,6 +28341,9 @@ x_wm_set_size_hint (struct frame *f, long flags, bool
user_position)
Window window = FRAME_OUTER_WINDOW (f);
#ifdef USE_X_TOOLKIT
WMShellWidget shell;
+#ifndef USE_MOTIF
+ bool hints_changed;
+#endif
#endif
if (!window)
@@ -27956,10 +28370,14 @@ x_wm_set_size_hint (struct frame *f, long flags, bool
user_position)
shell->wm.size_hints.flags |= USPosition;
}
+#ifndef USE_MOTIF
+ hints_changed
+ = widget_update_wm_size_hints (f->output_data.x->widget,
+ f->output_data.x->edit_widget);
+#else
widget_update_wm_size_hints (f->output_data.x->widget,
f->output_data.x->edit_widget);
-#ifdef USE_MOTIF
/* Do this all over again for the benefit of Motif, which always
knows better than the programmer. */
shell->wm.size_hints.flags &= ~(PPosition | USPosition);
@@ -27970,6 +28388,7 @@ x_wm_set_size_hint (struct frame *f, long flags, bool
user_position)
shell->wm.size_hints.flags &= ~PPosition;
shell->wm.size_hints.flags |= USPosition;
}
+#endif
/* Drill hints into Motif, since it keeps setting its own. */
size_hints.flags = shell->wm.size_hints.flags;
@@ -27987,15 +28406,23 @@ x_wm_set_size_hint (struct frame *f, long flags, bool
user_position)
size_hints.min_aspect.y = shell->wm.size_hints.min_aspect.y;
size_hints.max_aspect.x = shell->wm.size_hints.max_aspect.x;
size_hints.max_aspect.y = shell->wm.size_hints.max_aspect.y;
-#ifdef HAVE_X11XTR6
size_hints.base_width = shell->wm.base_width;
size_hints.base_height = shell->wm.base_height;
size_hints.win_gravity = shell->wm.win_gravity;
-#endif
+#ifdef USE_MOTIF
XSetWMNormalHints (XtDisplay (f->output_data.x->widget),
XtWindow (f->output_data.x->widget),
&size_hints);
+#else
+ /* In many cases, widget_update_wm_size_hints will not have
+ updated the size hints if only flags changed. When that
+ happens, set the WM hints manually. */
+
+ if (!hints_changed)
+ XSetWMNormalHints (XtDisplay (f->output_data.x->widget),
+ XtWindow (f->output_data.x->widget),
+ &size_hints);
#endif
return;
@@ -28410,9 +28837,10 @@ xi_check_toolkit (Display *display)
#endif
-/* Open a connection to X display DISPLAY_NAME, and return
- the structure that describes the open display.
- If we cannot contact the display, return null. */
+/* Open a connection to X display DISPLAY_NAME, and return the
+ structure that describes the open display. If obtaining the XCB
+ connection or toolkit-specific display fails, return NULL. Signal
+ an error if opening the display itself failed. */
struct x_display_info *
x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
@@ -28430,6 +28858,22 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
GdkDisplay *gdpy;
GdkScreen *gscr;
#endif
+#ifdef HAVE_XFIXES
+ Lisp_Object tem, lisp_name;
+ int num_fast_selections;
+ Atom selection_name;
+#ifdef USE_XCB
+ xcb_get_selection_owner_cookie_t *selection_cookies;
+ xcb_get_selection_owner_reply_t *selection_reply;
+ xcb_generic_error_t *selection_error;
+#endif
+#endif
+ int i;
+
+ USE_SAFE_ALLOCA;
+
+ /* Avoid warnings when SAFE_ALLOCA is not actually used. */
+ ((void) SAFE_ALLOCA (0));
block_input ();
@@ -28439,9 +28883,13 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
++x_initialized;
}
- if (! x_display_ok (SSDATA (display_name)))
+#if defined USE_X_TOOLKIT || defined USE_GTK
+
+ if (!x_display_ok (SSDATA (display_name)))
error ("Display %s can't be opened", SSDATA (display_name));
+#endif
+
#ifdef USE_GTK
{
#define NUM_ARGV 10
@@ -28568,13 +29016,24 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
/* Detect failure. */
if (dpy == 0)
{
+#if !defined USE_X_TOOLKIT && !defined USE_GTK
+ /* Avoid opening a display three times (once in dispextern.c
+ upon startup, once in x_display_ok, and once above) to
+ determine whether or not the display is alive on no toolkit
+ builds, where no toolkit initialization happens at all. */
+
+ error ("Display %s can't be opened", SSDATA (display_name));
+#endif
+
unblock_input ();
+
+ SAFE_FREE ();
return 0;
}
#ifdef USE_XCB
xcb_conn = XGetXCBConnection (dpy);
- if (xcb_conn == 0)
+ if (!xcb_conn)
{
#ifdef USE_GTK
xg_display_close (dpy);
@@ -28587,6 +29046,8 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
#endif /* ! USE_GTK */
unblock_input ();
+
+ SAFE_FREE ();
return 0;
}
#endif
@@ -29139,8 +29600,7 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
XkbUseCoreKbd);
if (dpyinfo->xkb_desc)
- XkbGetNames (dpyinfo->display,
- XkbGroupNamesMask | XkbVirtualModNamesMask,
+ XkbGetNames (dpyinfo->display, XkbAllNamesMask,
dpyinfo->xkb_desc);
XkbSelectEvents (dpyinfo->display, XkbUseCoreKbd,
@@ -29150,9 +29610,10 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
#endif
#ifdef HAVE_XFIXES
- int xfixes_event_base, xfixes_error_base;
+ int xfixes_error_base;
dpyinfo->xfixes_supported_p
- = XFixesQueryExtension (dpyinfo->display, &xfixes_event_base,
+ = XFixesQueryExtension (dpyinfo->display,
+ &dpyinfo->xfixes_event_base,
&xfixes_error_base);
if (dpyinfo->xfixes_supported_p)
@@ -29203,7 +29664,6 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
XScreenNumberOfScreen (dpyinfo->screen));
{
- int i;
enum { atom_count = ARRAYELTS (x_atom_refs) };
/* 1 for _XSETTINGS_SN. */
enum { total_atom_count = 2 + atom_count };
@@ -29371,8 +29831,100 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
dpyinfo->protected_windows_max = 256;
#endif
+#ifdef HAVE_XFIXES
+ /* Initialize selection tracking for the selections in
+ x-fast-selection-list. */
+
+ if (CONSP (Vx_fast_selection_list)
+ && dpyinfo->xfixes_supported_p
+ && dpyinfo->xfixes_major >= 1)
+ {
+ num_fast_selections = 0;
+ tem = Vx_fast_selection_list;
+
+ FOR_EACH_TAIL_SAFE (tem)
+ {
+ if (!SYMBOLP (XCAR (tem)))
+ continue;
+
+ num_fast_selections++;
+ }
+
+ dpyinfo->n_monitored_selections = num_fast_selections;
+ dpyinfo->selection_tracking_window
+ = x_create_special_window (dpyinfo, dpyinfo->root_window);
+ dpyinfo->monitored_selections
+ = xmalloc (num_fast_selections
+ * sizeof *dpyinfo->monitored_selections);
+
+ num_fast_selections = 0;
+ tem = Vx_fast_selection_list;
+
+ FOR_EACH_TAIL_SAFE (tem)
+ {
+ lisp_name = XCAR (tem);
+
+ if (!SYMBOLP (lisp_name))
+ continue;
+
+ selection_name = symbol_to_x_atom (dpyinfo, lisp_name);
+ dpyinfo->monitored_selections[num_fast_selections++].name
+ = selection_name;
+ dpyinfo->monitored_selections[num_fast_selections - 1].owner
+ = X_INVALID_WINDOW;
+
+ /* Select for selection input. */
+ XFixesSelectSelectionInput (dpyinfo->display,
+ dpyinfo->selection_tracking_window,
+ selection_name,
+ (XFixesSetSelectionOwnerNotifyMask
+ | XFixesSetSelectionOwnerNotifyMask
+ | XFixesSelectionClientCloseNotifyMask));
+ }
+
+#ifdef USE_XCB
+ selection_cookies = SAFE_ALLOCA (sizeof *selection_cookies
+ * num_fast_selections);
+#endif
+
+ /* Now, ask for the current owners of all those selections. */
+ for (i = 0; i < num_fast_selections; ++i)
+ {
+#ifdef USE_XCB
+ selection_cookies[i]
+ = xcb_get_selection_owner (dpyinfo->xcb_connection,
+ dpyinfo->monitored_selections[i].name);
+#else
+ dpyinfo->monitored_selections[i].owner
+ = XGetSelectionOwner (dpyinfo->display,
+ dpyinfo->monitored_selections[i].name);
+#endif
+ }
+
+#ifdef USE_XCB
+ for (i = 0; i < num_fast_selections; ++i)
+ {
+ selection_reply
+ = xcb_get_selection_owner_reply (dpyinfo->xcb_connection,
+ selection_cookies[i],
+ &selection_error);
+
+ if (selection_reply)
+ {
+ dpyinfo->monitored_selections[i].owner
+ = selection_reply->owner;
+ free (selection_reply);
+ }
+ else if (selection_error)
+ free (selection_error);
+ }
+#endif
+ }
+#endif
+
unblock_input ();
+ SAFE_FREE ();
return dpyinfo;
}
@@ -29508,6 +30060,10 @@ x_delete_display (struct x_display_info *dpyinfo)
xfree (dpyinfo->x_id_name);
xfree (dpyinfo->x_dnd_atoms);
xfree (dpyinfo->color_cells);
+#ifdef HAVE_XFIXES
+ if (dpyinfo->monitored_selections)
+ xfree (dpyinfo->monitored_selections);
+#endif
#ifdef USE_TOOLKIT_SCROLL_BARS
xfree (dpyinfo->protected_windows);
#endif
@@ -29890,7 +30446,7 @@ mark_xterm (void)
{
Lisp_Object val;
#if defined HAVE_XINPUT2 || defined USE_TOOLKIT_SCROLL_BARS \
- || defined HAVE_XRANDR || defined USE_GTK
+ || defined HAVE_XRANDR || defined USE_GTK || defined HAVE_X_I18N
struct x_display_info *dpyinfo;
#if defined HAVE_XINPUT2 || defined USE_TOOLKIT_SCROLL_BARS
int i;
@@ -30114,8 +30670,14 @@ x_get_keyboard_modifiers (struct x_display_info
*dpyinfo)
/* This sometimes happens when the function is called during display
initialization, which can happen while obtaining vendor specific
keysyms. */
+
+#ifdef HAVE_XKB
if (!dpyinfo->xkb_desc && !dpyinfo->modmap)
x_find_modifier_meanings (dpyinfo);
+#else
+ if (!dpyinfo->modmap)
+ x_find_modifier_meanings (dpyinfo);
+#endif
return list5 (make_uint (dpyinfo->hyper_mod_mask),
make_uint (dpyinfo->super_mod_mask),
@@ -30235,6 +30797,9 @@ With MS Windows, Haiku windowing or Nextstep, the value
is t. */);
Fput (Qsuper, Qmodifier_value, make_fixnum (super_modifier));
DEFSYM (QXdndSelection, "XdndSelection");
DEFSYM (Qx_selection_alias_alist, "x-selection-alias-alist");
+ DEFSYM (Qimitate_pager, "imitate-pager");
+ DEFSYM (Qnewer_time, "newer-time");
+ DEFSYM (Qraise_and_focus, "raise-and-focus");
DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym,
doc: /* Which keys Emacs uses for the ctrl modifier.
@@ -30475,4 +31040,43 @@ It should accept a single argument, a string
describing the locale of
the input method, and return a coding system that can decode keyboard
input generated by said input method. */);
Vx_input_coding_function = Qnil;
+
+ DEFVAR_LISP ("x-fast-selection-list", Vx_fast_selection_list,
+ doc: /* List of selections for which `x-selection-exists-p' should be fast.
+
+List of selection names as atoms that will be monitored by Emacs for
+ownership changes when the X server supports the XFIXES extension.
+The result of the monitoring is then used by `x-selection-exists-p' to
+avoid a server round trip, which is important as it is called while
+updating the tool bar. The value of this variable is only read upon
+connection setup. */);
+ /* The default value of this variable is chosen so that updating the
+ tool bar does not require a call to _XReply. */
+ Vx_fast_selection_list = list1 (QCLIPBOARD);
+
+ DEFVAR_LISP ("x-allow-focus-stealing", Vx_allow_focus_stealing,
+ doc: /* How to bypass window manager focus stealing prevention.
+
+Some window managers prevent `x-focus-frame' from activating the given
+frame when Emacs is in the background, which is especially prone to
+cause problems when the Emacs server wants to activate itself.
+
+In addition, when an old-fashioned (pre-EWMH) window manager is being
+run and `x-no-window-manager' is nil, the X server will not let Emacs
+focus itself if another program was focused after the last time Emacs
+obtained the input focus.
+
+This variable specifies the strategy used to activate frames when that
+is the case, and has several valid values (any other value means to
+not bypass window manager focus stealing prevention):
+
+ - The symbol `imitate-pager', which means to pretend that Emacs is a
+ pager.
+
+ - The symbol `newer-time', which means to fetch the current time
+ from the X server and use it to activate the frame.
+
+ - The symbol `raise-and-focus', which means to raise the window and
+ focus it manually. */);
+ Vx_allow_focus_stealing = Qnewer_time;
}
diff --git a/src/xterm.h b/src/xterm.h
index b68a234faa..2967d105ea 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -295,8 +295,7 @@ struct xi_device_t
};
#endif
-Status x_parse_color (struct frame *f, const char *color_name,
- XColor *color);
+extern Status x_parse_color (struct frame *, const char *, XColor *);
struct x_failable_request
{
@@ -308,6 +307,22 @@ struct x_failable_request
unsigned long end;
};
+#ifdef HAVE_XFIXES
+
+struct x_monitored_selection
+{
+ /* The name of the selection. */
+ Atom name;
+
+ /* The current owner of the selection. */
+ Window owner;
+};
+
+/* An invalid window. */
+#define X_INVALID_WINDOW 0xffffffff
+
+#endif
+
/* For each X display, we have a structure that records
information about it. */
@@ -778,6 +793,7 @@ struct x_display_info
bool xfixes_supported_p;
int xfixes_major;
int xfixes_minor;
+ int xfixes_event_base;
#endif
#ifdef HAVE_XSYNC
@@ -828,6 +844,17 @@ struct x_display_info
/* Pointer to the next request in `failable_requests'. */
struct x_failable_request *next_failable_request;
+#ifdef HAVE_XFIXES
+ /* Array of selections being monitored and their owners. */
+ struct x_monitored_selection *monitored_selections;
+
+ /* Window used to monitor those selections. */
+ Window selection_tracking_window;
+
+ /* The number of those selections. */
+ int n_monitored_selections;
+#endif
+
/* The pending drag-and-drop time for middle-click based
drag-and-drop emulation. */
Time pending_dnd_time;
@@ -916,11 +943,6 @@ struct x_output
Picture picture;
#endif
- /* Flag that indicates whether we've modified the back buffer and
- need to publish our modifications to the front buffer at a
- convenient time. */
- bool need_buffer_flip;
-
/* The X window used for the bitmap icon;
or 0 if we don't have a bitmap icon. */
Window icon_desc;
@@ -1091,6 +1113,18 @@ struct x_output
and inactive states. */
bool_bf alpha_identical_p : 1;
+#ifdef HAVE_XDBE
+ /* Flag that indicates whether we've modified the back buffer and
+ need to publish our modifications to the front buffer at a
+ convenient time. */
+ bool_bf need_buffer_flip : 1;
+
+ /* Flag that indicates whether or not the frame contents are
+ complete and can be safely flushed while handling async
+ input. */
+ bool_bf complete : 1;
+#endif
+
#ifdef HAVE_X_I18N
/* Input context (currently, this means Compose key handler setup). */
XIC xic;
@@ -1248,6 +1282,10 @@ extern void x_mark_frame_dirty (struct frame *f);
/* Return the need-buffer-flip flag for frame F. */
#define FRAME_X_NEED_BUFFER_FLIP(f) ((f)->output_data.x->need_buffer_flip)
+
+/* Return whether or not the frame F has been completely drawn. Used
+ while handling async input. */
+#define FRAME_X_COMPLETE_P(f) ((f)->output_data.x->complete)
#endif
/* Return the outermost X window associated with the frame F. */
@@ -1645,6 +1683,10 @@ extern void x_cr_draw_frame (cairo_t *, struct frame *);
extern Lisp_Object x_cr_export_frames (Lisp_Object, cairo_surface_type_t);
#endif
+#ifdef HAVE_XFIXES
+extern Window x_find_selection_owner (struct x_display_info *, Atom);
+#endif
+
#ifdef HAVE_XRENDER
extern void x_xrender_color_from_gc_background (struct frame *, GC,
XRenderColor *, bool);
@@ -1653,6 +1695,8 @@ extern void x_xr_apply_ext_clip (struct frame *, GC);
extern void x_xr_reset_ext_clip (struct frame *);
#endif
+extern void x_translate_coordinates_to_root (struct frame *, int, int,
+ int *, int *);
extern Bool x_query_pointer (Display *, Window, Window *, Window *, int *,
int *, int *, int *, unsigned int *);
diff --git a/test/lisp/apropos-tests.el b/test/lisp/apropos-tests.el
index 289700abf7..917c08b911 100644
--- a/test/lisp/apropos-tests.el
+++ b/test/lisp/apropos-tests.el
@@ -120,14 +120,15 @@
(should (apropos-true-hit "foo bar baz" '("foo" "bar"))))
(ert-deftest apropos-tests-format-plist ()
- (setplist 'foo '(a 1 b (2 3) c nil))
- (apropos-parse-pattern '("b"))
- (should (equal (apropos-format-plist 'foo ", ")
- "a 1, b (2 3), c nil"))
- (should (equal (apropos-format-plist 'foo ", " t)
- "b (2 3)"))
- (apropos-parse-pattern '("d"))
- (should-not (apropos-format-plist 'foo ", " t)))
+ (let ((foo (make-symbol "foo")))
+ (setplist foo '(a 1 b (2 3) c nil))
+ (apropos-parse-pattern '("b"))
+ (should (equal (apropos-format-plist foo ", ")
+ "a 1, b (2 3), c nil"))
+ (should (equal (apropos-format-plist foo ", " t)
+ "b (2 3)"))
+ (apropos-parse-pattern '("d"))
+ (should-not (apropos-format-plist foo ", " t))))
(provide 'apropos-tests)
;;; apropos-tests.el ends here
diff --git a/test/lisp/calendar/icalendar-tests.el
b/test/lisp/calendar/icalendar-tests.el
index 7f8cd47914..2e9353a09b 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -1310,7 +1310,7 @@ SUMMARY:and diary-anniversary
"import-real-world-2003-05-29.diary-european"
"import-real-world-2003-05-29.diary-american")
- ;; created with http://apps.marudot.com/ical/
+ ;; created with https://apps.marudot.com/ical/
(icalendar-tests--test-import "import-real-world-no-dst.ics"
nil
"import-real-world-no-dst.diary-european"
diff --git a/test/lisp/cedet/semantic-utest.el
b/test/lisp/cedet/semantic-utest.el
index 24a467474b..b577b19808 100644
--- a/test/lisp/cedet/semantic-utest.el
+++ b/test/lisp/cedet/semantic-utest.el
@@ -609,7 +609,6 @@ INSERTME is the text to be inserted after the deletion."
(semantic-utest-generic (semantic-utest-fname "phptest.php")
semantic-utest-PHP-buffer-contents semantic-utest-PHP-name-contents '("fun1")
"fun2" "%^@")
)
-;look at http://mfgames.com/linux/csharp-mode
(ert-deftest semantic-utest-Csharp() ;; hmm i don't even know how to edit a
scharp file. need a csharp mode implementation i suppose
(skip-unless (featurep 'csharp-mode))
(semantic-utest-generic (semantic-utest-fname "csharptest.cs")
semantic-utest-Csharp-buffer-contents semantic-utest-Csharp-name-contents
'("fun2") "//1" "//deleted line")
diff --git a/test/lisp/dnd-tests.el b/test/lisp/dnd-tests.el
index 67b660fc12..bdadc0f280 100644
--- a/test/lisp/dnd-tests.el
+++ b/test/lisp/dnd-tests.el
@@ -416,7 +416,7 @@ This function only tries to handle strings."
;; system specific test is in x-dnd-tests.el. When running this
;; interactively, keep in mind that there are only two file managers
;; which are known to implement XDS correctly: System G (see
- ;; http://nps-systemg.sourceforge.net), and Emacs itself. GTK file
+ ;; https://nps-systemg.sourceforge.net), and Emacs itself. GTK file
;; managers such as Nautilus will not work, since they prefer the
;; `text/uri-list' selection target to `XdndDirectSave0', contrary
;; to the XDS specification.
diff --git a/test/lisp/emacs-lisp/bindat-tests.el
b/test/lisp/emacs-lisp/bindat-tests.el
index 0c03c51e2e..2abf714852 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -252,7 +252,24 @@
(should (equal (bindat-unpack spec "abc\0") "abc"))
;; Missing null terminator.
(should-error (bindat-unpack spec ""))
- (should-error (bindat-unpack spec "a"))))
+ (should-error (bindat-unpack spec "a")))
+
+ (ert-deftest bindat-test--strz-array-unpack ()
+ (should (equal (bindat-unpack spec [#x61 #x62 #x63 #x00]) "abc"))))
+
+(let ((spec (bindat-type str 3)))
+ (ert-deftest bindat-test--str-simple-array-unpack ()
+ (should (equal (bindat-unpack spec [#x61 #x62 #x63]) "abc"))))
+
+(let ((spec (bindat-type
+ (first u8)
+ (string str 3)
+ (last uint 16))))
+ (ert-deftest bindat-test--str-combined-array-unpack ()
+ (let ((unpacked (bindat-unpack spec [#xff #x63 #x62 #x61 #xff #xff])))
+ (should (equal (bindat-get-field unpacked 'string) "cba"))
+ (should (equal (bindat-get-field unpacked 'first) (- (expt 2 8) 1)))
+ (should (equal (bindat-get-field unpacked 'last) (- (expt 2 16) 1))))))
(let ((spec '((x strz 2))))
(ert-deftest bindat-test--strz-legacy-fixedlen-len ()
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el
b/test/lisp/emacs-lisp/cl-extra-tests.el
index 297e413d85..6a34cd681e 100644
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -32,8 +32,28 @@
(ert-deftest cl-getf ()
(let ((plist '(x 1 y nil)))
(should (eq (cl-getf plist 'x) 1))
- (should (eq (cl-getf plist 'y :none) nil))
- (should (eq (cl-getf plist 'z :none) :none))))
+ (should-not (cl-getf plist 'y :none))
+ (should (eq (cl-getf plist 'z :none) :none))
+ (should (eq (cl-incf (cl-getf plist 'x 10) 2) 3))
+ (should (equal plist '(x 3 y nil)))
+ (should-error (cl-incf (cl-getf plist 'y 10) 4) :type 'wrong-type-argument)
+ (should (equal plist '(x 3 y nil)))
+ (should (eq (cl-incf (cl-getf plist 'z 10) 5) 15))
+ (should (equal plist '(z 15 x 3 y nil))))
+ (let ((plist '(x 1 y)))
+ (should (eq (cl-getf plist 'x) 1))
+ (should (eq (cl-getf plist 'y :none) :none))
+ (should (eq (cl-getf plist 'z :none) :none))
+ (should (eq (cl-incf (cl-getf plist 'x 10) 2) 3))
+ (should (equal plist '(x 3 y)))
+ (should (eq (cl-incf (cl-getf plist 'y 10) 4) 14))
+ (should (equal plist '(y 14 x 3 y))))
+ (let ((plist '(x 1 y . 2)))
+ (should (eq (cl-getf plist 'x) 1))
+ (should (eq (cl-incf (cl-getf plist 'x 10) 2) 3))
+ (should (equal plist '(x 3 y . 2)))
+ (should-error (cl-getf plist 'y :none) :type 'wrong-type-argument)
+ (should-error (cl-getf plist 'z :none) :type 'wrong-type-argument)))
(ert-deftest cl-extra-test-mapc ()
(let ((lst '(a b c))
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el
b/test/lisp/emacs-lisp/cl-generic-tests.el
index 56b766769e..8e807b1591 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -297,5 +297,27 @@ Edebug symbols (Bug#42672)."
(intern "cl-defgeneric/edebug/method/2 (number)")
'cl-defgeneric/edebug/method/2))))))
+(cl-defgeneric cl-generic-tests--acc (x &optional y)
+ (declare (advertised-calling-convention (x) "671.2")))
+
+(cl-defmethod cl-generic-tests--acc ((x float)) (+ x 5.0))
+
+(ert-deftest cl-generic-tests--advertised-calling-convention-bug58563 ()
+ (should (equal (get-advertised-calling-convention
+ (indirect-function 'cl-generic-tests--acc))
+ '(x)))
+ (should
+ (condition-case err
+ (let ((lexical-binding t)
+ (byte-compile-debug t)
+ (byte-compile-error-on-warn t))
+ (byte-compile '(cl-defmethod cl-generic-tests--acc ((x list))
+ (declare (advertised-calling-convention (y) "1.1"))
+ (cons x '(5 5 5 5 5))))
+ nil)
+ (error
+ (and (eq 'error (car err))
+ (string-match "Stray.*declare" (cadr err)))))))
+
(provide 'cl-generic-tests)
;;; cl-generic-tests.el ends here
diff --git a/test/lisp/emacs-lisp/comp-tests.el
b/test/lisp/emacs-lisp/comp-tests.el
new file mode 100644
index 0000000000..082b641fe3
--- /dev/null
+++ b/test/lisp/emacs-lisp/comp-tests.el
@@ -0,0 +1,77 @@
+;;; comp-tests.el --- Tests for comp.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'comp)
+
+(defvar comp-native-version-dir)
+(defvar native-comp-eln-load-path)
+
+(defmacro with-test-native-compile-prune-cache (&rest body)
+ (declare (indent 0) (debug t))
+ `(ert-with-temp-directory testdir
+ (setq testdir (expand-file-name "eln-cache" testdir))
+ (make-directory testdir)
+ (let* ((c1 (expand-file-name "29.0.50-cur" testdir))
+ (c2 (expand-file-name "29.0.50-old" testdir))
+ (native-comp-eln-load-path (list testdir))
+ (comp-native-version-dir "29.0.50-cur"))
+ (dolist (d (list c1 c2))
+ (make-directory d)
+ (with-temp-file (expand-file-name "some.eln" d) (insert "foo"))
+ (with-temp-file (expand-file-name "some.eln.tmp" d) (insert "foo")))
+ ,@body)))
+
+(ert-deftest test-native-compile-prune-cache ()
+ (skip-unless (featurep 'native-compile))
+ (with-test-native-compile-prune-cache
+ (native-compile-prune-cache)
+ (should (file-directory-p c1))
+ (should (file-regular-p (expand-file-name "some.eln" c1)))
+ (should (file-regular-p (expand-file-name "some.eln.tmp" c1)))
+ (should-not (file-directory-p c2))
+ (should-not (file-regular-p (expand-file-name "some.eln" c2)))
+ (should-not (file-regular-p (expand-file-name "some.eln.tmp" c2)))))
+
+(ert-deftest test-native-compile-prune-cache/delete-only-eln ()
+ (skip-unless (featurep 'native-compile))
+ (with-test-native-compile-prune-cache
+ (with-temp-file (expand-file-name "keep1.txt" c1) (insert "foo"))
+ (with-temp-file (expand-file-name "keep2.txt" c2) (insert "foo"))
+ (native-compile-prune-cache)
+ (should (file-regular-p (expand-file-name "keep1.txt" c1)))
+ (should (file-regular-p (expand-file-name "keep2.txt" c2)))))
+
+(ert-deftest test-native-compile-prune-cache/dont-delete-in-parent-of-cache ()
+ (skip-unless (featurep 'native-compile))
+ (with-test-native-compile-prune-cache
+ (let ((f1 (expand-file-name "../some.eln" testdir))
+ (f2 (expand-file-name "some.eln" testdir)))
+ (with-temp-file f1 (insert "foo"))
+ (with-temp-file f2 (insert "foo"))
+ (native-compile-prune-cache)
+ (should (file-regular-p f1))
+ (should (file-regular-p f2)))))
+
+;;; comp-tests.el ends here
diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el
index 0757e3c7aa..69a7bcf7dd 100644
--- a/test/lisp/emacs-lisp/gv-tests.el
+++ b/test/lisp/emacs-lisp/gv-tests.el
@@ -157,55 +157,42 @@ its getter (Bug#41853)."
(push 123 (gv-setter-edebug-get 'gv-setter-edebug
'gv-setter-edebug-prop))))
(print form (current-buffer)))
- ;; Only check whether evaluation works in general.
- (eval-buffer)))
+ ;; Silence "Edebug: foo" messages.
+ (let ((inhibit-message t))
+ ;; Only check whether evaluation works in general.
+ (eval-buffer))))
(should (equal (get 'gv-setter-edebug 'gv-setter-edebug-prop) '(123))))
(ert-deftest gv-plist-get ()
- (require 'cl-lib)
-
- ;; Simple setf usage for plist-get.
- (should (equal (let ((target '(:a "a" :b "b" :c "c")))
- (setf (plist-get target :b) "modify")
- target)
- '(:a "a" :b "modify" :c "c")))
-
- ;; Other function (cl-rotatef) usage for plist-get.
- (should (equal (let ((target '(:a "a" :b "b" :c "c")))
- (cl-rotatef (plist-get target :b) (plist-get target :c))
- target)
- '(:a "a" :b "c" :c "b")))
-
- ;; Add new key value pair at top of list if setf for missing key.
- (should (equal (let ((target '(:a "a" :b "b" :c "c")))
- (setf (plist-get target :d) "modify")
- target)
- '(:d "modify" :a "a" :b "b" :c "c")))
+ ;; Simple `setf' usage for `plist-get'.
+ (let ((target (list :a "a" :b "b" :c "c")))
+ (setf (plist-get target :b) "modify")
+ (should (equal target '(:a "a" :b "modify" :c "c")))
+ (setf (plist-get target ":a" #'string=) "mogrify")
+ (should (equal target '(:a "mogrify" :b "modify" :c "c"))))
+
+ ;; Other function (`cl-rotatef') usage for `plist-get'.
+ (let ((target (list :a "a" :b "b" :c "c")))
+ (cl-rotatef (plist-get target :b) (plist-get target :c))
+ (should (equal target '(:a "a" :b "c" :c "b")))
+ (cl-rotatef (plist-get target ":a" #'string=)
+ (plist-get target ":b" #'string=))
+ (should (equal target '(:a "c" :b "a" :c "b"))))
+
+ ;; Add new key value pair at top of list if `setf' for missing key.
+ (let ((target (list :a "a" :b "b" :c "c")))
+ (setf (plist-get target :d) "modify")
+ (should (equal target '(:d "modify" :a "a" :b "b" :c "c")))
+ (setf (plist-get target :e #'string=) "mogrify")
+ (should (equal target '(:e "mogrify" :d "modify" :a "a" :b "b" :c "c"))))
;; Rotate with missing value.
;; The value corresponding to the missing key is assumed to be nil.
- (should (equal (let ((target '(:a "a" :b "b" :c "c")))
- (cl-rotatef (plist-get target :b) (plist-get target :d))
- target)
- '(:d "b" :a "a" :b nil :c "c")))
-
- ;; Simple setf usage for plist-get. (symbol plist)
- (should (equal (let ((target '(a "a" b "b" c "c")))
- (setf (plist-get target 'b) "modify")
- target)
- '(a "a" b "modify" c "c")))
-
- ;; Other function (cl-rotatef) usage for plist-get. (symbol plist)
- (should (equal (let ((target '(a "a" b "b" c "c")))
- (cl-rotatef (plist-get target 'b) (plist-get target 'c))
- target)
- '(a "a" b "c" c "b"))))
-
-;; `ert-deftest' messes up macroexpansion when the test file itself is
-;; compiled (see Bug #24402).
-
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+ (let ((target (list :a "a" :b "b" :c "c")))
+ (cl-rotatef (plist-get target :b) (plist-get target :d))
+ (should (equal target '(:d "b" :a "a" :b nil :c "c")))
+ (cl-rotatef (plist-get target ":e" #'string=)
+ (plist-get target ":d" #'string=))
+ (should (equal target '(":e" "b" :d nil :a "a" :b nil :c "c")))))
;;; gv-tests.el ends here
diff --git a/test/lisp/emacs-lisp/map-tests.el
b/test/lisp/emacs-lisp/map-tests.el
index 314a1c9e30..75ebe59431 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -29,10 +29,13 @@
(require 'ert)
(require 'map)
+(eval-when-compile
+ (require 'cl-lib))
+
(defmacro with-maps-do (var &rest body)
"Successively bind VAR to an alist, plist, vector, and hash-table.
Each map is built from the following alist data:
- \\='((0 . 3) (1 . 4) (2 . 5)).
+ ((0 . 3) (1 . 4) (2 . 5))
Evaluate BODY for each created map."
(declare (indent 1) (debug (symbolp body)))
(let ((alist (make-symbol "alist"))
@@ -84,18 +87,96 @@ Evaluate BODY for each created map."
(with-empty-maps-do map
(should (= 5 (map-elt map 0 5)))))
-(ert-deftest test-map-elt-testfn ()
+(ert-deftest test-map-elt-testfn-alist ()
+ "Test the default alist predicate of `map-elt'."
(let* ((a (string ?a))
(map `((,a . 0) (,(string ?b) . 1))))
- (should (= (map-elt map a) 0))
- (should (= (map-elt map "a") 0))
- (should (= (map-elt map (string ?a)) 0))
- (should (= (map-elt map "b") 1))
- (should (= (map-elt map (string ?b)) 1))))
+ (should (= 0 (map-elt map a)))
+ (should (= 0 (map-elt map "a")))
+ (should (= 0 (map-elt map (string ?a))))
+ (should (= 1 (map-elt map "b")))
+ (should (= 1 (map-elt map (string ?b))))
+ (with-suppressed-warnings ((callargs map-elt))
+ (should (= 0 (map-elt map 'a nil #'string=)))
+ (should (= 1 (map-elt map 'b nil #'string=))))))
+
+(ert-deftest test-map-elt-testfn-plist ()
+ "Test the default plist predicate of `map-elt'."
+ (let* ((a (string ?a))
+ (map `(,a 0 "b" 1)))
+ (should-not (map-elt map "a"))
+ (should-not (map-elt map "b"))
+ (should-not (map-elt map (string ?a)))
+ (should-not (map-elt map (string ?b)))
+ (should (= 0 (map-elt map a)))
+ (with-suppressed-warnings ((callargs map-elt))
+ (should (= 0 (map-elt map a nil #'equal)))
+ (should (= 0 (map-elt map "a" nil #'equal)))
+ (should (= 0 (map-elt map (string ?a) nil #'equal)))
+ (should (= 1 (map-elt map "b" nil #'equal)))
+ (should (= 1 (map-elt map (string ?b) nil #'equal))))))
+
+(ert-deftest test-map-elt-gv ()
+ "Test the generalized variable `map-elt'."
+ (let ((sort (lambda (map) (sort (map-pairs map) #'car-less-than-car))))
+ (with-empty-maps-do map
+ ;; Empty map, without default.
+ (should-error (cl-incf (map-elt map 1)) :type 'wrong-type-argument)
+ (with-suppressed-warnings ((callargs map-elt))
+ (should-error (cl-incf (map-elt map 1.0 nil #'=))
+ :type 'wrong-type-argument))
+ (should (map-empty-p map))
+ ;; Empty map, with default.
+ (if (vectorp map)
+ (progn
+ (should-error (cl-incf (map-elt map 1 3)) :type 'args-out-of-range)
+ (with-suppressed-warnings ((callargs map-elt))
+ (should-error (cl-incf (map-elt map 1 3 #'=))
+ :type 'args-out-of-range))
+ (should (map-empty-p map)))
+ (should (= (cl-incf (map-elt map 1 3) 10) 13))
+ (with-suppressed-warnings ((callargs map-elt))
+ (should (= (cl-incf (map-elt map 2.0 5 #'=) 12) 17)))
+ (should (equal (funcall sort map) '((1 . 13) (2.0 . 17))))))
+ (with-maps-do map
+ ;; Nonempty map, without predicate.
+ (should (= (cl-incf (map-elt map 1 3) 10) 14))
+ (should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 5))))
+ ;; Nonempty map, with predicate.
+ (with-suppressed-warnings ((callargs map-elt))
+ (pcase-exhaustive map
+ ((pred consp)
+ (should (= (cl-incf (map-elt map 2.0 6 #'=) 12) 17))
+ (should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 17))))
+ (should (= (cl-incf (map-elt map 0 7 #'=) 13) 16))
+ (should (equal (funcall sort map) '((0 . 16) (1 . 14) (2 . 17)))))
+ ((pred vectorp)
+ (should-error (cl-incf (map-elt map 2.0 6 #'=))
+ :type 'wrong-type-argument)
+ (should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 5))))
+ (should (= (cl-incf (map-elt map 2 6 #'=) 12) 17))
+ (should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 17))))
+ (should (= (cl-incf (map-elt map 0 7 #'=) 13) 16))
+ (should (equal (funcall sort map) '((0 . 16) (1 . 14) (2 . 17)))))
+ ((pred hash-table-p)
+ (should (= (cl-incf (map-elt map 2.0 6 #'=) 12) 18))
+ (should (member (funcall sort map)
+ '(((0 . 3) (1 . 14) (2 . 5) (2.0 . 18))
+ ((0 . 3) (1 . 14) (2.0 . 18) (2 . 5)))))
+ (should (= (cl-incf (map-elt map 0 7 #'=) 13) 16))
+ (should (member (funcall sort map)
+ '(((0 . 16) (1 . 14) (2 . 5) (2.0 . 18))
+ ((0 . 16) (1 . 14) (2.0 . 18) (2 . 5)))))))))))
(ert-deftest test-map-elt-with-nil-value ()
(should-not (map-elt '((a . 1) (b)) 'b 2)))
+(ert-deftest test-map-elt-signature ()
+ "Test that `map-elt' has the right advertised signature.
+See bug#58531#25 and bug#58563."
+ (should (equal (get-advertised-calling-convention (symbol-function 'map-elt))
+ '(map key &optional default))))
+
(ert-deftest test-map-put! ()
(with-maps-do map
(setf (map-elt map 2) 'hello)
@@ -144,6 +225,24 @@ Evaluate BODY for each created map."
(should (equal map '(("a" . 1))))
(should-error (map-put! map (string ?a) val #'eq) :type 'map-not-inplace)))
+(ert-deftest test-map-put!-plist ()
+ "Test `map-put!' predicate on plists."
+ (let* ((a (string ?a))
+ (map (list a 0)))
+ (map-put! map a -1)
+ (should (equal map '("a" -1)))
+ (map-put! map 'a 2)
+ (should (equal map '("a" -1 a 2)))
+ (with-suppressed-warnings ((callargs map-put!))
+ (map-put! map 'a -3 #'string=))
+ (should (equal map '("a" -3 a 2)))))
+
+(ert-deftest test-map-put!-signature ()
+ "Test that `map-put!' has the right advertised signature.
+See bug#58531#25 and bug#58563."
+ (should (equal (get-advertised-calling-convention (symbol-function
'map-put!))
+ '(map key value))))
+
(ert-deftest test-map-put-alist-new-key ()
"Regression test for Bug#23105."
(let ((alist (list (cons 0 'a))))
@@ -395,13 +494,23 @@ Evaluate BODY for each created map."
(alist '(("a" . 1) (a . 2))))
(should (map-contains-key alist 'a))
(should (map-contains-key plist 'a))
+ ;; FIXME: Why is no warning emitted for these (bug#58563#13)?
(should (map-contains-key alist 'a #'eq))
(should (map-contains-key plist 'a #'eq))
(should (map-contains-key alist key))
+ (should (map-contains-key alist "a"))
+ (should (map-contains-key plist (string ?a) #'equal))
(should-not (map-contains-key plist key))
(should-not (map-contains-key alist key #'eq))
(should-not (map-contains-key plist key #'eq))))
+(ert-deftest test-map-contains-key-signature ()
+ "Test that `map-contains-key' has the right advertised signature.
+See bug#58531#25 and bug#58563."
+ (should (equal (get-advertised-calling-convention
+ (symbol-function 'map-contains-key))
+ '(map key))))
+
(ert-deftest test-map-some ()
(with-maps-do map
(should (eq (map-some (lambda (k _v) (and (= k 1) 'found)) map)
@@ -515,19 +624,19 @@ Evaluate BODY for each created map."
(should (equal alist '((key . value))))))
(ert-deftest test-map-setf-alist-overwrite-key ()
- (let ((alist '((key . value1))))
+ (let ((alist (list (cons 'key 'value1))))
(should (equal (setf (map-elt alist 'key) 'value2)
'value2))
(should (equal alist '((key . value2))))))
(ert-deftest test-map-setf-plist-insert-key ()
- (let ((plist '(key value)))
+ (let ((plist (list 'key 'value)))
(should (equal (setf (map-elt plist 'key2) 'value2)
'value2))
(should (equal plist '(key value key2 value2)))))
(ert-deftest test-map-setf-plist-overwrite-key ()
- (let ((plist '(key value)))
+ (let ((plist (list 'key 'value)))
(should (equal (setf (map-elt plist 'key) 'value2)
'value2))
(should (equal plist '(key value2)))))
@@ -535,14 +644,14 @@ Evaluate BODY for each created map."
(ert-deftest test-hash-table-setf-insert-key ()
(let ((ht (make-hash-table)))
(should (equal (setf (map-elt ht 'key) 'value)
- 'value))
+ 'value))
(should (equal (map-elt ht 'key) 'value))))
(ert-deftest test-hash-table-setf-overwrite-key ()
(let ((ht (make-hash-table)))
(puthash 'key 'value1 ht)
(should (equal (setf (map-elt ht 'key) 'value2)
- 'value2))
+ 'value2))
(should (equal (map-elt ht 'key) 'value2))))
(ert-deftest test-setf-map-with-function ()
@@ -551,8 +660,79 @@ Evaluate BODY for each created map."
(setf (map-elt map 'foo)
(funcall (lambda ()
(cl-incf num))))
+ (should (equal map '((foo . 1))))
;; Check that the function is only called once.
(should (= num 1))))
+(ert-deftest test-map-plist-member ()
+ "Test `map--plist-member' and `map--plist-member-1'."
+ (dolist (mem '(map--plist-member map--plist-member-1))
+ ;; Lambda exercises Lisp implementation.
+ (dolist (= `(nil ,(lambda (a b) (eq a b))))
+ (should-not (funcall mem () 'a =))
+ (should-not (funcall mem '(a) 'b =))
+ (should-not (funcall mem '(a 1) 'b =))
+ (should (equal (funcall mem '(a) 'a =) '(a)))
+ (should (equal (funcall mem '(a . 1) 'a =) '(a . 1)))
+ (should (equal (funcall mem '(a 1 . b) 'a =) '(a 1 . b)))
+ (should (equal (funcall mem '(a 1 b) 'a =) '(a 1 b)))
+ (should (equal (funcall mem '(a 1 b) 'b =) '(b)))
+ (should (equal (funcall mem '(a 1 b . 2) 'a =) '(a 1 b . 2)))
+ (should (equal (funcall mem '(a 1 b . 2) 'b =) '(b . 2)))
+ (should (equal (funcall mem '(a 1 b 2) 'a =) '(a 1 b 2)))
+ (should (equal (funcall mem '(a 1 b 2) 'b =) '(b 2)))
+ (should (equal (should-error (funcall mem '(a . 1) 'b =))
+ '(wrong-type-argument plistp (a . 1))))
+ (should (equal (should-error (funcall mem '(a 1 . b) 'b =))
+ '(wrong-type-argument plistp (a 1 . b)))))
+ (should (equal (funcall mem '(a 1 b 2) "a" #'string=) '(a 1 b 2)))
+ (should (equal (funcall mem '(a 1 b 2) "b" #'string=) '(b 2)))))
+
+(ert-deftest test-map-plist-put ()
+ "Test `map--plist-put' and `map--plist-put-1'."
+ (dolist (put '(map--plist-put map--plist-put-1))
+ ;; Lambda exercises Lisp implementation.
+ (dolist (= `(nil ,(lambda (a b) (eq a b))))
+ (let ((l ()))
+ (should (equal (funcall put l 'a 1 =) '(a 1)))
+ (should-not l))
+ (let ((l (list 'a)))
+ (dolist (key '(a b))
+ (should (equal (should-error (funcall put l key 1 =))
+ '(wrong-type-argument plistp (a)))))
+ (should (equal l '(a))))
+ (let ((l (cons 'a 1)))
+ (dolist (key '(a b))
+ (should (equal (should-error (funcall put l key 1 =))
+ '(wrong-type-argument plistp (a . 1)))))
+ (should (equal l '(a . 1))))
+ (let ((l (cons 'a (cons 1 'b))))
+ (should (equal (funcall put l 'a 2 =) '(a 2 . b)))
+ (dolist (key '(b c))
+ (should (equal (should-error (funcall put l key 3 =))
+ '(wrong-type-argument plistp (a 2 . b)))))
+ (should (equal l '(a 2 . b))))
+ (let ((l (list 'a 1 'b)))
+ (should (equal (funcall put l 'a 2 =) '(a 2 b)))
+ (dolist (key '(b c))
+ (should (equal (should-error (funcall put l key 3 =))
+ '(wrong-type-argument plistp (a 2 b)))))
+ (should (equal l '(a 2 b))))
+ (let ((l (cons 'a (cons 1 (cons 'b 2)))))
+ (should (equal (funcall put l 'a 3 =) '(a 3 b . 2)))
+ (dolist (key '(b c))
+ (should (equal (should-error (funcall put l key 4 =))
+ '(wrong-type-argument plistp (a 3 b . 2)))))
+ (should (equal l '(a 3 b . 2))))
+ (let ((l (list 'a 1 'b 2)))
+ (should (equal (funcall put l 'a 3 =) '(a 3 b 2)))
+ (should (equal (funcall put l 'b 4 =) '(a 3 b 4)))
+ (should (equal (funcall put l 'c 5 =) '(a 3 b 4 c 5)))
+ (should (equal l '(a 3 b 4 c 5)))))
+ (let ((l (list 'a 1 'b 2)))
+ (should (equal (funcall put l "a" 3 #'string=) '(a 3 b 2)))
+ (should (equal (funcall put l "b" 4 #'string=) '(a 3 b 4)))
+ (should (equal (funcall put l "c" 5 #'string=) '(a 3 b 4 "c" 5))))))
+
(provide 'map-tests)
;;; map-tests.el ends here
diff --git a/test/lisp/emacs-lisp/package-resources/ustar-withsub-0.1.tar
b/test/lisp/emacs-lisp/package-resources/ustar-withsub-0.1.tar
new file mode 100644
index 0000000000..009c4fc420
Binary files /dev/null and
b/test/lisp/emacs-lisp/package-resources/ustar-withsub-0.1.tar differ
diff --git a/test/lisp/emacs-lisp/package-resources/v7-withsub-0.1.tar
b/test/lisp/emacs-lisp/package-resources/v7-withsub-0.1.tar
new file mode 100644
index 0000000000..16c79e529f
Binary files /dev/null and
b/test/lisp/emacs-lisp/package-resources/v7-withsub-0.1.tar differ
diff --git a/test/lisp/emacs-lisp/package-tests.el
b/test/lisp/emacs-lisp/package-tests.el
index b903cd781b..ffe4d7cd5f 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -275,11 +275,31 @@ Must called from within a `tar-mode' buffer."
(let* ((pkg-el "multi-file-0.2.3.tar")
(source-file (expand-file-name pkg-el (ert-resource-directory))))
- (package-initialize)
(should-not (package-installed-p 'multie-file))
(package-install-file source-file)
(should (package-installed-p 'multi-file))
- (package-delete (cadr (assq 'multi-file package-alist))))
+ (package-delete (cadr (assq 'multi-file package-alist))))))
+
+(ert-deftest package-test-bug58367 ()
+ "Check variations in tarball formats."
+ (with-package-test (:basedir (ert-resource-directory))
+ (package-initialize)
+
+ ;; A package whose first entry is the main dir but without trailing /.
+ (let* ((pkg-el "ustar-withsub-0.1.tar")
+ (source-file (expand-file-name pkg-el (ert-resource-directory))))
+ (should-not (package-installed-p 'ustar-withsub))
+ (package-install-file source-file)
+ (should (package-installed-p 'ustar-withsub))
+ (package-delete (cadr (assq 'ustar-withsub package-alist))))
+
+ ;; A package whose first entry is a file in a subdir.
+ (let* ((pkg-el "v7-withsub-0.1.tar")
+ (source-file (expand-file-name pkg-el (ert-resource-directory))))
+ (should-not (package-installed-p 'v7-withsub))
+ (package-install-file source-file)
+ (should (package-installed-p 'v7-withsub))
+ (package-delete (cadr (assq 'v7-withsub package-alist))))
))
(ert-deftest package-test-install-file-EOLs ()
diff --git a/test/lisp/eshell/esh-ext-tests.el
b/test/lisp/eshell/esh-ext-tests.el
new file mode 100644
index 0000000000..54191e9409
--- /dev/null
+++ b/test/lisp/eshell/esh-ext-tests.el
@@ -0,0 +1,76 @@
+;;; esh-ext-tests.el --- esh-ext test suite -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for Eshell's external command handling.
+
+;;; Code:
+
+(require 'ert)
+(require 'esh-mode)
+(require 'esh-ext)
+(require 'eshell)
+
+(require 'eshell-tests-helpers
+ (expand-file-name "eshell-tests-helpers"
+ (file-name-directory (or load-file-name
+ default-directory))))
+
+;;; Tests:
+
+(ert-deftest esh-ext-test/addpath/end ()
+ "Test that \"addpath\" adds paths to the end of $PATH."
+ (with-temp-eshell
+ (let ((eshell-path-env-list '("/some/path" "/other/path"))
+ (expected-path (string-join '("/some/path" "/other/path" "/new/path"
+ "/new/path2")
+ (path-separator))))
+ (eshell-match-command-output "addpath /new/path /new/path2"
+ (concat expected-path "\n"))
+ (eshell-match-command-output "echo $PATH"
+ (concat expected-path "\n")))))
+
+(ert-deftest esh-ext-test/addpath/begin ()
+ "Test that \"addpath -b\" adds paths to the beginning of $PATH."
+ (with-temp-eshell
+ (let ((eshell-path-env-list '("/some/path" "/other/path"))
+ (expected-path (string-join '("/new/path" "/new/path2" "/some/path"
+ "/other/path")
+ (path-separator))))
+ (eshell-match-command-output "addpath -b /new/path /new/path2"
+ (concat expected-path "\n"))
+ (eshell-match-command-output "echo $PATH"
+ (concat expected-path "\n")))))
+
+(ert-deftest esh-ext-test/addpath/set-locally ()
+ "Test adding to the path temporarily in a subcommand."
+ (let* ((eshell-path-env-list '("/some/path" "/other/path"))
+ (original-path (string-join eshell-path-env-list (path-separator)))
+ (local-path (string-join (append eshell-path-env-list '("/new/path"))
+ (path-separator))))
+ (with-temp-eshell
+ (eshell-match-command-output
+ "{ addpath /new/path; env }"
+ (format "PATH=%s\n" (regexp-quote local-path)))
+ ;; After the last command, the previous $PATH value should be restored.
+ (eshell-match-command-output "echo $PATH"
+ (concat original-path "\n")))))
+
+;; esh-ext-tests.el ends here
diff --git a/test/lisp/eshell/esh-var-tests.el
b/test/lisp/eshell/esh-var-tests.el
index cb5b1766bb..d9b2585a32 100644
--- a/test/lisp/eshell/esh-var-tests.el
+++ b/test/lisp/eshell/esh-var-tests.el
@@ -23,8 +23,10 @@
;;; Code:
+(require 'tramp)
(require 'ert)
(require 'esh-mode)
+(require 'esh-var)
(require 'eshell)
(require 'eshell-tests-helpers
@@ -440,6 +442,150 @@ inside double-quotes"
"000"))
+;; Variable-related commands
+
+(ert-deftest esh-var-test/set/env-var ()
+ "Test that `set' with a string variable name sets an environment variable."
+ (with-temp-eshell
+ (eshell-match-command-output "set VAR hello" "hello\n")
+ (should (equal (getenv "VAR") "hello")))
+ (should-not (equal (getenv "VAR") "hello")))
+
+(ert-deftest esh-var-test/set/symbol ()
+ "Test that `set' with a symbol variable name sets a Lisp variable."
+ (let (eshell-test-value)
+ (eshell-command-result-equal "set #'eshell-test-value hello"
+ "hello")
+ (should (equal eshell-test-value "hello"))))
+
+(ert-deftest esh-var-test/unset/env-var ()
+ "Test that `unset' with a string variable name unsets an env var."
+ (let ((process-environment (cons "VAR=value" process-environment)))
+ (with-temp-eshell
+ (eshell-match-command-output "unset VAR" "\\`\\'")
+ (should (equal (getenv "VAR") nil)))
+ (should (equal (getenv "VAR") "value"))))
+
+(ert-deftest esh-var-test/unset/symbol ()
+ "Test that `unset' with a symbol variable name unsets a Lisp variable."
+ (let ((eshell-test-value "value"))
+ (eshell-command-result-equal "unset #'eshell-test-value" nil)
+ (should (equal eshell-test-value nil))))
+
+(ert-deftest esh-var-test/setq ()
+ "Test that `setq' sets Lisp variables."
+ (let (eshell-test-value)
+ (eshell-command-result-equal "setq eshell-test-value hello"
+ "hello")
+ (should (equal eshell-test-value "hello"))))
+
+(ert-deftest esh-var-test/export ()
+ "Test that `export' sets environment variables."
+ (with-temp-eshell
+ (eshell-match-command-output "export VAR=hello" "\\`\\'")
+ (should (equal (getenv "VAR") "hello"))))
+
+(ert-deftest esh-var-test/local-variables ()
+ "Test that \"VAR=value command\" temporarily sets variables."
+ (with-temp-eshell
+ (push "VAR=value" process-environment)
+ (eshell-match-command-output "VAR=hello env" "VAR=hello\n")
+ (should (equal (getenv "VAR") "value"))))
+
+
+;; Variable aliases
+
+(ert-deftest esh-var-test/alias/function ()
+ "Test using a variable alias defined as a function."
+ (with-temp-eshell
+ (push `("ALIAS" ,(lambda () "value") nil t) eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "value\n")
+ (eshell-match-command-output "set ALIAS hello"
+ "Variable `ALIAS' is not settable\n"
+ nil t)))
+
+(ert-deftest esh-var-test/alias/function-pair ()
+ "Test using a variable alias defined as a pair of getter/setter functions."
+ (with-temp-eshell
+ (let ((eshell-test-value "value"))
+ (push `("ALIAS" (,(lambda () eshell-test-value)
+ . (lambda (_ value)
+ (setq eshell-test-value (upcase value))))
+ nil t)
+ eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "value\n")
+ (eshell-match-command-output "set ALIAS hello" "HELLO\n")
+ (should (equal eshell-test-value "HELLO")))))
+
+(ert-deftest esh-var-test/alias/string ()
+ "Test using a variable alias defined as a string.
+This should get/set the aliased environment variable."
+ (with-temp-eshell
+ (let ((eshell-test-value "lisp-value"))
+ (push "eshell-test-value=env-value" process-environment)
+ (push `("ALIAS" "eshell-test-value") eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "env-value\n")
+ (eshell-match-command-output "set ALIAS hello" "hello\n")
+ (should (equal (getenv "eshell-test-value") "hello"))
+ (should (equal eshell-test-value "lisp-value")))))
+
+(ert-deftest esh-var-test/alias/string/prefer-lisp ()
+ "Test using a variable alias defined as a string.
+This sets `eshell-prefer-lisp-variables' to t and should get/set
+the aliased Lisp variable."
+ (with-temp-eshell
+ (let ((eshell-test-value "lisp-value")
+ (eshell-prefer-lisp-variables t))
+ (push "eshell-test-value=env-value" process-environment)
+ (push `("ALIAS" "eshell-test-value") eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "lisp-value\n")
+ (eshell-match-command-output "set ALIAS hello" "hello\n")
+ (should (equal (car process-environment) "eshell-test-value=env-value"))
+ (should (equal eshell-test-value "hello")))))
+
+(ert-deftest esh-var-test/alias/symbol ()
+ "Test using a variable alias defined as a symbol.
+This should get/set the value bound to the symbol."
+ (with-temp-eshell
+ (let ((eshell-test-value "value"))
+ (push '("ALIAS" eshell-test-value) eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "value\n")
+ (eshell-match-command-output "set ALIAS hello" "hello\n")
+ (should (equal eshell-test-value "hello")))))
+
+(ert-deftest esh-var-test/alias/symbol-pair ()
+ "Test using a variable alias defined as a pair of symbols.
+This should get the value bound to the symbol, but fail to set
+it, since the setter is nil."
+ (with-temp-eshell
+ (let ((eshell-test-value "value"))
+ (push '("ALIAS" (eshell-test-value . nil)) eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "value\n")
+ (eshell-match-command-output "set ALIAS hello"
+ "Variable `ALIAS' is not settable\n"
+ nil t))))
+
+(ert-deftest esh-var-test/alias/export ()
+ "Test that `export' properly sets variable aliases."
+ (with-temp-eshell
+ (let ((eshell-test-value "value"))
+ (push `("ALIAS" (,(lambda () eshell-test-value)
+ . (lambda (_ value) (setq eshell-test-value value)))
+ nil t)
+ eshell-variable-aliases-list)
+ (eshell-match-command-output "export ALIAS=hello" "\\`\\'")
+ (should (equal eshell-test-value "hello")))))
+
+(ert-deftest esh-var-test/alias/local-variables ()
+ "Test that \"VAR=value cmd\" temporarily sets read-only variable aliases."
+ (with-temp-eshell
+ (let ((eshell-test-value "value"))
+ (push `("ALIAS" ,(lambda () eshell-test-value) t t)
+ eshell-variable-aliases-list)
+ (eshell-match-command-output "ALIAS=hello env" "ALIAS=hello\n")
+ (should (equal eshell-test-value "value")))))
+
+
;; Built-in variables
(ert-deftest esh-var-test/lines-var ()
@@ -465,6 +611,65 @@ inside double-quotes"
(eshell-match-command-output "echo $INSIDE_EMACS[, 1]"
"eshell")))
+(ert-deftest esh-var-test/path-var/local-directory ()
+ "Test using $PATH in a local directory."
+ (let ((expected-path (string-join (eshell-get-path t) (path-separator))))
+ (with-temp-eshell
+ (eshell-match-command-output "echo $PATH" (regexp-quote expected-path)))))
+
+(ert-deftest esh-var-test/path-var/remote-directory ()
+ "Test using $PATH in a remote directory."
+ (skip-unless (eshell-tests-remote-accessible-p))
+ (let* ((default-directory ert-remote-temporary-file-directory)
+ (expected-path (string-join (eshell-get-path t) (path-separator))))
+ (with-temp-eshell
+ (eshell-match-command-output "echo $PATH" (regexp-quote expected-path)))))
+
+(ert-deftest esh-var-test/path-var/set ()
+ "Test setting $PATH."
+ (let* ((path-to-set-list '("/some/path" "/other/path"))
+ (path-to-set (string-join path-to-set-list (path-separator))))
+ (with-temp-eshell
+ (eshell-match-command-output (concat "set PATH " path-to-set)
+ (concat path-to-set "\n"))
+ (eshell-match-command-output "echo $PATH" (concat path-to-set "\n"))
+ (should (equal (eshell-get-path t) path-to-set-list)))))
+
+(ert-deftest esh-var-test/path-var/set-locally ()
+ "Test setting $PATH temporarily for a single command."
+ (let* ((path-to-set-list '("/some/path" "/other/path"))
+ (path-to-set (string-join path-to-set-list (path-separator))))
+ (with-temp-eshell
+ (eshell-match-command-output (concat "set PATH " path-to-set)
+ (concat path-to-set "\n"))
+ (eshell-match-command-output "PATH=/local/path env"
+ "PATH=/local/path\n")
+ ;; After the last command, the previous $PATH value should be restored.
+ (eshell-match-command-output "echo $PATH" (concat path-to-set "\n"))
+ (should (equal (eshell-get-path t) path-to-set-list)))))
+
+(ert-deftest esh-var-test/path-var/preserve-across-hosts ()
+ "Test that $PATH can be set independently on multiple hosts."
+ (let ((local-directory default-directory)
+ local-path remote-path)
+ (with-temp-eshell
+ ;; Set the $PATH on localhost.
+ (eshell-insert-command "set PATH /local/path")
+ (setq local-path (eshell-last-output))
+ ;; `cd' to a remote host and set the $PATH there too.
+ (eshell-insert-command
+ (format "cd %s" ert-remote-temporary-file-directory))
+ (eshell-insert-command "set PATH /remote/path")
+ (setq remote-path (eshell-last-output))
+ ;; Return to localhost and check that $PATH is the value we set
+ ;; originally.
+ (eshell-insert-command (format "cd %s" local-directory))
+ (eshell-match-command-output "echo $PATH" (regexp-quote local-path))
+ ;; ... and do the same for the remote host.
+ (eshell-insert-command
+ (format "cd %s" ert-remote-temporary-file-directory))
+ (eshell-match-command-output "echo $PATH" (regexp-quote remote-path)))))
+
(ert-deftest esh-var-test/last-status-var-lisp-command ()
"Test using the \"last exit status\" ($?) variable with a Lisp command"
(with-temp-eshell
@@ -472,9 +677,8 @@ inside double-quotes"
"t\n0\n")
(eshell-match-command-output "zerop 1; echo $?"
"0\n")
- (let ((debug-on-error nil))
- (eshell-match-command-output "zerop foo; echo $?"
- "1\n"))))
+ (eshell-match-command-output "zerop foo; echo $?"
+ "1\n" nil t)))
(ert-deftest esh-var-test/last-status-var-lisp-form ()
"Test using the \"last exit status\" ($?) variable with a Lisp form"
@@ -484,9 +688,8 @@ inside double-quotes"
"t\n0\n")
(eshell-match-command-output "(zerop 1); echo $?"
"2\n")
- (let ((debug-on-error nil))
- (eshell-match-command-output "(zerop \"foo\"); echo $?"
- "1\n")))))
+ (eshell-match-command-output "(zerop \"foo\"); echo $?"
+ "1\n" nil t))))
(ert-deftest esh-var-test/last-status-var-lisp-form-2 ()
"Test using the \"last exit status\" ($?) variable with a Lisp form.
@@ -497,9 +700,8 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
"0\n")
(eshell-match-command-output "(zerop 0); echo $?"
"0\n")
- (let ((debug-on-error nil))
- (eshell-match-command-output "(zerop \"foo\"); echo $?"
- "1\n")))))
+ (eshell-match-command-output "(zerop \"foo\"); echo $?"
+ "1\n" nil t))))
(ert-deftest esh-var-test/last-status-var-ext-cmd ()
"Test using the \"last exit status\" ($?) variable with an external command"
diff --git a/test/lisp/eshell/eshell-tests-helpers.el
b/test/lisp/eshell/eshell-tests-helpers.el
index 73abfcbb55..1d9674070c 100644
--- a/test/lisp/eshell/eshell-tests-helpers.el
+++ b/test/lisp/eshell/eshell-tests-helpers.el
@@ -31,11 +31,22 @@
(require 'eshell)
(defvar eshell-history-file-name nil)
+(defvar eshell-last-dir-ring-file-name nil)
(defvar eshell-test--max-subprocess-time 5
"The maximum amount of time to wait for a subprocess to finish, in seconds.
See `eshell-wait-for-subprocess'.")
+(defun eshell-tests-remote-accessible-p ()
+ "Return if a test involving remote files can proceed.
+If using this function, be sure to load `tramp' near the
+beginning of the test file."
+ (ignore-errors
+ (and
+ (file-remote-p ert-remote-temporary-file-directory)
+ (file-directory-p ert-remote-temporary-file-directory)
+ (file-writable-p ert-remote-temporary-file-directory))))
+
(defmacro with-temp-eshell (&rest body)
"Evaluate BODY in a temporary Eshell buffer."
`(save-current-buffer
@@ -44,6 +55,7 @@ See `eshell-wait-for-subprocess'.")
;; back on $HISTFILE.
(process-environment (cons "HISTFILE" process-environment))
(eshell-history-file-name nil)
+ (eshell-last-dir-ring-file-name nil)
(eshell-buffer (eshell t)))
(unwind-protect
(with-current-buffer eshell-buffer
@@ -83,26 +95,39 @@ After inserting, call FUNC. If FUNC is nil, instead call
(insert-and-inherit command)
(funcall (or func 'eshell-send-input)))
+(defun eshell-last-input ()
+ "Return the input of the last Eshell command."
+ (buffer-substring-no-properties
+ eshell-last-input-start eshell-last-input-end))
+
+(defun eshell-last-output ()
+ "Return the output of the last Eshell command."
+ (buffer-substring-no-properties
+ (eshell-beginning-of-output) (eshell-end-of-output)))
+
(defun eshell-match-output (regexp)
"Test whether the output of the last command matches REGEXP."
- (string-match-p
- regexp (buffer-substring-no-properties
- (eshell-beginning-of-output) (eshell-end-of-output))))
+ (string-match-p regexp (eshell-last-output)))
(defun eshell-match-output--explainer (regexp)
"Explain the result of `eshell-match-output'."
`(mismatched-output
- (command ,(buffer-substring-no-properties
- eshell-last-input-start eshell-last-input-end))
- (output ,(buffer-substring-no-properties
- (eshell-beginning-of-output) (eshell-end-of-output)))
+ (command ,(eshell-last-input))
+ (output ,(eshell-last-output))
(regexp ,regexp)))
(put 'eshell-match-output 'ert-explainer #'eshell-match-output--explainer)
-(defun eshell-match-command-output (command regexp &optional func)
- "Insert a COMMAND at the end of the buffer and match the output with REGEXP."
- (eshell-insert-command command func)
+(defun eshell-match-command-output (command regexp &optional func
+ ignore-errors)
+ "Insert a COMMAND at the end of the buffer and match the output with REGEXP.
+FUNC is the function to call after inserting the text (see
+`eshell-insert-command').
+
+If IGNORE-ERRORS is non-nil, ignore any errors signaled when
+inserting the command."
+ (let ((debug-on-error (and (not ignore-errors) debug-on-error)))
+ (eshell-insert-command command func))
(eshell-wait-for-subprocess)
(should (eshell-match-output regexp)))
diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el
index 7ee2f0c1a6..b1555a0266 100644
--- a/test/lisp/files-x-tests.el
+++ b/test/lisp/files-x-tests.el
@@ -23,6 +23,7 @@
(require 'ert)
(require 'files-x)
+(require 'tramp-integration)
(defconst files-x-test--variables1
'((remote-shell-file-name . "/bin/bash")
@@ -35,16 +36,20 @@
'((remote-null-device . "/dev/null")))
(defconst files-x-test--variables4
'((remote-null-device . "null")))
+(defconst files-x-test--variables5
+ '((remote-lazy-var . nil)
+ (remote-null-device . "/dev/null")))
(defvar remote-null-device)
+(defvar remote-lazy-var nil)
(put 'remote-shell-file-name 'safe-local-variable #'identity)
(put 'remote-shell-command-switch 'safe-local-variable #'identity)
(put 'remote-shell-interactive-switch 'safe-local-variable #'identity)
(put 'remote-shell-login-switch 'safe-local-variable #'identity)
(put 'remote-null-device 'safe-local-variable #'identity)
-(defconst files-x-test--application '(:application 'my-application))
+(defconst files-x-test--application '(:application my-application))
(defconst files-x-test--another-application
- '(:application 'another-application))
+ '(:application another-application))
(defconst files-x-test--protocol '(:protocol "my-protocol"))
(defconst files-x-test--user '(:user "my-user"))
(defconst files-x-test--machine '(:machine "my-machine"))
@@ -91,6 +96,28 @@
(connection-local-get-profile-variables 'remote-nullfile)
files-x-test--variables4))))
+(ert-deftest files-x-test-connection-local-update-profile-variables ()
+ "Test updating connection-local profile variables."
+
+ ;; Declare (PROFILE VARIABLES) objects.
+ (let (connection-local-profile-alist connection-local-criteria-alist)
+ (connection-local-set-profile-variables
+ 'remote-bash (copy-alist files-x-test--variables1))
+ (should
+ (equal
+ (connection-local-get-profile-variables 'remote-bash)
+ files-x-test--variables1))
+
+ ;; Updating overwrites only the values specified in this call, but
+ ;; retains all the other values from previous calls.
+ (connection-local-update-profile-variables
+ 'remote-bash files-x-test--variables2)
+ (should
+ (equal
+ (connection-local-get-profile-variables 'remote-bash)
+ (cons (car files-x-test--variables2)
+ (cdr files-x-test--variables1))))))
+
(ert-deftest files-x-test-connection-local-set-profiles ()
"Test setting connection-local profiles."
@@ -233,9 +260,12 @@
(nreverse (copy-tree files-x-test--variables2)))))
;; The variables exist also as local variables.
(should (local-variable-p 'remote-shell-file-name))
+ (should (local-variable-p 'remote-null-device))
;; The proper variable value is set.
(should
- (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh"))))
+ (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh"))
+ (should
+ (string-equal (symbol-value 'remote-null-device) "/dev/null"))))
;; The third test case. Both criteria `files-x-test--criteria1'
;; and `files-x-test--criteria2' apply, but there are no double
@@ -274,13 +304,11 @@
(should-not (local-variable-p 'remote-shell-file-name))
(should-not (boundp 'remote-shell-file-name))))))
-(defvar tramp-connection-local-default-shell-variables)
-(defvar tramp-connection-local-default-system-variables)
-
(ert-deftest files-x-test-with-connection-local-variables ()
"Test setting connection-local variables."
- (let (connection-local-profile-alist connection-local-criteria-alist)
+ (let ((connection-local-profile-alist connection-local-profile-alist)
+ (connection-local-criteria-alist connection-local-criteria-alist))
(connection-local-set-profile-variables
'remote-bash files-x-test--variables1)
(connection-local-set-profile-variables
@@ -291,29 +319,6 @@
(connection-local-set-profiles
nil 'remote-ksh 'remote-nullfile)
- (with-temp-buffer
- (let ((enable-connection-local-variables t))
- (hack-connection-local-variables-apply nil)
-
- ;; All connection-local variables are set. They apply in
- ;; reverse order in `connection-local-variables-alist'.
- (should
- (equal connection-local-variables-alist
- (append
- (nreverse (copy-tree files-x-test--variables3))
- (nreverse (copy-tree files-x-test--variables2)))))
- ;; The variables exist also as local variables.
- (should (local-variable-p 'remote-shell-file-name))
- (should (local-variable-p 'remote-null-device))
- ;; The proper variable values are set.
- (should
- (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh"))
- (should
- (string-equal (symbol-value 'remote-null-device) "/dev/null"))
-
- ;; A candidate connection-local variable is not bound yet.
- (should-not (local-variable-p 'remote-shell-command-switch))))
-
(with-temp-buffer
;; Use the macro. We need a remote `default-directory'.
(let ((enable-connection-local-variables t)
@@ -331,18 +336,18 @@
(with-connection-local-variables
;; All connection-local variables are set. They apply in
;; reverse order in `connection-local-variables-alist'.
- ;; Since we ha a remote default directory, Tramp's settings
+ ;; Since we have a remote default directory, Tramp's settings
;; are appended as well.
(should
(equal
connection-local-variables-alist
(append
- (nreverse (copy-tree files-x-test--variables3))
- (nreverse (copy-tree files-x-test--variables2))
(nreverse
(copy-tree tramp-connection-local-default-shell-variables))
(nreverse
- (copy-tree tramp-connection-local-default-system-variables)))))
+ (copy-tree tramp-connection-local-default-system-variables))
+ (nreverse (copy-tree files-x-test--variables3))
+ (nreverse (copy-tree files-x-test--variables2)))))
;; The variables exist also as local variables.
(should (local-variable-p 'remote-shell-file-name))
(should (local-variable-p 'remote-null-device))
@@ -352,15 +357,21 @@
(should
(string-equal (symbol-value 'remote-null-device) "/dev/null"))
- ;; Run another instance of `with-connection-local-variables'
- ;; with a different application.
- (let ((connection-local-default-application (cadr
files-x-test--application)))
- (with-connection-local-variables
- ;; The proper variable values are set.
- (should
- (string-equal (symbol-value 'remote-shell-file-name) "/bin/bash"))
- (should
- (string-equal (symbol-value 'remote-null-device) "/dev/null"))))
+ ;; Run `with-connection-local-application-variables' to use a
+ ;; different application.
+ (with-connection-local-application-variables
+ (cadr files-x-test--application)
+ (should
+ (equal
+ connection-local-variables-alist
+ (append
+ (nreverse (copy-tree files-x-test--variables3))
+ (nreverse (copy-tree files-x-test--variables1)))))
+ ;; The proper variable values are set.
+ (should
+ (string-equal (symbol-value 'remote-shell-file-name) "/bin/bash"))
+ (should
+ (string-equal (symbol-value 'remote-null-device) "/dev/null")))
;; The variable values are reset.
(should
(string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh"))
@@ -376,5 +387,60 @@
(should-not (boundp 'remote-shell-file-name))
(should (string-equal (symbol-value 'remote-null-device) "null"))))))
+(defun files-x-test--get-lazy-var ()
+ "Get the connection-local value of `remote-lazy-var'.
+If it's not initialized yet, initialize it."
+ (with-connection-local-application-variables
+ (cadr files-x-test--application)
+ (or remote-lazy-var
+ (setq-connection-local remote-lazy-var
+ (or (file-remote-p default-directory 'host)
+ "local")))))
+
+(defun files-x-test--set-lazy-var (value)
+ "Set the connection-local value of `remote-lazy-var'"
+ (with-connection-local-application-variables
+ (cadr files-x-test--application)
+ (setq-connection-local remote-lazy-var value)))
+
+(ert-deftest files-x-test-setq-connection-local ()
+ "Test dynamically setting connection local variables."
+ (let (connection-local-profile-alist connection-local-criteria-alist)
+ (connection-local-set-profile-variables
+ 'remote-lazy files-x-test--variables5)
+ (connection-local-set-profiles
+ files-x-test--application
+ 'remote-lazy)
+
+ ;; Test the initial local value.
+ (should (equal (files-x-test--get-lazy-var) "local"))
+
+ ;; Set the local value and make sure it retains the value we set.
+ (should (equal (files-x-test--set-lazy-var "here") "here"))
+ (should (equal (files-x-test--get-lazy-var) "here"))
+
+ (let ((default-directory "/method:host:"))
+ ;; Test the initial remote value.
+ (should (equal (files-x-test--get-lazy-var) "host"))
+
+ ;; Set the remote value and make sure it retains the value we set.
+ (should (equal (files-x-test--set-lazy-var "there") "there"))
+ (should (equal (files-x-test--get-lazy-var) "there"))
+ ;; Set another connection-local variable.
+ (with-connection-local-application-variables
+ (cadr files-x-test--application)
+ (setq-connection-local remote-null-device "null")))
+
+ ;; Make sure we get the local value we set above.
+ (should (equal (files-x-test--get-lazy-var) "here"))
+ (should-not (boundp 'remote-null-device))
+
+ ;; Make sure we get the remote values we set above.
+ (let ((default-directory "/method:host:"))
+ (should (equal (files-x-test--get-lazy-var) "there"))
+ (with-connection-local-application-variables
+ (cadr files-x-test--application)
+ (should (equal remote-null-device "null"))))))
+
(provide 'files-x-tests)
;;; files-x-tests.el ends here
diff --git a/test/lisp/image/wallpaper-tests.el
b/test/lisp/image/wallpaper-tests.el
index 52011fe797..a5d3343bd4 100644
--- a/test/lisp/image/wallpaper-tests.el
+++ b/test/lisp/image/wallpaper-tests.el
@@ -23,6 +23,104 @@
(require 'ert-x)
(require 'wallpaper)
+(ert-deftest wallpaper--find-setter ()
+ (skip-unless (executable-find "touch"))
+ (let (wallpaper--current-setter
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" "/tmp/touched"))))
+ (should (wallpaper--find-setter))))
+
+(ert-deftest wallpaper--find-setter/call-predicate ()
+ (skip-unless (executable-find "touch"))
+ (let* ( wallpaper--current-setter called
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" "/tmp/touched"
+ :predicate (lambda () (setq called t))))))
+ (should-not called)
+ (wallpaper--find-setter)
+ (should called)))
+
+(ert-deftest wallpaper--find-setter/set-current-setter ()
+ (skip-unless (executable-find "touch"))
+ (let (wallpaper--current-setter
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" "/tmp/touched"))))
+ (wallpaper--find-setter)
+ (should wallpaper--current-setter)))
+
+(ert-deftest wallpaper-set/runs-command ()
+ (skip-unless (executable-find "touch"))
+ (ert-with-temp-file fil-jpg
+ :suffix ".jpg"
+ (ert-with-temp-file fil
+ (let* ( wallpaper--current-setter
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" fil)))
+ (wallpaper-command (wallpaper--find-command))
+ (wallpaper-command-args (wallpaper--find-command-args)))
+ (delete-file fil)
+ (let ((process (wallpaper-set fil-jpg)))
+ (while (process-live-p process)
+ (sit-for 0.001))
+ ;; Touch has recreated the file:
+ (should (file-exists-p fil)))))))
+
+(ert-deftest wallpaper-set/runs-command/detach ()
+ (skip-unless (executable-find "touch"))
+ (ert-with-temp-file fil-jpg
+ :suffix ".jpg"
+ (ert-with-temp-file fil
+ (let* ( wallpaper--current-setter
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" fil
+ :detach t)))
+ (wallpaper-command (wallpaper--find-command))
+ (wallpaper-command-args (wallpaper--find-command-args)))
+ (delete-file fil)
+ (wallpaper-set fil-jpg)
+ (while (not (file-exists-p fil))
+ (sit-for 0.001))
+ ;; Touch has recreated the file:
+ (should (file-exists-p fil))))))
+
+(ert-deftest wallpaper-set/calls-init-action ()
+ (skip-unless (executable-find "touch"))
+ (ert-with-temp-file fil-jpg
+ :suffix ".jpg"
+ (ert-with-temp-file fil
+ (let* ( wallpaper--current-setter called
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" fil
+ :init-action (lambda () (setq called t)))))
+ (wallpaper-command (wallpaper--find-command))
+ (wallpaper-command-args (wallpaper--find-command-args))
+ process)
+ (should (functionp (wallpaper-setter-init-action
wallpaper--current-setter)))
+ (setq process (wallpaper-set fil-jpg))
+ ;; Wait for "touch" process to exit so temp file is removed.
+ (accept-process-output process 3)
+ (should called)))))
+
+(ert-deftest wallpaper-set/calls-wallpaper-set-function ()
+ (skip-unless (executable-find "touch"))
+ (ert-with-temp-file fil-jpg
+ :suffix ".jpg"
+ (let* ( wallpaper--current-setter called
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" "foo")))
+ (wallpaper-set-function
+ (lambda (file) (setq called file))))
+ (wallpaper--find-setter)
+ (wallpaper-set fil-jpg)
+ (should (equal called fil-jpg)))))
+
(ert-deftest wallpaper--find-command/return-string ()
(should (or (not (wallpaper--find-command))
(stringp (wallpaper--find-command)))))
diff --git a/test/lisp/net/eudc-tests.el b/test/lisp/net/eudc-tests.el
new file mode 100644
index 0000000000..915006a97c
--- /dev/null
+++ b/test/lisp/net/eudc-tests.el
@@ -0,0 +1,155 @@
+;;; eudc-tests.el --- tests for eudc.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'eudc)
+
+(ert-deftest eudc--plist-member ()
+ "Test `eudc--plist-member' behavior."
+ (dolist (obj '(a (a . a) (a a . a)))
+ (should-error (eudc--plist-member obj nil) :type 'wrong-type-argument))
+ (dolist (plist '((nil) (a) (a a a)))
+ (let ((err `(wrong-type-argument plistp ,(copy-sequence plist))))
+ (dolist (key '(nil a))
+ (should (equal err (should-error (eudc--plist-member plist key)))))))
+ (let ((-nil (string ?n ?i ?l))
+ (-a (string ?a)))
+ (should-not (eudc--plist-member () nil))
+ (should-not (eudc--plist-member () 'a))
+ (should-not (eudc--plist-member '(nil nil) 'a))
+ (should-not (eudc--plist-member '(nil a) 'a))
+ (should-not (eudc--plist-member '(a nil) nil))
+ (should-not (eudc--plist-member '(a a) nil))
+ (should-not (eudc--plist-member '("nil" a) nil))
+ (should-not (eudc--plist-member '("nil" a) -nil))
+ (should-not (eudc--plist-member '("a" a) nil))
+ (should-not (eudc--plist-member '("a" a) -a))
+ (should-not (eudc--plist-member '(nil a nil a) 'a))
+ (should-not (eudc--plist-member '(nil a "a" a) -a))
+ (should (equal (eudc--plist-member '(nil nil) nil) '(nil nil)))
+ (should (equal (eudc--plist-member '(nil a) nil) '(nil a)))
+ (should (equal (eudc--plist-member '(a nil) 'a) '(a nil)))
+ (should (equal (eudc--plist-member '(a a) 'a) '(a a)))
+ (should (equal (eudc--plist-member '(nil nil a nil) 'a) '(a nil)))
+ (should (equal (eudc--plist-member '(nil a a a) 'a) '(a a)))
+ (should (equal (eudc--plist-member '(a a a a) 'a) '(a a a a)))))
+
+(ert-deftest eudc-plist-member ()
+ "Test `eudc-plist-member' behavior."
+ (dolist (obj '(a (a . a) (a a . a)))
+ (should-error (eudc-plist-member obj nil) :type 'wrong-type-argument))
+ (dolist (plist '((nil) (a) (a a a)))
+ (let ((err `(wrong-type-argument plistp ,(copy-sequence plist))))
+ (dolist (key '(nil a))
+ (should (equal err (should-error (eudc-plist-member plist key)))))))
+ (let ((-nil (string ?n ?i ?l))
+ (-a (string ?a)))
+ (should-not (eudc-plist-member () nil))
+ (should-not (eudc-plist-member () 'a))
+ (should-not (eudc-plist-member '(nil nil) 'a))
+ (should-not (eudc-plist-member '(nil a) 'a))
+ (should-not (eudc-plist-member '(a nil) nil))
+ (should-not (eudc-plist-member '(a a) nil))
+ (should-not (eudc-plist-member '("nil" a) nil))
+ (should-not (eudc-plist-member '("nil" a) -nil))
+ (should-not (eudc-plist-member '("a" a) nil))
+ (should-not (eudc-plist-member '("a" a) -a))
+ (should-not (eudc-plist-member '(nil a nil a) 'a))
+ (should-not (eudc-plist-member '(nil a "a" a) -a))
+ (should (eq t (eudc-plist-member '(nil nil) nil)))
+ (should (eq t (eudc-plist-member '(nil a) nil)))
+ (should (eq t (eudc-plist-member '(a nil) 'a)))
+ (should (eq t (eudc-plist-member '(a a) 'a)))
+ (should (eq t (eudc-plist-member '(nil nil a nil) 'a)))
+ (should (eq t (eudc-plist-member '(nil a a a) 'a)))
+ (should (eq t (eudc-plist-member '(a a a a) 'a)))))
+
+(ert-deftest eudc-plist-get ()
+ "Test `eudc-plist-get' behavior."
+ (dolist (obj '(a (a . a) (a a . a)))
+ (should-error (eudc-plist-get obj nil) :type 'wrong-type-argument))
+ (dolist (plist '((nil) (a) (a a a)))
+ (let ((err `(wrong-type-argument plistp ,(copy-sequence plist))))
+ (dolist (key '(nil a))
+ (should (equal err (should-error (eudc-plist-get plist key)))))))
+ (let ((-nil (string ?n ?i ?l))
+ (-a (string ?a)))
+ (should-not (eudc-plist-get () nil))
+ (should-not (eudc-plist-get () 'a))
+ (should-not (eudc-plist-get '(nil nil) nil))
+ (should-not (eudc-plist-get '(nil nil) 'a))
+ (should-not (eudc-plist-get '(nil a) 'a))
+ (should-not (eudc-plist-get '(a nil) nil))
+ (should-not (eudc-plist-get '(a nil) 'a))
+ (should-not (eudc-plist-get '(a a) nil))
+ (should-not (eudc-plist-get '("nil" a) nil))
+ (should-not (eudc-plist-get '("nil" a) -nil))
+ (should-not (eudc-plist-get '("a" a) nil))
+ (should-not (eudc-plist-get '("a" a) -a))
+ (should-not (eudc-plist-get '(nil nil nil a) nil))
+ (should-not (eudc-plist-get '(nil a nil a) 'a))
+ (should-not (eudc-plist-get '(nil a "a" a) -a))
+ (should-not (eudc-plist-get '(a nil a a) 'a))
+ (should (eq 'a (eudc-plist-get '(nil a) nil)))
+ (should (eq 'a (eudc-plist-get '(a a) 'a)))
+ (should (eq 'a (eudc-plist-get '(a a a nil) 'a)))
+ (should (eq 'b (eudc-plist-get () nil 'b)))
+ (should (eq 'b (eudc-plist-get () 'a 'b)))
+ (should (eq 'b (eudc-plist-get '(nil a "a" a) -a 'b)))
+ (should (eq 'b (eudc-plist-get '(a nil "nil" nil) -nil 'b)))))
+
+(ert-deftest eudc-lax-plist-get ()
+ "Test `eudc-lax-plist-get' behavior."
+ (dolist (obj '(a (a . a) (a a . a)))
+ (should-error (eudc-lax-plist-get obj nil) :type 'wrong-type-argument))
+ (dolist (plist '((nil) (a) (a a a)))
+ (let ((err `(wrong-type-argument plistp ,(copy-sequence plist))))
+ (dolist (key '(nil a))
+ (should (equal err (should-error (eudc-lax-plist-get plist key)))))))
+ (let ((-nil (string ?n ?i ?l))
+ (-a (string ?a)))
+ (should-not (eudc-lax-plist-get () nil))
+ (should-not (eudc-lax-plist-get () 'a))
+ (should-not (eudc-lax-plist-get '(nil nil) nil))
+ (should-not (eudc-lax-plist-get '(nil nil) 'a))
+ (should-not (eudc-lax-plist-get '(nil a) 'a))
+ (should-not (eudc-lax-plist-get '(a nil) nil))
+ (should-not (eudc-lax-plist-get '(a nil) 'a))
+ (should-not (eudc-lax-plist-get '(a a) nil))
+ (should-not (eudc-lax-plist-get '("nil" a) nil))
+ (should-not (eudc-lax-plist-get '("nil" a) 'a))
+ (should-not (eudc-lax-plist-get '("a" a) nil))
+ (should-not (eudc-lax-plist-get '("a" a) 'a))
+ (should-not (eudc-lax-plist-get '(nil nil nil a) nil))
+ (should-not (eudc-lax-plist-get '(nil a nil a) 'a))
+ (should-not (eudc-lax-plist-get '(nil a "a" a) 'a))
+ (should-not (eudc-lax-plist-get '(a nil a a) 'a))
+ (should (eq 'a (eudc-lax-plist-get '(nil a) nil)))
+ (should (eq 'a (eudc-lax-plist-get '(a a) 'a)))
+ (should (eq 'a (eudc-lax-plist-get '(a a a nil) 'a)))
+ (should (eq 'b (eudc-lax-plist-get () nil 'b)))
+ (should (eq 'b (eudc-lax-plist-get () 'a 'b)))
+ (should (eq 'a (eudc-lax-plist-get '("nil" a) -nil)))
+ (should (eq 'a (eudc-lax-plist-get '("a" a) -a)))
+ (should (eq 'a (eudc-lax-plist-get '(nil a "a" a) -a)))
+ (should (eq 'b (eudc-lax-plist-get '(nil a "a" a) 'a 'b)))
+ (should (eq 'b (eudc-lax-plist-get '(a nil "nil" nil) nil 'b)))))
+
+;;; eudc-tests.el ends here
diff --git a/test/lisp/net/puny-resources/IdnaTestV2.txt
b/test/lisp/net/puny-resources/IdnaTestV2.txt
index ed2f32e129..4b8d5984a7 100644
--- a/test/lisp/net/puny-resources/IdnaTestV2.txt
+++ b/test/lisp/net/puny-resources/IdnaTestV2.txt
@@ -2,12 +2,12 @@
# Date: 2021-08-17, 19:34:01 GMT
# © 2021 Unicode®, Inc.
# Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in
the U.S. and other countries.
-# For terms of use, see http://www.unicode.org/terms_of_use.html
+# For terms of use, see https://www.unicode.org/terms_of_use.html
#
# Unicode IDNA Compatible Preprocessing for UTS #46
# Version: 14.0.0
#
-# For documentation and usage, see http://www.unicode.org/reports/tr46
+# For documentation and usage, see https://www.unicode.org/reports/tr46
#
# Test cases for verifying UTS #46 conformance.
#
diff --git a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
index bb3d4871a9..13d879bf76 100644
--- a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
+++ b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
@@ -140,4 +140,70 @@ HERE
. 'indent-level'; # Continuation, should be indented
+=head2 Test case 7
+
+An indented HERE document using a bare identifier.
+
+=cut
+
+## test case
+
+$text = <<~HERE;
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
+=head2 Test case 8
+
+A HERE document as an argument to print when printing to a filehandle.
+
+=cut
+
+## test case
+
+print $fh <<~HERE;
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
+=head2 Test case 9
+
+A HERE document as a hash value.
+
+=cut
+
+my %foo = (
+ text => <<~HERE
+look-here
+HERE
+ );
+
+$noindent = "New statement in this line";
+
+=head2 Test case 10
+
+A HERE document as an argument to die.
+
+=cut
+
+1 or die <<HERE;
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
+=head2 Test case 11
+
+A HERE document as an argument to warn.
+
+=cut
+
+1 or warn <<HERE;
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
__END__
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index fdaedb5fd7..81c9217c62 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -43,6 +43,37 @@ always located at the beginning of buffer."
(goto-char (point-min))
,@body)))
+(defun python-tests-shell-wait-for-prompt ()
+ "Wait for the prompt in the shell buffer."
+ (python-shell-with-shell-buffer
+ (while (not (if-let ((prompt (python-util-comint-last-prompt)))
+ (python-shell-comint-end-of-output-p
+ (buffer-substring-no-properties
+ (car prompt) (cdr prompt)))))
+ (sit-for 0.1))))
+
+(defmacro python-tests-with-temp-buffer-with-shell (contents &rest body)
+ "Create a `python-mode' enabled temp buffer with CONTENTS and `run-python'.
+BODY is code to be executed within the temp buffer. Point is
+always located at the beginning of buffer. Native completion is
+turned off. Shell buffer will be killed on exit."
+ (declare (indent 1) (debug t))
+ `(with-temp-buffer
+ (let ((python-indent-guess-indent-offset nil)
+ (python-shell-completion-native-enable nil))
+ (python-mode)
+ (unwind-protect
+ (progn
+ (run-python nil t)
+ (insert ,contents)
+ (goto-char (point-min))
+ (python-tests-shell-wait-for-prompt)
+ ,@body)
+ (when (python-shell-get-buffer)
+ (python-shell-with-shell-buffer
+ (let (kill-buffer-hook kill-buffer-query-functions)
+ (kill-buffer))))))))
+
(defmacro python-tests-with-temp-file (contents &rest body)
"Create a `python-mode' enabled file with CONTENTS.
BODY is code to be executed within the temp buffer. Point is
@@ -4365,6 +4396,32 @@ def foo():
(python-shell-interpreter "/some/path/to/bin/pypy"))
(should (python-shell-completion-native-interpreter-disabled-p))))
+(ert-deftest python-shell-completion-at-point-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ ""
+ (python-shell-with-shell-buffer
+ (insert "import abc")
+ (comint-send-input)
+ (python-tests-shell-wait-for-prompt)
+ (insert "abc.")
+ (should (nth 2 (python-shell-completion-at-point)))
+ (end-of-line 0)
+ (should-not (nth 2 (python-shell-completion-at-point))))))
+
+(ert-deftest python-shell-completion-at-point-native-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ ""
+ (python-shell-completion-native-turn-on)
+ (python-shell-with-shell-buffer
+ (insert "import abc")
+ (comint-send-input)
+ (python-tests-shell-wait-for-prompt)
+ (insert "abc.")
+ (should (nth 2 (python-shell-completion-at-point)))
+ (end-of-line 0)
+ (should-not (nth 2 (python-shell-completion-at-point))))))
@@ -4373,6 +4430,119 @@ def foo():
;;; Symbol completion
+(ert-deftest python-completion-at-point-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (goto-char (point-max))
+ (insert "abc.")
+ (should (completion-at-point))
+ (insert "A")
+ (should (completion-at-point)))))
+
+(ert-deftest python-completion-at-point-2 ()
+ "Should work regardless of the point in the Shell buffer."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (python-shell-with-shell-buffer
+ (goto-char (point-min)))
+ (goto-char (point-max))
+ (insert "abc.")
+ (should (completion-at-point)))))
+
+(ert-deftest python-completion-at-point-pdb-1 ()
+ "Should not complete PDB commands in Python buffer."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import pdb
+
+pdb.set_trace()
+print('Hello')
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (goto-char (point-max))
+ (insert "u")
+ (should-not (nth 2 (python-completion-at-point))))))
+
+(ert-deftest python-completion-at-point-native-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-completion-native-turn-on)
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (goto-char (point-max))
+ (insert "abc.")
+ (should (completion-at-point))
+ (insert "A")
+ (should (completion-at-point)))))
+
+(ert-deftest python-completion-at-point-native-2 ()
+ "Should work regardless of the point in the Shell buffer."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-completion-native-turn-on)
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (python-shell-with-shell-buffer
+ (goto-char (point-min)))
+ (goto-char (point-max))
+ (insert "abc.")
+ (should (completion-at-point)))))
+
+(ert-deftest python-completion-at-point-native-with-ffap-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-completion-native-turn-on)
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (goto-char (point-max))
+ (insert "abc.")
+ ;; This is called when FFAP is enabled and a find-file function is called.
+ (python-ffap-module-path "abc.")
+ (should (completion-at-point)))))
+
+(ert-deftest python-completion-at-point-native-with-eldoc-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-completion-native-turn-on)
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (goto-char (point-max))
+ (insert "abc.")
+ ;; This is called by idle-timer when ElDoc is enabled.
+ (python-eldoc-function)
+ (should (completion-at-point)))))
+
;;; Fill paragraph
diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
index 0c206b1e0c..f39489071e 100644
--- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
@@ -177,11 +177,11 @@ qux :+,
b = $:
c = ??
-# Example from http://www.ruby-doc.org/docs/ProgrammingRuby/html/language.html
+# Example from https://ruby-doc.com/docs/ProgrammingRuby/
d = 4 + 5 + # no '\' needed
6 + 7
-# Example from http://www.ruby-doc.org/docs/ProgrammingRuby/html/language.html
+# Example from https://www.ruby-doc.org/docs/ProgrammingRuby/
e = 8 + 9 \
+ 10 # '\' needed
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 347981e818..cc9610cd39 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1139,7 +1139,10 @@ final or penultimate step during initialization."))
(should-not (plistp '(1 . 2)))
(should (plistp '(1 2 3 4)))
(should-not (plistp '(1 2 3)))
- (should-not (plistp '(1 2 3 . 4))))
+ (should-not (plistp '(1 2 3 . 4)))
+ (let ((cycle (list 1 2 3)))
+ (nconc cycle cycle)
+ (should-not (plistp cycle))))
(defun subr-tests--butlast-ref (list &optional n)
"Reference implementation of `butlast'."
diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el
index 55e37b71d8..1b5ef04436 100644
--- a/test/lisp/time-stamp-tests.el
+++ b/test/lisp/time-stamp-tests.el
@@ -89,11 +89,11 @@
(iter-defun time-stamp-test-pattern-sequential ()
"Iterate through each possibility for a part of `time-stamp-pattern'."
(let ((pattern-value-parts
- '(("4/" "10/" "-4/" "0/" "") ;0: line limit
+ '(("4/" "10/" "-9/" "0/" "") ;0: line limit
("stamp<" "") ;1: start
- ("%-d" "%_H" "%^a" "%#Z" "%:A" "%02H" "%%" "") ;2: format part 1
+ ("%-d" "%_H" "%^a" "%#Z" "%:A" "%09z" "%%" "") ;2: format part 1
(" " "x" ":" "\n" "") ;3: format part 2
- ("%-d" "%_H" "%^a" "%#Z" "%:A" "%02H" "%%") ;4: format part 3
+ ("%-d" "%_H" "%^a" "%#Z" "%:A" "%09z" "%%") ;4: format part 3
(">end" "")))) ;5: end
(dotimes (cur (length pattern-value-parts))
(dotimes (cur-index (length (nth cur pattern-value-parts)))
@@ -118,7 +118,7 @@
(iter-defun time-stamp-test-pattern-multiply ()
"Iterate through every combination of parts of `time-stamp-pattern'."
(let ((line-limit-values '("" "4/"))
- (start-values '("" "stamp<"))
+ (start-values '("" "/stamp/"))
(format-values '("%%" "%m"))
(end-values '("" ">end")))
;; yield all combinations of the above
diff --git a/test/manual/image-circular-tests.el
b/test/manual/image-circular-tests.el
index 1299970f82..d2187cbbad 100644
--- a/test/manual/image-circular-tests.el
+++ b/test/manual/image-circular-tests.el
@@ -27,8 +27,11 @@
(require 'ert)
+(declare-function image-size "image.c" (spec &optional pixels frame))
+
(ert-deftest image-test-duplicate-keywords ()
"Test that duplicate keywords in an image spec lead to rejection."
+ (skip-unless (display-images-p))
(should-error (image-size `(image :type xbm :type xbm
:data-width 1 :data-height 1
:data ,(bool-vector t))
@@ -36,33 +39,37 @@
(ert-deftest image-test-circular-plist ()
"Test that a circular image spec is rejected."
- (should-error
- (let ((l `(image :type xbm :data-width 1 :data-height 1
- :data ,(bool-vector t))))
- (setcdr (last l) '#1=(:invalid . #1#))
- (image-size l t))))
+ (skip-unless (display-images-p))
+ (let ((spec `(image :type xbm :data-width 1 :data-height 1
+ :data ,(bool-vector t)
+ . ,'#1=(:invalid . #1#))))
+ (should-error (image-size spec t))))
(ert-deftest image-test-:type-property-value ()
"Test that :type is allowed as a property value in an image spec."
+ (skip-unless (display-images-p))
(should (equal (image-size `(image :dummy :type :type xbm
:data-width 1 :data-height 1
:data ,(bool-vector t))
t)
- (cons 1 1))))
+ '(1 . 1))))
(ert-deftest image-test-circular-specs ()
- "Test that circular image spec property values do not cause infinite
recursion."
- (should
- (let* ((circ1 (cons :dummy nil))
- (circ2 (cons :dummy nil))
- (spec1 `(image :type xbm :data-width 1 :data-height 1
- :data ,(bool-vector 1) :ignored ,circ1))
- (spec2 `(image :type xbm :data-width 1 :data-height 1
+ "Test with circular image spec property values.
+In particular, test that they do not cause infinite recursion."
+ :expected-result :failed ;; FIXME: bug#36403#63.
+ (skip-unless (display-images-p))
+ ;; Two copies needed to warm up image cache.
+ (let* ((circ1 (list :dummy))
+ (circ2 (list :dummy))
+ (spec1 `(image :type xbm :data-width 1 :data-height 1
+ :data ,(bool-vector 1) :ignored ,circ1))
+ (spec2 `(image :type xbm :data-width 1 :data-height 1
:data ,(bool-vector 1) :ignored ,circ2)))
- (setcdr circ1 circ1)
- (setcdr circ2 circ2)
- (and (equal (image-size spec1 t) (cons 1 1))
- (equal (image-size spec2 t) (cons 1 1))))))
+ (setcdr circ1 circ1)
+ (setcdr circ2 circ2)
+ (should (equal (image-size spec1 t) '(1 . 1)))
+ (should (equal (image-size spec2 t) '(1 . 1)))))
(provide 'image-circular-tests)
;;; image-circular-tests.el ends here.
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 9a2bd5cef3..7568d941d0 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -22,6 +22,7 @@
;;; Code:
(require 'cl-lib)
+(require 'ert)
(ert-deftest fns-tests-identity ()
(let ((num 12345)) (should (eq (identity num) num)))
@@ -29,9 +30,22 @@
(let ((lst '(11))) (should (eq (identity lst) lst))))
(ert-deftest fns-tests-random ()
- (should (integerp (random)))
- (should (>= (random 10) 0))
- (should (< (random 10) 10)))
+ (unwind-protect
+ (progn
+ (should-error (random -1) :type 'args-out-of-range)
+ (should-error (random 0) :type 'args-out-of-range)
+ (should (integerp (random)))
+ (should (= (random 1) 0))
+ (should (>= (random 10) 0))
+ (should (< (random 10) 10))
+ (should (equal (random "seed") (random "seed")))
+ ;; The probability of four calls being the same is low.
+ ;; This makes sure that the value isn't constant.
+ (should (not (= (random t) (random t) (random t) (random t))))
+ ;; Handle bignums.
+ (should (integerp (random (1+ most-positive-fixnum)))))
+ ;; Reset the PRNG seed after testing.
+ (random t)))
(ert-deftest fns-tests-length ()
(should (= (length nil) 0))
@@ -152,6 +166,8 @@
(,(string-to-multibyte "abc") < "abd")
(,(string-to-multibyte "abc") < ,(string-to-multibyte "abd"))
(,(string-to-multibyte "\x80") = ,(string-to-multibyte "\x80"))
+ ("Liberté, Égalité, Fraternité" = "Liberté, Égalité, Fraternité")
+ ("Liberté, Égalité, Fraternité" < "Liberté, Égalité, Sororité")
;; Cases concerning the ordering of raw bytes: these are
;; troublesome because the current `string<' order is not very useful as
@@ -841,6 +857,14 @@
(should-error (reverse (dot1 1)) :type 'wrong-type-argument)
(should-error (reverse (dot2 1 2)) :type 'wrong-type-argument))
+(ert-deftest test-cycle-equal ()
+ (should-error (equal (cyc1 1) (cyc1 1)))
+ (should-error (equal (cyc2 1 2) (cyc2 1 2))))
+
+(ert-deftest test-cycle-nconc ()
+ (should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
+ (should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
+
(ert-deftest test-cycle-plist-get ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
@@ -895,30 +919,47 @@
(should-error (plist-put d1 3 3) :type 'wrong-type-argument)
(should-error (plist-put d2 3 3) :type 'wrong-type-argument)))
-(ert-deftest test-cycle-equal ()
- (should-error (equal (cyc1 1) (cyc1 1)))
- (should-error (equal (cyc2 1 2) (cyc2 1 2))))
-
-(ert-deftest test-cycle-nconc ()
- (should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
- (should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
-
(ert-deftest plist-get/odd-number-of-elements ()
"Test that `plist-get' doesn't signal an error on degenerate plists."
(should-not (plist-get '(:foo 1 :bar) :bar)))
(ert-deftest plist-put/odd-number-of-elements ()
- "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726.";
- (should (equal (should-error (plist-put '(:foo 1 :bar) :zot 2)
- :type 'wrong-type-argument)
+ "Check for bug#27726."
+ (should (equal (should-error (plist-put (list :foo 1 :bar) :zot 2))
'(wrong-type-argument plistp (:foo 1 :bar)))))
(ert-deftest plist-member/improper-list ()
- "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726.";
- (should (equal (should-error (plist-member '(:foo 1 . :bar) :qux)
- :type 'wrong-type-argument)
+ "Check for bug#27726."
+ (should (equal (should-error (plist-member '(:foo 1 . :bar) :qux))
'(wrong-type-argument plistp (:foo 1 . :bar)))))
+(ert-deftest test-plist ()
+ (let ((plist (list :a "b")))
+ (setq plist (plist-put plist :b "c"))
+ (should (equal (plist-get plist :b) "c"))
+ (should (equal (plist-member plist :b) '(:b "c"))))
+
+ (let ((plist (list "1" "2" "a" "b")))
+ (setq plist (plist-put plist (string ?a) "c"))
+ (should (equal plist '("1" "2" "a" "b" "a" "c")))
+ (should-not (plist-get plist (string ?a)))
+ (should-not (plist-member plist (string ?a))))
+
+ (let ((plist (list "1" "2" "a" "b")))
+ (setq plist (plist-put plist (string ?a) "c" #'equal))
+ (should (equal plist '("1" "2" "a" "c")))
+ (should (equal (plist-get plist (string ?a) #'equal) "c"))
+ (should (equal (plist-member plist (string ?a) #'equal) '("a" "c"))))
+
+ (let ((plist (list :a 1 :b 2 :c 3)))
+ (setq plist (plist-put plist ":a" 4 #'string>))
+ (should (equal plist '(:a 1 :b 4 :c 3)))
+ (should (equal (plist-get plist ":b" #'string>) 3))
+ (should (equal (plist-member plist ":c" #'string<) plist))
+ (dolist (fn '(plist-get plist-member))
+ (should-not (funcall fn plist ":a" #'string<))
+ (should-not (funcall fn plist ":c" #'string>)))))
+
(ert-deftest test-string-distance ()
"Test `string-distance' behavior."
;; ASCII characters are always fine
@@ -1334,23 +1375,6 @@
(should-error (append loop '(end))
:type 'circular-list)))
-(ert-deftest test-plist ()
- (let ((plist '(:a "b")))
- (setq plist (plist-put plist :b "c"))
- (should (equal (plist-get plist :b) "c"))
- (should (equal (plist-member plist :b) '(:b "c"))))
-
- (let ((plist '("1" "2" "a" "b")))
- (setq plist (plist-put plist (copy-sequence "a") "c"))
- (should-not (equal (plist-get plist (copy-sequence "a")) "c"))
- (should-not (equal (plist-member plist (copy-sequence "a")) '("a" "c"))))
-
- (let ((plist '("1" "2" "a" "b")))
- (setq plist (plist-put plist (copy-sequence "a") "c" #'equal))
- (should (equal (plist-get plist (copy-sequence "a") #'equal) "c"))
- (should (equal (plist-member plist (copy-sequence "a") #'equal)
- '("a" "c")))))
-
(ert-deftest fns--string-to-unibyte-multibyte ()
(dolist (str (list "" "a" "abc" "a\x00\x7fz" "a\xaa\xbbz" "\x80\xdd\xff"
(apply #'unibyte-string (number-sequence 0 255))))
diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el
index 1829a7ea1f..7f0f660d13 100644
--- a/test/src/lcms-tests.el
+++ b/test/src/lcms-tests.el
@@ -28,7 +28,7 @@
;; https://github.com/njsmith/colorspacious
;; Other references:
-;;
http://www.babelcolor.com/index_htm_files/A%20review%20of%20RGB%20color%20spaces.pdf
+;;
https://www.babelcolor.com/index_htm_files/A%20review%20of%20RGB%20color%20spaces.pdf
;;; Code:
diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el
index ff0d6be3f5..b323f592dc 100644
--- a/test/src/regex-emacs-tests.el
+++ b/test/src/regex-emacs-tests.el
@@ -867,4 +867,9 @@ This evaluates the TESTS test cases from glibc."
(should (equal (string-match "[[:lower:]]" "ẞ") 0))
(should (equal (string-match "[[:upper:]]" "ẞ") 0))))
+(ert-deftest regexp-atomic-failure ()
+ "Bug#58726."
+ (should (equal (string-match "\\`\\(?:ab\\)*\\'" "a") nil))
+ (should (equal (string-match "\\`a\\{2\\}*\\'" "a") nil)))
+
;;; regex-emacs-tests.el ends here
diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el
index 5af4392301..be4f60ab57 100644
--- a/test/src/sqlite-tests.el
+++ b/test/src/sqlite-tests.el
@@ -241,4 +241,17 @@
(should (multibyte-string-p c1))
(should-not (multibyte-string-p c2)))))))
+(ert-deftest sqlite-returning ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (progn
+ (setq db (sqlite-open))
+ (sqlite-execute db "CREATE TABLE people1 (people_id INTEGER PRIMARY KEY,
first TEXT, last TEXT)")
+ (should (null (sqlite-select db "select * from people1")))
+ (should
+ (equal
+ (sqlite-execute db "INSERT INTO people1 (first, last) values (?, ?)
RETURNING people_id, first"
+ '("Joe" "Doe"))
+ '((1 "Joe")))))))
+
;;; sqlite-tests.el ends here