[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/package+vc 2a4f37fe52 10/10: Merge remote-tracking branch 'origi
|
From: |
Philip Kaludercic |
|
Subject: |
feature/package+vc 2a4f37fe52 10/10: Merge remote-tracking branch 'origin/master' into feature/package+vc |
|
Date: |
Sun, 30 Oct 2022 13:55:31 -0400 (EDT) |
branch: feature/package+vc
commit 2a4f37fe520b4f18295cff6671f289a47c1578df
Merge: d33998ed3b 3fa4cca3d2
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>
Merge remote-tracking branch 'origin/master' into feature/package+vc
---
.clang-format | 2 +-
admin/notes/repo | 18 +
configure.ac | 1 +
doc/emacs/building.texi | 11 +-
doc/emacs/custom.texi | 2 +-
doc/emacs/display.texi | 2 +-
doc/emacs/emacs.texi | 2 +-
doc/emacs/haiku.texi | 2 +-
doc/emacs/killing.texi | 4 +-
doc/emacs/macos.texi | 6 +-
doc/emacs/maintaining.texi | 4 +-
doc/emacs/misc.texi | 2 +-
doc/emacs/modes.texi | 2 +-
doc/emacs/programs.texi | 147 +-
doc/emacs/text.texi | 17 +-
doc/lispref/backups.texi | 2 +-
doc/lispref/commands.texi | 2 +-
doc/lispref/compile.texi | 2 +-
doc/lispref/display.texi | 8 +-
doc/lispref/files.texi | 2 +-
doc/lispref/frames.texi | 111 +-
doc/lispref/lists.texi | 8 +-
doc/lispref/modes.texi | 8 +-
doc/lispref/processes.texi | 2 +-
doc/lispref/searching.texi | 18 +-
doc/lispref/symbols.texi | 8 +-
doc/lispref/text.texi | 12 +-
doc/lispref/variables.texi | 2 +-
doc/lispref/windows.texi | 2 +-
doc/misc/cc-mode.texi | 2 +-
doc/misc/cl.texi | 2 +-
doc/misc/eglot.texi | 49 +-
doc/misc/eshell.texi | 6 +-
doc/misc/flymake.texi | 4 +-
doc/misc/gnus.texi | 14 +-
doc/misc/modus-themes.org | 175 +-
doc/misc/newsticker.texi | 2 +-
doc/misc/octave-mode.texi | 7 +-
doc/misc/rcirc.texi | 4 +-
doc/misc/sem-user.texi | 2 +-
doc/misc/tramp.texi | 7 +-
doc/misc/transient.texi | 2 +-
doc/misc/url.texi | 2 +-
etc/NEWS | 109 +-
etc/themes/modus-operandi-theme.el | 5 +-
etc/themes/modus-themes.el | 198 +-
etc/themes/modus-vivendi-theme.el | 7 +-
lisp/abbrev.el | 2 +-
lisp/allout-widgets.el | 2 +-
lisp/ansi-color.el | 2 +-
lisp/autoinsert.el | 2 +-
lisp/autorevert.el | 5 +-
lisp/bindings.el | 8 +
lisp/cedet/ede/locate.el | 4 +-
lisp/cedet/semantic/wisent.el | 2 +-
lisp/cus-edit.el | 2 +-
lisp/cus-theme.el | 2 +-
lisp/dired-aux.el | 2 +-
lisp/dired.el | 10 +-
lisp/dom.el | 68 +-
lisp/ecomplete.el | 5 +-
lisp/elide-head.el | 4 +-
lisp/emacs-lisp/backtrace.el | 2 +-
lisp/emacs-lisp/bindat.el | 6 +-
lisp/emacs-lisp/byte-opt.el | 2 +-
lisp/emacs-lisp/bytecomp.el | 11 +-
lisp/emacs-lisp/cconv.el | 150 +-
lisp/emacs-lisp/cl-extra.el | 4 +-
lisp/emacs-lisp/comp-cstr.el | 2 +-
lisp/emacs-lisp/comp.el | 21 +-
lisp/emacs-lisp/crm.el | 2 +-
lisp/emacs-lisp/eldoc.el | 127 +-
lisp/emacs-lisp/gv.el | 7 +-
lisp/emacs-lisp/hierarchy.el | 85 +-
lisp/emacs-lisp/icons.el | 25 +-
lisp/emacs-lisp/map.el | 164 +-
lisp/emacs-lisp/package.el | 3 +-
lisp/emacs-lisp/re-builder.el | 31 +-
lisp/emacs-lisp/tabulated-list.el | 2 +-
lisp/erc/erc-capab.el | 2 +-
lisp/erc/erc-networks.el | 2 +-
lisp/files-x.el | 11 +-
lisp/files.el | 2 +-
lisp/follow.el | 2 +-
lisp/gnus/gnus-art.el | 1 -
lisp/gnus/gnus-bookmark.el | 2 +-
lisp/gnus/gnus-cus.el | 5 +-
lisp/gnus/gnus-start.el | 2 +-
lisp/gnus/message.el | 2 +-
lisp/gnus/mm-bodies.el | 20 +-
lisp/gnus/smime.el | 2 +-
lisp/help.el | 124 +-
lisp/icomplete.el | 2 +-
lisp/ido.el | 2 +-
lisp/image/image-dired-external.el | 2 +-
lisp/info.el | 5 +-
lisp/international/mule-cmds.el | 93 +-
lisp/international/mule-diag.el | 2 +-
lisp/international/textsec.el | 2 +-
lisp/language/misc-lang.el | 2 +-
lisp/loadup.el | 5 +
lisp/mail/rmailsum.el | 96 +-
lisp/mail/sendmail.el | 8 +-
lisp/minibuffer.el | 16 +-
lisp/net/eudc.el | 61 +-
lisp/net/ldap.el | 5 +-
lisp/net/newst-backend.el | 1 -
lisp/net/rcirc.el | 2 +-
lisp/net/sieve-manage.el | 2 +-
lisp/net/tramp-cache.el | 27 +-
lisp/net/tramp-container.el | 25 +-
lisp/net/tramp-sh.el | 31 +-
lisp/net/tramp.el | 7 +
lisp/nxml/rng-uri.el | 8 +-
lisp/org/org-agenda.el | 2 +-
lisp/org/ox-ascii.el | 2 +-
lisp/outline.el | 270 +-
lisp/play/zone.el | 6 +-
lisp/progmodes/cc-engine.el | 68 +-
lisp/progmodes/cc-fonts.el | 284 +-
lisp/progmodes/cc-langs.el | 209 +-
lisp/progmodes/compile.el | 2 +-
lisp/progmodes/eglot.el | 36 +-
lisp/progmodes/etags.el | 22 +-
lisp/progmodes/flymake.el | 5 +-
lisp/progmodes/fortran.el | 2 +-
lisp/progmodes/gdb-mi.el | 2 +-
lisp/progmodes/gud.el | 7 +-
lisp/progmodes/make-mode.el | 298 +-
lisp/progmodes/perl-mode.el | 2 +-
lisp/progmodes/prolog.el | 2 +-
lisp/progmodes/ps-mode.el | 50 +-
lisp/progmodes/python.el | 17 +-
lisp/progmodes/ruby-mode.el | 4 +-
lisp/progmodes/verilog-mode.el | 4 +-
lisp/startup.el | 5 +-
lisp/subr.el | 6 +-
lisp/tab-bar.el | 123 +-
lisp/tab-line.el | 3 +-
lisp/textmodes/emacs-news-mode.el | 2 +-
lisp/textmodes/page-ext.el | 38 +-
lisp/textmodes/table.el | 5 -
lisp/transient.el | 209 +-
lisp/url/url-util.el | 37 +-
lisp/url/url.el | 2 +-
lisp/vc/vc-hg.el | 36 +-
lisp/whitespace.el | 287 +-
lisp/winner.el | 8 +
lisp/x-dnd.el | 10 +-
lisp/xwidget.el | 2 +-
oldXMenu/Activate.c | 10 -
oldXMenu/XMenu.h | 2 -
src/Makefile.in | 39 +-
src/alloc.c | 60 +-
src/buffer.c | 1505 +++----
src/buffer.h | 110 +-
src/callproc.c | 31 +-
src/editfns.c | 67 +-
src/emacs.c | 1 +
src/eval.c | 40 +-
src/fileio.c | 3 +-
src/fns.c | 156 +-
src/indent.c | 13 +-
src/insdel.c | 12 -
src/intervals.c | 4 +-
src/itree.c | 1432 +++++++
src/itree.h | 182 +
src/keyboard.c | 12 +-
src/lisp.h | 20 +-
src/menu.c | 12 +
src/msdos.h | 1 -
src/nsterm.m | 10 +-
src/pdumper.c | 68 +-
src/print.c | 14 +-
src/regex-emacs.c | 14 +-
src/sqlite.c | 72 +-
src/textprop.c | 57 +-
src/w32fns.c | 3 +-
src/window.h | 10 +
src/xdisp.c | 260 +-
src/xfaces.c | 17 +-
src/xfns.c | 24 +-
src/xmenu.c | 22 +-
src/xselect.c | 7 +-
src/xsettings.c | 29 +-
src/xterm.c | 350 +-
src/xterm.h | 30 +-
test/lisp/apropos-tests.el | 17 +-
test/lisp/autorevert-tests.el | 2 +-
test/lisp/elide-head-tests.el | 21 +-
test/lisp/emacs-lisp/bindat-tests.el | 19 +-
test/lisp/emacs-lisp/cconv-tests.el | 17 +-
test/lisp/emacs-lisp/cl-extra-tests.el | 24 +-
test/lisp/emacs-lisp/gv-tests.el | 75 +-
test/lisp/emacs-lisp/hierarchy-tests.el | 143 +
test/lisp/emacs-lisp/map-tests.el | 204 +-
test/lisp/international/textsec-tests.el | 2 +-
test/lisp/net/eudc-tests.el | 155 +
test/lisp/progmodes/python-tests.el | 71 +-
test/lisp/subr-tests.el | 5 +-
test/manual/noverlay/.gitignore | 1 +
test/manual/noverlay/Makefile.in | 32 +
test/manual/noverlay/check-sanitize.sh | 11 +
test/manual/noverlay/emacs-compat.h | 52 +
test/manual/noverlay/itree-tests.c | 1381 +++++++
test/manual/noverlay/many-errors.py | 2480 +++++++++++
test/manual/noverlay/overlay-perf.el | 764 ++++
test/src/buffer-tests.el | 6665 ++++++++++++++++++++++++++++++
test/src/comp-tests.el | 2 +-
test/src/emacs-module-tests.el | 2 +-
test/src/fns-tests.el | 70 +-
test/src/regex-emacs-tests.el | 5 +
212 files changed, 17622 insertions(+), 3715 deletions(-)
diff --git a/.clang-format b/.clang-format
index 44200a3995..ac9f95c88a 100644
--- a/.clang-format
+++ b/.clang-format
@@ -6,7 +6,7 @@ BreakBeforeBinaryOperators: All
BreakBeforeBraces: GNU
ColumnLimit: 70
ContinuationIndentWidth: 2
-ForEachMacros: [FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE]
+ForEachMacros: [FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE, ITREE_FOREACH]
IncludeCategories:
- Regex: '^<config\.h>$'
Priority: -1
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/configure.ac b/configure.ac
index 2d84344050..63cb9c412e 100644
--- a/configure.ac
+++ b/configure.ac
@@ -6708,6 +6708,7 @@ if test -f "$srcdir/$opt_makefile.in"; then
dnl Again, it's best not to use a variable. Though you can add
dnl ", [], [opt_makefile='$opt_makefile']" and it should work.
AC_CONFIG_FILES([test/Makefile])
+ AC_CONFIG_FILES([test/manual/noverlay/Makefile])
fi
opt_makefile=test/infra/Makefile
if test -f "$srcdir/$opt_makefile.in"; then
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 6e5a0ddc1c..08ada2a70b 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -1271,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.
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index b7c8825efa..cf4f041452 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -270,7 +270,7 @@ either at the top or bottom of the window depending on the
scroll
direction. By default, @code{scroll-conservatively} is@tie{}0, which
means to always center point in the window.
This said, in minibuffer windows, scrolling is always conservative by
-default because @code{scroll-minibuffer-conservatively} is non-nil,
+default because @code{scroll-minibuffer-conservatively} is non-@code{nil},
which takes precedence over @code{scroll-conservatively}.
@vindex scroll-step
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/haiku.texi b/doc/emacs/haiku.texi
index ac631a39a6..33c81b6f17 100644
--- a/doc/emacs/haiku.texi
+++ b/doc/emacs/haiku.texi
@@ -108,7 +108,7 @@ You can create such a file with the @command{xmlbmessage}
tool.
@cindex crashes, Haiku
@cindex haiku debugger
@vindex haiku-debug-on-fatal-error
- If the variable @code{haiku-debug-on-fatal-error} is non-nil, Emacs
+ If the variable @code{haiku-debug-on-fatal-error} is non-@code{nil}, Emacs
will launch the system debugger when a fatal signal is received. It
defaults to @code{t}. If GDB cannot be used on your system, please
attach the report generated by the system debugger when reporting a
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/macos.texi b/doc/emacs/macos.texi
index d7c432d420..1457a8bc3a 100644
--- a/doc/emacs/macos.texi
+++ b/doc/emacs/macos.texi
@@ -159,7 +159,7 @@ dialogue on quitting.
@vindex ns-auto-hide-menu-bar
@item ns-auto-hide-menu-bar
This variable specifies whether the macOS menu bar is hidden when an
-Emacs frame is selected. If non-nil the menu bar is not shown unless
+Emacs frame is selected. If non-@code{nil} the menu bar is not shown unless
the mouse pointer is moved near to the top of the screen.
@vindex ns-use-native-fullscreen
@@ -178,14 +178,14 @@ These variables only apply to macOS 10.7 (Lion) and above.
@item ns-use-mwheel-acceleration
This variable controls whether Emacs ignores the system mousewheel
acceleration. When nil each `click' of the mousewheel will correspond
-exactly with one mousewheel event. When non-nil, the default, each
+exactly with one mousewheel event. When non-@code{nil}, the default, each
`click' may correspond with more than one mousewheel event, depending
on the user's input.
@vindex ns-use-mwheel-momentum
@item ns-use-mwheel-momentum
This variable controls whether Emacs ignores the system `momentum'
-when scrolling using a trackpad. When non-nil, the default, scrolling
+when scrolling using a trackpad. When non-@code{nil}, the default, scrolling
rapidly may result in the buffer continuing to scroll for a short
while after the user has lifted their fingers off the trackpad.
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 94171b3a08..3e03bd817a 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:
@@ -3296,7 +3298,7 @@ according to @code{bug-reference-setup-from-mail-alist},
and @code{bug-reference-maybe-setup-from-irc} which does the setup
according to @code{bug-reference-setup-from-irc-alist}.
@end itemize
-A setup function should return non-nil if it could setup bug-reference
+A setup function should return non-@code{nil} if it could setup bug-reference
mode which is the case if the last thing the function does is calling
one of the helper functions above.
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 1514e316f8..29c0bed19c 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -1540,7 +1540,7 @@ color is supported. Therefore, Emacs provides an option
@code{comint-terminfo-terminal} to let you choose a terminal with more
advanced features, as defined in your system's terminfo database.
Emacs will use this option as the value for @env{TERM} so long as
-@code{system-uses-terminfo} is non-nil.
+@code{system-uses-terminfo} is non-@code{nil}.
Both @code{comint-terminfo-terminal} and @code{system-uses-terminfo}
can be declared as connection-local variables to adjust these options
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 b5e577d96a..6abf29c009 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -1197,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
@@ -1298,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})
@@ -1307,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-echo-area-display-truncation-message
-@item eldoc-echo-area-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
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/lispref/backups.texi b/doc/lispref/backups.texi
index d99487368b..f0b154e495 100644
--- a/doc/lispref/backups.texi
+++ b/doc/lispref/backups.texi
@@ -474,7 +474,7 @@ Each transform is a list of the form @w{@code{(@var{regexp}
@var{replacement} [@var{uniquify}])}}. @var{regexp} is a regular
expression to match against the file name; if it matches,
@code{replace-match} is used to replace the matching part with
-@var{replacement}. If the optional element @var{uniquify} is non-nil,
+@var{replacement}. If the optional element @var{uniquify} is non-@code{nil},
the auto-save file name is constructed by concatenating the directory
part of the transformed file name with the buffer's file name in which
all directory separators were changed to @samp{!} to prevent clashes.
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index ede1c4d762..377b433cae 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -2726,7 +2726,7 @@ coordinates @var{x} and @var{y} in a specified frame or
window,
@var{frame-or-window}, which defaults to the selected window.
The coordinates @var{x} and @var{y} are relative to the
text area of the selected window.
-If @var{whole} is @code{non-nil}, the @var{x} coordinate is relative
+If @var{whole} is non-@code{nil}, the @var{x} coordinate is relative
to the entire window area including scroll bars, margins and fringes.
@end defun
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index 6f8431c55c..d1d281d709 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -1077,7 +1077,7 @@ pristine environment, that may not be true for the
subprocess.
@end defopt
@defopt native-comp-async-query-on-exit
-If this variable's value is non-nil, Emacs will query upon exiting
+If this variable's value is non-@code{nil}, Emacs will query upon exiting
whether to exit and kill any asynchronous native-compilation
subprocesses that are still running, thus preventing the corresponding
@file{.eln} files from being written. If the value is @code{nil}, the
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 64400ef931..c75107fb58 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},
@@ -2587,7 +2587,7 @@ meaning the foreground color of the face. Omitting the
attribute
@code{:color} means to use the foreground color of the face.
@var{style} should be a symbol @code{line} or @code{wave}, meaning to
use a straight or wavy line. Omitting the attribute @code{:style}
-means to use a straight line. @var{position}, if non-nil, means to
+means to use a straight line. @var{position}, if non-@code{nil}, means to
display the underline at the descent of the text, instead of at the
baseline level. If it is a number, then it specifies the amount of
pixels above the descent to display the underline.
@@ -7347,7 +7347,7 @@ Display the next search result in @var{xwidget}. This
function will
signal an error if a search query has not been already started in
@var{xwidget} through @code{xwidget-webkit-search}.
-If @code{wrap-around} was non-nil when @code{xwidget-webkit-search}
+If @code{wrap-around} was non-@code{nil} when @code{xwidget-webkit-search}
was called, then the search will restart from the beginning of the
document when its end is reached.
@end defun
@@ -7357,7 +7357,7 @@ Display the previous search result in @var{xwidget}.
This function
signals an error if a search query has not been already started in
@var{xwidget} through @code{xwidget-webkit-search}.
-If @code{wrap-around} was non-nil when @code{xwidget-webkit-search}
+If @code{wrap-around} was non-@code{nil} when @code{xwidget-webkit-search}
was called, then the search will restart from the end of the
document when its beginning is reached.
@end defun
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index b26d4f1058..183b2786ea 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -3136,7 +3136,7 @@ a list of file names that match it.
@var{pattern} is, by default, a ``glob''/wildcard string, e.g.,
@samp{"/tmp/*.png"} or @samp{"/*/*/foo.png"}, but can also be a
-regular expression if the optional @var{regexp} parameter is non-nil.
+regular expression if the optional @var{regexp} parameter is non-@code{nil}.
In any case, the matches are applied per sub-directory, so a match
can't span a parent/sub directory.
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 8db6ad0fd3..b3f1a29ae8 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -4058,70 +4058,89 @@ amount of different data types on the clipboard.
When the user drops something from another application over Emacs,
Emacs will try to insert any text and open any URL that was dropped.
If text was dropped, then it will always be inserted at the location
-of the mouse pointer when the drop happened, or saved in the kill ring
-if insertion failed (which can happen if the buffer is read-only). If
-it was an URL, then Emacs tries to call an appropriate handler
-function by first matching the URL against regexps defined in
-@code{dnd-protocol-alist}, and then against @code{browse-url-handlers}
-and @code{browse-url-default-handlers}, and failing that, inserting
-the URL as plain text.
+of the mouse pointer where the drop happened, or saved in the kill
+ring if insertion failed, which could happen if the buffer was
+read-only. If a URL was dropped instead, then Emacs will first try to
+call an appropriate handler function by matching the URL against
+regexps defined in the variable @code{dnd-protocol-alist}, and then
+against those defined in the variables @code{browse-url-handlers} and
+@code{browse-url-default-handlers}. Should no suitable handler be
+located, Emacs will fall back to inserting the URL as plain text.
@defvar dnd-protocol-alist
This variable is a list of cons cells of the form
@w{@code{(@var{pattern} . @var{action})}}. @var{pattern} is a regexp
that URLs are matched against after being dropped. @var{action} is a
-function that is called with two arguments should a URL being dropped
+function that is called with two arguments, should a URL being dropped
match @var{pattern}: the URL being dropped, and the action being
-performed for the drop (one of the symbols @code{copy}, @code{move},
-@code{link}, @code{private} or @code{ask}).
+performed for the drop, which is one of the symbols @code{copy},
+@code{move}, @code{link}, @code{private} or @code{ask}.
+
+If @var{action} is @var{private}, then it means the program that
+initiated the drop wants Emacs to perform an unspecified action with
+the URL; a reasonable action to perform in that case is to open the URL
+or copy its contents into the current buffer. Otherwise, @var{action}
+has the same meaning as the @var{action} argument to
+@code{dnd-begin-file-drag}.
@end defvar
@cindex drag and drop, X
@cindex drag and drop, other formats
- Emacs implements drag-and-drop for text and URLs individually for
-each window system, and does not by default support the dropping of
-anything else. Code that wishes to support the dropping of content
-types not supported by Emacs can utilize the X-specific interface
-described below:
+ Emacs implements receiving text and URLs individually for each
+window system, and does not by default support receiving other kinds
+of data as drops. To support receiving other kinds of data, use the
+X-specific interface described below:
@vindex x-dnd-test-function
@vindex x-dnd-known-types
- When a user drags something from another application over Emacs on
-the X Window System, that other application expects Emacs to tell it
-if Emacs can handle the data that was dragged. The variable
-@code{x-dnd-test-function} is used by Emacs to determine what to
-reply. The default value is @code{x-dnd-default-test-function} which
-accepts drops if the type of the data to be dropped is present in
-@code{x-dnd-known-types}. You can customize
-@code{x-dnd-test-function} and/or @code{x-dnd-known-types} if you want
-Emacs to accept or reject drops based on some other criteria.
+ When a user drags something from another application over Emacs
+under the X Window System, that other application expects Emacs to
+tell it if Emacs understands the data being dragged. The function in
+the variable @code{x-dnd-test-function} is called by Emacs to
+determine what to reply to any such inquiry. The default value is
+@code{x-dnd-default-test-function}, which accepts drops if the type of
+the data to be dropped is present in @code{x-dnd-known-types}.
+Changing the variables @code{x-dnd-test-function} and
+@code{x-dnd-known-types} can make Emacs accept or reject drops based
+on some other criteria.
@vindex x-dnd-types-alist
- If you want to change the way Emacs handles drop of different types
-or add a new type, customize @code{x-dnd-types-alist}. This requires
-detailed knowledge of what types other applications use for drag and
-drop.
-
- Those data types are typically implemented as special data types an
-X selection provided by the other application can be converted to.
-They can either be the same data types that are typically accepted by
-@code{gui-set-selection}, or they can be MIME types, depending on the
-specific drag-n-drop protocol being used. Plain text may be
-@code{"STRING"} or @code{"text/plain"}, for example.
+ If you want to change the way Emacs receives drops of different data
+types, or you want to enable it to understand a new type, change the variable
+@code{x-dnd-types-alist}. Doing so correctly requires detailed
+knowledge of what data types other applications use for drag and drop.
+
+ These data types are typically implemented as special data types
+that can be obtained from an X selection provided by the other
+application. In most cases, they are either the same data types that
+are typically accepted by @code{gui-set-selection}, or MIME types,
+depending on the specific drag-and-drop protocol being used. For
+example, the data type used for plain text may be either
+@code{"STRING"} or @code{"text/plain"}.
@vindex x-dnd-direct-save-function
+@c FIXME: This description is overly-complicated and confusing. In
+@c particular, the two calls to the function basically sound
+@c identical, so it is unclear how should the function distinguish
+@c between the first and the second one. The description of who asks
+@c whom to do what is also very hard to understand. Needs rewording,
+@c and needs shorter sentences. Perhaps examples could help.
However, @code{x-dnd-types-alist} does not handle a special kind of
-drop sent by a program which wants Emacs to save a file in a location
-Emacs must determine by itself. These drops are handled via the
-variable @code{x-dnd-direct-save-function}, which should be a function
-that accepts two arguments. If the first argument is non-@code{nil},
-then the second argument is a string describing the name (with no
-leading directory) that the other program recommends the file be saved
-under, and the function should return the complete file name under
-which it will be saved. Otherwise, the file has already been saved,
-and the second argument is the complete name of the file. The
-function should then perform whatever action is appropriate (i.e.,
-open the file or refresh the directory listing.)
+drop sent by a program that wants Emacs to tell it where to save a
+file in a specific location determined by the user. These drops are
+instead handled by a function that is the value of the variable
+@code{x-dnd-direct-save-function}. This function should accept two arguments.
+If the first argument is non-@code{nil}, then the second argument is a
+file name to save (with leading directories) that the other
+program recommends, and the
+function should return the full file name under which it should be
+saved. After the function completes, Emacs will ask the other program
+to save the file under the name that was returned, and if the file was
+successfully saved, call the function again with the first argument
+set to a non-@code{nil} value and the second argument set to the file
+name that was returned. The function should then perform whatever
+action is appropriate (i.e., opening the file or refreshing a
+directory listing.)
@cindex initiating drag-and-drop
On capable window systems, Emacs also supports dragging contents
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/modes.texi b/doc/lispref/modes.texi
index 434538dcbf..9527df33b8 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -198,7 +198,7 @@ on the hook. The optional argument @var{depth} lets you
indicate where the
function should be inserted in the list: it should then be a number
between -100 and 100 where the higher the value, the closer to the end of the
list the function should go. The @var{depth} defaults to 0 and for backward
-compatibility when @var{depth} is a non-nil symbol it is interpreted as a depth
+compatibility when @var{depth} is a non-@code{nil} symbol it is interpreted as
a depth
of 90. Furthermore, when @var{depth} is strictly greater than 0 the function
is added @emph{after} rather than before functions of the same depth.
One should never use a depth of 100 (or -100), because one can never be
@@ -1256,7 +1256,7 @@ will be a vector for the ID at @var{pos}. If there is no
entry at
@vindex tabulated-list-use-header-line
@defun tabulated-list-header-overlay-p &optional POS
-This @code{defsubst} returns non-nil if there is a fake header at
+This @code{defsubst} returns non-@code{nil} if there is a fake header at
@var{pos}. A fake header is used if
@code{tabulated-list-use-header-line} is @code{nil} to put the column
names at the beginning of the buffer. If omitted or @code{nil},
@@ -1269,7 +1269,7 @@ This function puts @var{tag} in the padding area of the
current line.
The padding area can be empty space at the beginning of the line, the
width of which is governed by @code{tabulated-list-padding}.
@var{tag} should be a string, with a length less than or equal to
-@code{tabulated-list-padding}. If @var{advance} is non-nil, this
+@code{tabulated-list-padding}. If @var{advance} is non-@code{nil}, this
function advances point by one line.
@end defun
@@ -1284,7 +1284,7 @@ This function changes the tabulated list entry at point,
setting
the name of the column to change. @var{desc} is the new column
descriptor, which is inserted via @code{tabulated-list-print-col}.
-If @var{change-entry-data} is non-nil, this function modifies the
+If @var{change-entry-data} is non-@code{nil}, this function modifies the
underlying data (usually the column descriptor in the list
@code{tabulated-list-entries}) by setting the column descriptor of the
vector to @code{desc}.
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index db6b4c35ef..da8df96854 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -507,7 +507,7 @@ string describing this signal.
Since there are processes violating this rule, returning exit codes
greater than 128 which are not bound to a signal, @code{process-file}
returns always the exit code as natural number for remote processes.
-Setting this user option to non-nil forces @code{process-file} to
+Setting this user option to non-@code{nil} forces @code{process-file} to
interpret such exit codes as signals, and to return a corresponding
string.
@end defopt
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 5ee139a11d..743718b560 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
@@ -1290,12 +1294,12 @@ Match any character that has whitespace syntax
@item @code{lower}, @code{lower-case}
Match anything lower-case, as determined by the current case table.
-If @code{case-fold-search} is non-nil, this also matches any
+If @code{case-fold-search} is non-@code{nil}, this also matches any
upper-case letter.
@item @code{upper}, @code{upper-case}
Match anything upper-case, as determined by the current case table.
-If @code{case-fold-search} is non-nil, this also matches any
+If @code{case-fold-search} is non-@code{nil}, this also matches any
lower-case letter.
@item @code{graph}, @code{graphic}
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi
index ea1e086ebf..2ef4f8c291 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
@@ -794,7 +794,7 @@ this case.
@end defvar
@defvar print-symbols-bare
-When bound to non-nil, the Lisp printer prints only the bare symbol of
+When bound to non-@code{nil}, the Lisp printer prints only the bare symbol of
a symbol with position, ignoring the position.
@end defvar
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 509ce56725..793c22949c 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -1525,7 +1525,7 @@ Some commands leave the region active after execution in
such a way that
it interferes with selective undo of that command. To make @code{undo}
ignore the active region when invoked immediately after such a command,
set the property @code{undo-inhibit-region} of the command's function
-symbol to a non-nil value. @xref{Standard Properties}.
+symbol to a non-@code{nil} value. @xref{Standard Properties}.
@node Maintaining Undo
@section Maintaining Undo Lists
@@ -4876,7 +4876,7 @@ If the optional argument @var{no-pad} is non-@code{nil}
then this
function doesn't generate the padding.
@end defun
-@deffn Command base64-decode-region beg end &optional base64url
+@deffn Command base64-decode-region beg end &optional base64url ignore-invalid
This function converts the region from @var{beg} to @var{end} from base
64 code into the corresponding decoded text. It returns the length of
the decoded text.
@@ -4885,9 +4885,11 @@ The decoding functions ignore newline characters in the
encoded text.
If optional argument @var{base64url} is non-@code{nil}, then padding
is optional, and the URL variant of base 64 encoding is used.
+If optional argument @var{ignore-invalid} is non-@code{nil}, then any
+unrecognized characters are ignored.
@end deffn
-@defun base64-decode-string string &optional base64url
+@defun base64-decode-string string &optional base64url ignore-invalid
This function converts the string @var{string} from base 64 code into
the corresponding decoded text. It returns a unibyte string containing the
decoded text.
@@ -4897,6 +4899,8 @@ The decoding functions ignore newline characters in the
encoded text.
If optional argument @var{base64url} is non-@code{nil}, then padding
is optional, and the URL variant of base 64 encoding is used.
+If optional argument @var{ignore-invalid} is non-@code{nil}, then any
+unrecognized characters are ignored.
@end defun
@node Checksum/Hash
@@ -5922,7 +5926,7 @@ methods if these concepts apply to the transport. If
they do, then
any system resources (e.g.@: processes, timers, etc.) used to listen for
messages on the wire should be released in @code{jsonrpc-shutdown},
i.e.@: they should only be needed while @code{jsonrpc-running-p} is
-non-nil.
+non-@code{nil}.
@end enumerate
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index cbe276b2dc..7206f2acd2 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -1183,7 +1183,7 @@ Here is an example:
(let ((x 0)) ; @r{@code{x} is lexically bound.}
(setq my-ticker (lambda ()
(setq x (1+ x)))))
- @result{} (closure ((x . 0) t) ()
+ @result{} (closure ((x . 0)) ()
(setq x (1+ x)))
(funcall my-ticker)
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index e946a408fd..37884faec7 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -2624,7 +2624,7 @@ default value is an empty display action, i.e.,
@w{@code{(nil . nil)}}.
The value of this option is an alist mapping conditions to display
actions. Each condition is passed to @code{buffer-match-p}, along
with the buffer name and the @var{action} argument passed to
-@code{display-buffer}. If it returns a non-nil value, then
+@code{display-buffer}. If it returns a non-@code{nil} value, then
@code{display-buffer} uses the corresponding display action to display
the buffer.
@end defopt
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index ab41737794..bade04fb95 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -2191,7 +2191,7 @@ foo& bar
@defvar c-asymmetry-fontification-flag
@vindex asymmetry-fontification-flag @r{(c-)}
-When @code{c-asymmetry-fontification-flag} is non-nil (which it is by
+When @code{c-asymmetry-fontification-flag} is non-@code{nil} (which it is by
default), code like the above, with white space either before or after
the operator, but not both, is fontified as a declaration. When the
variable is nil, such a construct gets the default face.
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index a6747b1096..e4b344f267 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -4051,7 +4051,7 @@ following keywords can be used:
@table @code
@item :read-only
-A non-nil value means the slot should not be @code{setf}-able;
+A non-@code{nil} value means the slot should not be @code{setf}-able;
the slot's value is determined when the object is created and does
not change afterward.
diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi
index 033464f990..5a20028702 100644
--- a/doc/misc/eglot.texi
+++ b/doc/misc/eglot.texi
@@ -72,12 +72,12 @@ Eglot is the Emacs client for the @dfn{Language Server
Protocol}
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
+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 functions calls, types of variables, class
+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
@@ -525,7 +525,7 @@ Emacs Development Environment (@pxref{EDE,,, emacs, GNU
Emacs
Manual}).
@end itemize
-Eglot uses the Emacs's project management infrastructure to figure out
+Eglot uses 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.
@@ -588,8 +588,8 @@ 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
+user, but automatically, as the 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
@@ -614,7 +614,7 @@ visiting the file.
@section Eglot Commands
@cindex commands, Eglot
-This section provides a reference of the most commonly used Eglot
+This section provides a reference for the most commonly used Eglot
commands:
@ftable @code
@@ -672,7 +672,7 @@ 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
+then modifies all the files in the project which are managed by the
language server of the current buffer to implement the renaming.
@item M-x eglot-format
@@ -775,13 +775,13 @@ Request completion of the symbol at point.
@section Eglot Variables
@cindex variables, Eglot
-This section provides a reference of the Eglot' user options.
+This section provides a reference for 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
+unexpectedly. The default value @code{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
@@ -798,10 +798,10 @@ out. The default is 30 seconds.
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
+user interface while waiting. The default value is @code{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
+waiting period. The value of @code{nil} or @code{0} means don't block at
all during the waiting period.
@item eglot-events-buffer-size
@@ -885,7 +885,7 @@ destination, customize the ElDoc variable
@code{eldoc-display-functions}.
@end itemize
-For this reason, this manual describes only how to customize the
+For this reason, this manual describes only how to customize
Eglot's own operation, which mainly has to do with the server
connections and the server features to be used by Eglot.
@@ -919,12 +919,12 @@ A hook run after Eglot started or stopped managing a
buffer.
@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
+automatically try to manage on the 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
+To have Eglot stay away from 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
+@samp{company} to stay away from your Company customizations. Here's an
example:
@lisp
@@ -949,7 +949,7 @@ tuning of per-project settings via the variable
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
+connection) or when the settings are changed, or in response to a
configuration request from the server.
In many cases, servers can be configured globally using a
@@ -958,12 +958,12 @@ 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
+If possible, we recommend using those 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
+server, we recommend defining 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:
@@ -989,9 +989,10 @@ 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):
+the other one for Go (presumably, the project is written in a
+combination of these two languages). The server for Python in this
+case is @command{pylsp}, the server for Go is @command{gopls}. The
+value of @code{eglot-workspace-configuration} in this case should be:
@lisp
((python-mode
@@ -1104,9 +1105,9 @@ sure to repeat the process after toggling
@code{debug-on-error} on
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.
+An explanation of how to obtain, install, and configure 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
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index 2945c05e85..ff368c9dc4 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -800,12 +800,12 @@ command-line switch:
@table @var
@item short
-This element, if non-nil, should be a character to be used as a short
+This element, if non-@code{nil}, should be a character to be used as a short
switch, like @code{-@var{short}}. At least one of this element and
-@var{long} must be non-nil.
+@var{long} must be non-@code{nil}.
@item long
-This element, if non-nil, should be a string to be used as a long
+This element, if non-@code{nil}, should be a string to be used as a long
switch, like @code{--@var{long}}.
@item value
diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi
index 7406557623..da1695099a 100644
--- a/doc/misc/flymake.texi
+++ b/doc/misc/flymake.texi
@@ -312,7 +312,7 @@ been reported.
Which fringe (if any) should show the warning/error bitmaps.
@item flymake-wrap-around
-If non-nil, moving to errors with @code{flymake-goto-next-error} and
+If non-@code{nil}, moving to errors with @code{flymake-goto-next-error} and
@code{flymake-goto-prev-error} wraps around buffer boundaries.
@end vtable
@@ -878,7 +878,7 @@ line-idx col-idx err-text-idx)}. @xref{Parsing the output}.
@item flymake-proc-diagnostic-type-pred
A function to classify a diagnostic text as particular type of error.
Should be a function taking an error text and returning a diagnostic
-symbol (@pxref{Flymake error types}). If non-nil is returned but
+symbol (@pxref{Flymake error types}). If non-@code{nil} is returned but
there is no such symbol in that table, a warning is assumed. If nil
is returned, an error is assumed. Can also be a regular expression
that should match only warnings. This variable replaces the old
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index ec728c09ad..7bcf334297 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -10497,7 +10497,7 @@ normally, but it'll make this command work a whole lot
faster. Of
course, it'll make group entry somewhat slow.
@vindex gnus-refer-thread-use-search
-If @code{gnus-refer-thread-use-search} is non-nil then those backends
+If @code{gnus-refer-thread-use-search} is non-@code{nil} then those backends
that know how to find threads directly will search not just in the
current group but all groups on the same server.
@@ -10515,7 +10515,7 @@ is true and the initial referral starts from a summary
buffer for a
non-virtual group this may not be possible. In this case a new
summary buffer is created holding a virtual group with the result of
the thread search.) If @code{gnus-refer-thread-limit-to-thread} is
-non-nil then the summary buffer will be limited to articles in the
+non-@code{nil} then the summary buffer will be limited to articles in the
thread.
@item M-^ (Summary)
@@ -21569,7 +21569,7 @@ Search Groups}).
Search queries can be specified one of two ways: either using the
syntax of the engine responsible for the group you're searching, or
using Gnus' generalized search syntax. Set the option
-@code{gnus-search-use-parsed-queries} to a non-nil value to used the
+@code{gnus-search-use-parsed-queries} to a non-@code{nil} value to used the
generalized syntax. The advantage of this syntax is that, if you have
multiple backends indexed by different engines, you don't need to
remember which one you're searching---it's also possible to issue the
@@ -26329,7 +26329,7 @@ size, it will reject insertion of new entries.
@end defvar
@defvar gnus-registry-register-all
-If this option is non-nil, the registry will register all messages, as
+If this option is non-@code{nil}, the registry will register all messages, as
you see them. This is important to making split-to-parent and
Message-ID references work correctly, as the registry needs to know
where all messages are, but it can slow down group opening and the
@@ -26429,7 +26429,7 @@ have to put a rule like this:
in your fancy split setup.
-If @code{gnus-registry-register-all} is non-nil (the default), the
+If @code{gnus-registry-register-all} is non-@code{nil} (the default), the
registry will perform splitting for all messages. If it is nil,
splitting will only happen for children of messages you've explicitly
registered.
@@ -26508,7 +26508,7 @@ Store @code{value} under @code{key} for message
@code{id}.
@defun gnus-registry-get-id-key (id key)
Get the data under @code{key} for message @code{id}. If the option
-@code{gnus-registry-register-all} is non-nil, this function will also
+@code{gnus-registry-register-all} is non-@code{nil}, this function will also
create an entry for @code{id} if one doesn't exist.
@end defun
@@ -26633,7 +26633,7 @@ connections after the system resumes. On systems
compiled with D-Bus
support (check the value of @code{(featurep 'dbusbind)}), Gnus can
register a D-Bus signal to automatically close all server connections
before the system goes to sleep. To enable this, set
-@code{gnus-dbus-close-on-sleep} to a non-nil value.
+@code{gnus-dbus-close-on-sleep} to a non-@code{nil} value.
For more information about D-Bus and Emacs, @pxref{Top,,, dbus, D-Bus
integration in Emacs}.
diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org
index 2680fe9eb5..c5accd0789 100644
--- a/doc/misc/modus-themes.org
+++ b/doc/misc/modus-themes.org
@@ -4,9 +4,9 @@
#+language: en
#+options: ':t toc:nil author:t email:t num:t
#+startup: content
-#+macro: stable-version 2.7.0
-#+macro: release-date 2022-10-01
-#+macro: development-version 2.8.0-dev
+#+macro: stable-version 3.0.0
+#+macro: release-date 2022-10-28
+#+macro: development-version 3.1.0-dev
#+macro: file @@texinfo:@file{@@$1@@texinfo:}@@
#+macro: space @@texinfo:@: @@
#+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@
@@ -35,6 +35,7 @@ Current development target is {{{development-version}}}.
+ Homepage: https://protesilaos.com/emacs/modus-themes.
+ Git repository: https://git.sr.ht/~protesilaos/modus-themes.
+ Mailing list: https://lists.sr.ht/~protesilaos/modus-themes.
++ Backronym: My Old Display Unexpectedly Sharpened ... themes
#+toc: headlines 8 insert TOC here, with eight headline levels
@@ -632,7 +633,7 @@ to user options to take effect
([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enabl
:end:
#+vindex: modus-themes-deuteranopia
-Brief: When non-nil use red/blue color-coding instead of red/green,
+Brief: When non-~nil~ use red/blue color-coding instead of red/green,
where appropriate.
Symbol: ~modus-themes-deuteranopia~ (=boolean= type)
@@ -679,7 +680,7 @@ Possible values:
The default is to use a bold typographic weight only when it is
required.
-With a non-nil value (~t~) display several syntactic constructs in bold
+With a non-~nil~ value (~t~) display several syntactic constructs in bold
weight. This concerns keywords and other important aspects of code
syntax. It also affects certain mode line indicators and command-line
prompts.
@@ -709,7 +710,7 @@ Possible values:
The default is to not use slanted text forms (italics) unless it is
absolutely necessary.
-With a non-nil value (~t~) choose to render more faces in italics. This
+With a non-~nil~ value (~t~) choose to render more faces in italics. This
typically affects documentation strings and code comments.
Advanced users may also want to configure the exact attributes of the
@@ -799,7 +800,7 @@ Possible values:
1. ~nil~ (default)
2. ~t~
-When set to non-nil (~t~), configure some spacing-sensitive faces like Org
+When set to non-~nil~ (~t~), configure some spacing-sensitive faces like Org
tables and code blocks to always inherit from the ~fixed-pitch~ face.
This is to ensure that certain constructs like code blocks and tables
remain monospaced even when users opt for a mode that remaps typeface
@@ -926,8 +927,8 @@ an empty list). The list can include any of the following
symbols:
the form of =(height . FLOAT)=
+ ~all-buttons~
-The default (a nil value or an empty list) is a gray background combined
-with a pseudo three-dimensional effect.
+The default (a ~nil~ value or an empty list) is a gray background
+combined with a pseudo three-dimensional effect.
The ~flat~ property makes the button two dimensional.
@@ -1068,7 +1069,7 @@ effect, color, and border visibility:
+ A floating point to set the height of the mode line's text. It can
also be a cons cell in the form of ~(height . FLOAT)~.
-The default (a nil value or an empty list) is a two-dimensional
+The default (a ~nil~ value or an empty list) is a two-dimensional
rectangle with a border around it. The active and the inactive mode
lines use different shades of grayscale values for the background,
foreground, border.
@@ -1097,7 +1098,7 @@ of NATNUM pixels at the boundaries of the mode lines.
The default value
is 1 and does not need to be specified explicitly. The padding has no
effect when the ~moody~ property is also used, because Moody already
applies its own tweaks. To ensure that the underline is placed at the
-bottom of the mode line, set ~x-underline-at-descent-line~ to non-nil
+bottom of the mode line, set ~x-underline-at-descent-line~ to non-~nil~
(this is not needed when the ~borderless~ property is also set). For
users on Emacs 29, the ~x-use-underline-position-properties~ variable must
also be set to nil.
@@ -1159,7 +1160,7 @@ colors (which have been carefully designed to be highly
accessible).
Furthermore, because Moody expects an underline and overline instead of
a box style, it is strongly advised to set ~x-underline-at-descent-line~
-to a non-nil value.
+to a non-~nil~ value.
Finally, note that various packages which heavily modify the mode line,
such as =doom-modeline=, =nano-modeline=, =powerline=, =spaceline= may not look
@@ -1183,7 +1184,7 @@ Possible values:
+ ~t~
By default, all tab interfaces use backgrounds which are shades of gray.
-When this option is set to non-nil, the backgrounds become colorful.
+When this option is set to non-~nil~, the backgrounds become colorful.
This affects the built-in ~tab-bar-mode~ and ~tab-line-mode~, as well as the
Centaur tabs package.
@@ -1202,8 +1203,9 @@ Symbol: ~modus-themes-completions~ (=alist= type
properties)
This affects Company, Corfu, Flx, Helm, Icomplete/Fido, Ido, Ivy,
Orderless, Selectrum, Vertico. The value is an alist that takes the
-form of a =(key . properties)= combination. Here is a sample, followed
-by a description of the particularities:
+form of a =(KEY . PROPERTIES)= combination. =KEY= is a symbol, while
+=PROPERTIES= is a list. Here is a sample, followed by a description
+of the particularities:
#+begin_src emacs-lisp
(setq modus-themes-completions
@@ -1213,10 +1215,10 @@ by a description of the particularities:
#+end_src
The ~matches~ key refers to the highlighted characters that correspond
-to the user's input. By default (nil or an empty list), they have a
-bold weight and a colored foreground. The list of properties may
-include any of the following symbols regardless of the order they may
-appear in:
+to the user's input. When its properties are ~nil~ or an empty list,
+matching characters in the user interface will have a bold weight and
+a colored foreground. The list of properties may include any of the
+following symbols regardless of the order they may appear in:
- ~background~ to add a background color;
@@ -1232,10 +1234,10 @@ appear in:
variable. The absence of a weight means that bold will be used.
The ~selection~ key applies to the current line or currently matched
-candidate, depending on the specifics of the User Interface. By default
-(nil or an empty list), it has a subtle gray background, a bold weight,
-and the base foreground value for the text. The list of properties it
-accepts is as follows (order is not significant):
+candidate, depending on the specifics of the user interface. When its
+properties are ~nil~ or an empty list, it has a subtle gray background,
+a bold weight, and the base foreground value for the text. The list
+of properties it accepts is as follows (order is not significant):
- ~accented~ to make the background colorful instead of gray;
@@ -1251,7 +1253,11 @@ accepts is as follows (order is not significant):
cetera. Valid symbols are defined in the ~modus-themes-weights~
variable. The absence of a weight means that bold will be used.
-The ~popup~ key takes the same values as ~selection~.
+The ~popup~ key takes the same values as ~selection~. The only
+difference is that it applies specifically to user interfaces that
+display an inline popup and thus have slightly different styling
+requirements than the minibuffer. The two prominent packages are
+=company= and =corfu=.
Apart from specifying each key separately, a fallback list is accepted.
This is only useful when the desired aesthetic is the same across all
@@ -1276,21 +1282,10 @@ corresponding key is simply ignored (~matches~ does not
have ~accented~
and ~text-also~, while ~selection~ and ~popup~ do not have
~background~).
-A concise expression of those associations can be written as follows,
-where the ~car~ is always the key and the ~cdr~ is the list of
-properties (whatever order they may appear in):
-
-#+begin_src emacs-lisp
-(setq modus-themes-completions
- '((matches extrabold background intense)
- (selection semibold accented intense)
- (popup accented)))
-#+end_src
-
[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]].
-Also refer to the Orderless documentation for its intersection with
-Company (if you choose to use those in tandem).
+Also refer to the documentation of the ~orderless~ package for its
+intersection with ~company~ (if you choose to use those in tandem).
** Option for mail citations
:properties:
@@ -1312,7 +1307,7 @@ Possible values:
3. ~faint~
4. ~monochrome~
-By default (a nil value) citations are styled with contrasting hues to
+By default (a ~nil~ value) citations are styled with contrasting hues to
denote their depth. Colors are easy to tell apart because they
complement each other, but they otherwise are not very prominent.
@@ -1342,17 +1337,16 @@ Symbol: ~modus-themes-fringes~ (=choice= type)
Possible values:
-1. ~nil~ (default)
+1. ~nil~
2. ~subtle~
3. ~intense~
-The default is to use the same color as that of the main background,
-meaning that the fringes are not obvious though they still occupy the
-space given to them by ~fringe-mode~.
+When the value is nil, do not apply a distinct background color.
-Options ~subtle~ and ~intense~ apply a gray background, making the fringes
-visible. The difference between the two is one of degree, as their
-names imply.
+With a value of ~subtle~ use a gray background color that is
+visible yet close to the main background color.
+
+With ~intense~ use a more pronounced gray background color.
** Option for language checkers
:properties:
@@ -1435,16 +1429,16 @@ Brief: Control the style of the current line of
~hl-line-mode~.
Symbol: ~modus-themes-hl-line~ (=choice= type, list of properties)
-Possible values are expressed as a list of properties (default is ~nil~ or
-an empty list). The list can include any of the following symbols:
+The value is a list of properties, each designated by a symbol. With
+a ~nil~ value, or an empty list, the style is a subtle gray background
+color.
+
+Possible properties are the following symbols:
+ ~accented~
+ ~intense~
+ ~underline~
-The default (a ~nil~ value or an empty list) is a subtle gray background
-color.
-
The property ~accented~ changes the background to a colored variant.
An ~underline~ property draws a line below the highlighted area. Its
@@ -1471,8 +1465,9 @@ In user configuration files the form may look like this:
(setq modus-themes-hl-line '(underline accented))
#+end_src
-Set ~x-underline-at-descent-line~ to a non-nil value for better results
-with underlines.
+Set ~x-underline-at-descent-line~ to a non-~nil~ value so that the
+placement of the underline coincides with the lower boundary of the
+colored background.
This style affects several packages that enable ~hl-line-mode~, such as
=elfeed=, =notmuch=, and =mu4e=.
@@ -1506,7 +1501,7 @@ Similarly, the faces for
~display-line-numbers-major-tick~ and its
counterpart ~display-line-numbers-minor-tick~ use appropriate styles that
involve a bespoke background and foreground combination.
-With a non-nil value (~t~), line numbers have no background of their own.
+With a non-~nil~ value (~t~), line numbers have no background of their own.
Instead they retain the primary background of the theme, blending with
the rest of the buffer. Foreground values for all relevant faces are
updated to accommodate this aesthetic.
@@ -1529,7 +1524,7 @@ Possible value:
2. ~t~
By default all mouseover effects apply a highlight with a subtle colored
-background. When non-nil, these have a more pronounced effect.
+background. When non-~nil~, these have a more pronounced effect.
Note that this affects the generic ~highlight~ which, strictly speaking,
is not limited to mouse usage.
@@ -1713,11 +1708,11 @@ Option ~desaturated~ follows the same principles as
with the default
(~nil~), though it tones down all relevant colors.
Option ~bg-only~ applies a background but does not override the text's
-foreground. This makes it suitable for a non-nil value passed to
+foreground. This makes it suitable for a non-~nil~ value passed to
~diff-font-lock-syntax~ (note: Magit does not support syntax highlighting
in diffs---last checked on 2021-12-02).
-When the user option ~modus-themes-deuteranopia~ is non-nil, all diffs
+When the user option ~modus-themes-deuteranopia~ is non-~nil~, all diffs
will use a red/blue color-coding system instead of the standard
red/green. Other stylistic changes are made in the interest of
optimizing for such a use-case.
@@ -1776,8 +1771,8 @@ of the block. Disable the extension of such backgrounds
by setting
~org-fontify-whole-block-delimiter-line~ to nil.
Code blocks use their major mode's colors only when the variable
-~org-src-fontify-natively~ is non-nil. While quote/verse blocks require
-setting ~org-fontify-quote-and-verse-blocks~ to a non-nil value.
+~org-src-fontify-natively~ is non-~nil~. While quote/verse blocks require
+setting ~org-fontify-quote-and-verse-blocks~ to a non-~nil~ value.
[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][Update Org block delimiter
fontification]].
@@ -1894,7 +1889,7 @@ An ~event~ key covers (i) headings with a plain time
stamp that are
shown on the agenda, also known as events, (ii) entries imported from
the diary, and (iii) other items that derive from a symbolic expression
or sexp (phases of the moon, holidays, etc.). By default all those look
-the same and have a subtle foreground color (the default is a nil value
+the same and have a subtle foreground color (the default is a ~nil~ value
or an empty list). This key accepts a list of properties. Those are:
- ~accented~ applies an accent value to the event's foreground,
@@ -1925,7 +1920,7 @@ A ~scheduled~ key applies to tasks with a scheduled date.
By default (a
~nil~ value), those use varying shades of yellow to denote (i) a past or
current date and (ii) a future date. Valid values are symbols:
-- nil (default);
+- ~nil~ (default);
- ~uniform~ to make all scheduled dates the same color;
- ~rainbow~ to use contrasting colors for past, present, future
scheduled dates.
@@ -1963,7 +1958,7 @@ passed as a symbol. Those are:
being too late. The difference between ready and clear states is
attenuated by painting both of them using shades of green. This
option thus highlights the alert and overdue states.
-- When ~modus-themes-deuteranopia~ is non-nil the exact style of the habit
+- When ~modus-themes-deuteranopia~ is non-~nil~ the exact style of the habit
graph adapts to the needs of users with red-green color deficiency by
substituting every instance of green with blue or cyan (depending on
the specifics).
@@ -2108,7 +2103,7 @@ In user configuration files the form may look like this:
#+end_src
When defining the styles per heading level, it is possible to pass a
-non-nil value (~t~) instead of a list of properties. This will retain the
+non-~nil~ value (~t~) instead of a list of properties. This will retain the
original aesthetic for that level. For example:
#+begin_src emacs-lisp
@@ -2153,7 +2148,7 @@ and tab line.
The default is to use the same font as the rest of Emacs, which usually
is a monospaced family.
-With a non-nil value (~t~) apply a proportionately spaced typeface. This
+With a non-~nil~ value (~t~) apply a proportionately spaced typeface. This
is done by assigning the ~variable-pitch~ face to the relevant items.
[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and
others]].
@@ -4681,6 +4676,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ notmuch
+ num3-mode
+ nxml-mode
++ olivetti
+ orderless
+ org*
+ org-journal
@@ -4753,7 +4749,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ tab-bar-groups
+ tab-bar-mode
+ tab-line-mode
-+ table (built-in table.el)
++ table (built-in {{{file(table.el)}}})
+ telega
+ telephone-line
+ terraform-mode
@@ -4768,7 +4764,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ tuareg
+ typescript
+ undo-tree
-+ vc (vc-dir.el, vc-hooks.el)
++ vc ({{{file(vc-dir.el)}}}, {{{file(vc-hooks.el)}}})
+ vertico
+ vertico-quick
+ vimish-fold
@@ -4793,8 +4789,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ yasnippet
+ ztree
-Plus many other miscellaneous faces that are provided by the upstream
-GNU Emacs distribution.
+Plus many other miscellaneous faces that are provided by Emacs.
** Indirectly covered packages
:properties:
@@ -5397,7 +5392,7 @@ https://github.com/tumashu/company-posframe/]
:custom_id: h:98bdf319-1e32-4469-8a01-771200fba65c
:end:
-The built-in IRC client ~erc~ has the ability to colorise any text using
+The built-in IRC client ~erc~ has the ability to colorize any text using
escape sequences that start with =^C= (inserted with {{{kbd(C-q C-c)}}}) and
are
followed by a number for the foreground and background.[fn:: This page
explains the basics, though it is not specific to Emacs:
@@ -5453,7 +5448,7 @@ Consult the doc string of ~shr-use-colors~.
By default, packages that build on top of the Simple HTML Remember (=shr=)
use proportionately spaced fonts. This is controlled by the user option
-~shr-use-fonts~, which is set to non-nil by default. To use the standard
+~shr-use-fonts~, which is set to non-~nil~ by default. To use the standard
font instead, set that variable to nil.
[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and
others]].
@@ -5543,9 +5538,9 @@ ANSI color number 1 (red) from the already-supported
array of
:end:
Hints are drawn by [[https://imagemagick.org/][ImageMagick]], not Emacs, i.e.,
ImageMagick doesn't
-know about the hint face unless you tell ImageMagick about it. By
+know about the hint face unless you tell ImageMagick about it. By
default, only the foreground and background color attributes are
-passed. The below snippet adds to those the various font attributes. As
+passed. The below snippet adds to those the various font attributes. As
it queries various faces, specifically ~pdf-links-read-link~ and the faces
it inherits, it needs to be added to your initialization file after
you've customized any faces.
@@ -5816,9 +5811,9 @@ In general, an additional source of light other than that
of the monitor
can help reduce eye strain: the eyes are more relaxed when they do not
have to focus on one point to gather light.
-The monitor's display settings must be accounted for. Gamma values, in
+The monitor's display settings must be accounted for. Gamma values, in
particular, need to be calibrated to neither amplify nor distort the
-perception of black. Same principle for sharpness, brightness, and
+perception of black. Same principle for sharpness, brightness, and
contrast as determined by the hardware, which all have an effect on how
text is read on the screen.
@@ -5956,7 +5951,7 @@ the themes, which is partially fleshed out in this manual.
With regard to the artistic aspect (where "art" qua skill may amount to
an imprecise science), there is no hard-and-fast rule in effect as it
-requires one to exercise discretion and make decisions based on
+requires one to exercize discretion and make decisions based on
context-dependent information or constraints. As is true with most
things in life, when in doubt, do not cling on to the letter of the law
but try to understand its spirit.
@@ -6125,22 +6120,22 @@ The Modus themes are a collective effort. Every bit of
work matters.
Yiltiz, Ilja Kocken, Iris Garcia, Ivan Popovych, Jeremy Friesen,
Jerry Zhang, Johannes Grødem, John Haman, Jonas Collberg, Jorge
Morais, Joshua O'Connor, Julio C. Villasante, Kenta Usami, Kevin
- Fleming, Kévin Le Gouguec, Kostadin Ninev, Len Trigg, Lennart
- C. Karssen, Luis Miguel Castañeda, Magne Hov, Manuel Uberti, Mark
- Bestley, Mark Burton, Mark Simpson, Markus Beppler, Matt Armstrong,
- Mauro Aranda, Maxime Tréca, Michael Goldenberg, Morgan Smith, Morgan
- Willcock, Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere,
- Paul Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, Philip
- Kaludercic, Pierre Téchoueyres, Przemysław Kryger, Robert Hepple,
- Roman Rudakov, Ryan Phillips, Rytis Paškauskas, Rudolf Adamkovič,
- Sam Kleinman, Samuel Culpepper, Saša Janiška, Shreyas Ragavan, Simon
- Pugnet, Tassilo Horn, Thibaut Verron, Thomas Heartman, Togan
- Muftuoglu, Tony Zorman, Trey Merkley, Tomasz Hołubowicz, Toon Claes,
- Uri Sharf, Utkarsh Singh, Vincent Foley. As well as users: Ben,
- CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji,
- Nick, Summer Emacs, TheBlob42, Trey, bepolymathe, bit9tream,
- derek-upham, doolio, fleimgruber, gitrj95, iSeeU, jixiuf, okamsn,
- pRot0ta1p.
+ Fleming, Kévin Le Gouguec, Kevin Kainan Li, Kostadin Ninev, Len
+ Trigg, Lennart C. Karssen, Luis Miguel Castañeda, Magne Hov, Manuel
+ Uberti, Mark Bestley, Mark Burton, Mark Simpson, Markus Beppler,
+ Matt Armstrong, Matthias Fuchs, Mauro Aranda, Maxime Tréca, Michael
+ Goldenberg, Morgan Smith, Morgan Willcock, Murilo Pereira, Nicky van
+ Foreest, Nicolas De Jaeghere, Pablo Stafforini, Paul Poloskov,
+ Pengji Zhang, Pete Kazmier, Peter Wu, Philip Kaludercic, Pierre
+ Téchoueyres, Przemysław Kryger, Robert Hepple, Roman Rudakov, Ryan
+ Phillips, Rytis Paškauskas, Rudolf Adamkovič, Sam Kleinman, Samuel
+ Culpepper, Saša Janiška, Shreyas Ragavan, Simon Pugnet, Tassilo
+ Horn, Thibaut Verron, Thomas Heartman, Togan Muftuoglu, Tony Zorman,
+ Trey Merkley, Tomasz Hołubowicz, Toon Claes, Uri Sharf, Utkarsh
+ Singh, Vincent Foley. As well as users: Ben, CsBigDataHub1, Emacs
+ Contrib, Eugene, Fourchaux, Fredrik, Moesasji, Nick, Summer Emacs,
+ TheBlob42, Trey, bepolymathe, bit9tream, derek-upham, doolio,
+ fleimgruber, gitrj95, iSeeU, jixiuf, okamsn, pRot0ta1p.
+ Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii,
Glenn Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core
diff --git a/doc/misc/newsticker.texi b/doc/misc/newsticker.texi
index 92dba55c01..fec571d923 100644
--- a/doc/misc/newsticker.texi
+++ b/doc/misc/newsticker.texi
@@ -172,7 +172,7 @@ is fetched for the very first time.
@vindex newsticker-obsolete-item-max-age
@item newsticker-keep-obsolete-items
Obsolete headlines are removed immediately unless
-@code{newsticker-keep-obsolete-items} is non-nil in which case they
+@code{newsticker-keep-obsolete-items} is non-@code{nil} in which case they
are kept until @code{newsticker-obsolete-item-max-age} is reached.
@vindex newsticker-automatically-mark-items-as-old
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/rcirc.texi b/doc/misc/rcirc.texi
index 307fe55a63..84933a9ca7 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -259,7 +259,7 @@ Use @kbd{C-c C-@key{SPC}} to switch to these buffers.
@vindex rcirc-track-ignore-server-buffer-flag
If the user wishes to ignore events in the server buffer, set
-@code{rcirc-track-ignore-server-buffer-flag} to a non-nil value.
+@code{rcirc-track-ignore-server-buffer-flag} to a non-@code{nil} value.
@node Reference
@chapter Reference
@@ -693,7 +693,7 @@ buffers.
@cindex rcirc-track-abbrevate-flag
By default the channel names are abbreviated, set
-@code{rcirc-track-abbrevate-flag} to a non-nil value. This might be
+@code{rcirc-track-abbrevate-flag} to a non-@code{nil} value. This might be
interesting if the IRC activities are not tracked in the mode line,
but somewhere else.
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/tramp.texi b/doc/misc/tramp.texi
index 7de64829c0..99a268367b 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3532,9 +3532,14 @@ the @file{~/.authinfo.gpg} authentication file. The
user option
@code{tramp-completion-use-auth-sources} controls, whether such a
search is performed during completion.
+@vindex tramp-completion-use-cache
Remote hosts previously visited or hosts whose connections are kept
persistently (@pxref{Connection caching}) will be included in the
-completion lists.
+completion lists. If you want to suppress this completion because
+there are invalid entries in the persistency file, for example if the
+host configuration changes often, or if you plug your laptop to
+different networks frequently, you can set the user option
+@code{tramp-completion-use-cache} to nil.
After remote host name completion comes completion of file names on
the remote host. It works the same as with local host file completion
diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi
index 24c3090ef7..a6745131d8 100644
--- a/doc/misc/transient.texi
+++ b/doc/misc/transient.texi
@@ -945,7 +945,7 @@ that multiple suffix commands can be bound to the same key,
provided
they are never active at the same time, see @ref{Predicate Slots}.
Unfortunately both false-positives and false-negatives are possible.
-To deal with the former use non-nil @var{KEEP-OTHER@.} To deal with the
+To deal with the former use non-@code{nil} @var{KEEP-OTHER@.} To deal with the
latter remove the conflicting binding explicitly.
@end defun
diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index 546639b017..420a2b56c5 100644
--- a/doc/misc/url.texi
+++ b/doc/misc/url.texi
@@ -268,7 +268,7 @@ argument is @code{nil}, the allowed characters are those
specified as
@dfn{unreserved characters} by RFC 3986 (see the variable
@code{url-unreserved-chars}). Otherwise, @var{allowed-chars} should
be either a list of allowed chars, or a vector whose Nth element is
-non-nil if character N is allowed.
+non-@code{nil} if character N is allowed.
@end defun
@defun url-unhex-string string &optional allow-newlines
diff --git a/etc/NEWS b/etc/NEWS
index 19c9014116..cbde7afecb 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -105,29 +105,20 @@ configuration on X is known to have problems, such as
undesirable
frame positioning and various issues with keyboard input of sequences
such as 'C-;' and 'C-S-u'.
+---
+** The implementation of overlays has changed.
+Emacs now uses an implementation of overlays that is much more
+efficient than the original one, and should speed up all the
+operations that involve overlays, especially when there are lots of
+them in a buffer. However, no changes in behavior of overlays should
+be visible on the Lisp or user level, with the exception of better
+performance.
+
---
** The docstrings of preloaded files are not in "etc/DOC" any more.
Instead, they're fetched as needed from the corresponding ".elc" file,
as was already the case for all the non-preloaded files.
-** Emacs Sessions (Desktop)
-
-+++
-*** New user option to load a locked desktop if locking Emacs is not running.
-The option 'desktop-load-locked-desktop' can now be set to the value
-'check-pid', which means to allow loading a locked ".emacs.desktop"
-file if the Emacs process which locked it is no longer running on the
-local machine. This allows avoiding questions about locked desktop
-files when the Emacs session which locked it crashes, or was otherwise
-interrupted, and didn't exit gracefully. See the "(emacs) Saving
-Emacs Sessions" node in the Emacs manual for more details.
-
-** Miscellaneous
-
-+++
-*** User option 'minibuffer-eldef-shorten-default' is now obsolete.
-Customize the user option 'minibuffer-default-prompt-format' instead.
-
* Startup Changes in Emacs 29.1
@@ -1036,15 +1027,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
@@ -1581,6 +1568,18 @@ packages checked out using 'package-vc-install'.
This command helps you compose an email for sending bug reports to
package maintainers.
+** Emacs Sessions (Desktop)
+
++++
+*** New user option to load a locked desktop if locking Emacs is not running.
+The option 'desktop-load-locked-desktop' can now be set to the value
+'check-pid', which means to allow loading a locked ".emacs.desktop"
+file if the Emacs process which locked it is no longer running on the
+local machine. This allows avoiding questions about locked desktop
+files when the Emacs session which locked it crashes, or was otherwise
+interrupted, and didn't exit gracefully. See the "(emacs) Saving
+Emacs Sessions" node in the Emacs manual for more details.
+
** Miscellaneous
+++
@@ -1657,7 +1656,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.
---
@@ -1719,6 +1718,10 @@ but completes on the history items instead of the
default completion
table. 'minibuffer-complete-defaults' ('C-x <down>') completes
on the list of default items.
++++
+*** User option 'minibuffer-eldef-shorten-default' is now obsolete.
+Customize the user option 'minibuffer-default-prompt-format' instead.
+
+++
*** New user option 'completions-sort'.
This option controls the sorting of the completion candidates in
@@ -2075,6 +2078,18 @@ Formerly it was a pair of numbers '(A B)' that
represented 65536*A + B,
to cater to older Emacs implementations that lacked bignums.
The older form still works but is undocumented.
+** Rmail
+
+---
+*** Rmail partial summaries can now be applied one on top of the other.
+You can now narrow the filtering of messages by the summary's criteria
+(recipients, topic, senders, etc.) by making a summary of the already
+summarized messages. For example, invoking 'rmail-summary-by-senders',
+followed by 'rmail-summary-by-topic' will produce a summary where both
+the senders and the topic are according to your selection. The new
+user option 'rmail-summary-apply-filters-consecutively' controls
+whether the stacking of the filters is in effect.
+
** EIEIO
+++
@@ -2541,6 +2556,12 @@ the user requesting such a connection, and not of the
user who is the
target. This has always been needed, just the password prompt and the
related 'auth-sources' entry were wrong.
++++
+*** New user option 'tramp-completion-use-cache'.
+During user and host name completion in the minibuffer, results from
+Tramp's connection cache are taken into account. This can be disabled
+by setting the user option 'tramp-completion-use-cache' to nil.
+
** Browse URL
---
@@ -2670,6 +2691,14 @@ commands with a warning face as you type.
*** New user option 'calc-kill-line-numbering'.
Set it to nil to exclude line numbering from kills and copies.
+** Hierarchy
+
++++
+*** Tree Display can delay computation of children.
+'hierarchy-add-tree' and 'hierarchy-add-trees' have an optional
+argument which allows tree-widget display to be activated and computed
+only when the user expands the node.
+
** Miscellaneous
---
@@ -2779,6 +2808,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
@@ -3182,6 +3218,15 @@ The following generalized variables have been made
obsolete:
* Lisp Changes in Emacs 29.1
++++
+** Interpreted closures are "safe for space".
+As was already the case for byte-compiled closures, instead of capturing
+the whole current lexical environment, interpreted closures now only
+capture the part of the environment that they need.
+The previous behavior could occasionally lead to memory leaks or
+to problems where a printed closure would not be 'read'able because
+of an un'read'able value in an unrelated lexical variable.
+
+++
** New accessor function 'file-attribute-file-identifier'.
It returns the list of the inode number and device identifier
@@ -4221,11 +4266,3 @@ 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/>.
-
-
-Local variables:
-coding: utf-8
-mode: outline
-mode: emacs-news
-paragraph-separate: "[ ]*$"
-end:
diff --git a/etc/themes/modus-operandi-theme.el
b/etc/themes/modus-operandi-theme.el
index 0f0630a6d1..6ea92f8559 100644
--- a/etc/themes/modus-operandi-theme.el
+++ b/etc/themes/modus-operandi-theme.el
@@ -6,7 +6,7 @@
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
-;; Version: 2.7.1
+;; Version: 3.0.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: faces, theme, accessibility
@@ -71,6 +71,7 @@ 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))
+;;;###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-themes.el b/etc/themes/modus-themes.el
index d5e1b0a120..a9d0d53cba 100644
--- a/etc/themes/modus-themes.el
+++ b/etc/themes/modus-themes.el
@@ -6,7 +6,7 @@
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
-;; Version: 2.7.1
+;; Version: 3.0.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: faces, theme, accessibility
@@ -88,7 +88,7 @@
(require 'subr-x))
(defgroup modus-themes ()
- "Options for `modus-operandi', `modus-vivendi'.
+ "Options for `modus-operandi', `modus-vivendi' themes.
The Modus themes conform with the WCAG AAA standard for color
contrast between background and foreground combinations (a
minimum contrast of 7:1---the highest standard of its kind). The
@@ -103,13 +103,13 @@ cover the blue-cyan-magenta side of the spectrum."
:tag "Modus Themes")
(defgroup modus-themes-faces ()
- "Faces defined by `modus-operandi' and `modus-vivendi'."
+ "Faces defined by `modus-operandi' and `modus-vivendi' themes."
:group 'modus-themes
:link '(info-link "(modus-themes) Top")
:prefix "modus-themes-"
:tag "Modus Themes Faces")
-(defvar modus-themes--version "2.7.0"
+(defvar modus-themes--version "3.0.0"
"Current version of the Modus themes.
The version either is the last tagged release, such as '1.0.0',
@@ -123,10 +123,7 @@ those would count as part of '1.1.0-dev'.")
If optional INSERT argument is provided from Lisp or as a prefix
argument, insert the `modus-themes--version' at point."
(interactive "P")
- (if-let ((version modus-themes--version)
- ((or insert current-prefix-arg)))
- (insert version)
- (message version)))
+ (funcall (if insert 'insert 'message) modus-themes--version))
;;;###autoload
(defun modus-themes-report-bug ()
@@ -1364,26 +1361,6 @@ The actual styling of the face is done by
`modus-themes-faces'."
The actual styling of the face is done by `modus-themes-faces'."
:group 'modus-themes-faces)
-(define-obsolete-face-alias
- 'modus-themes-completion-standard-first-match
- 'modus-themes-completion-selected
- "2.2.0")
-
-(define-obsolete-face-alias
- 'modus-themes-completion-standard-selected
- 'modus-themes-completion-selected
- "2.2.0")
-
-(define-obsolete-face-alias
- 'modus-themes-completion-extra-selected
- 'modus-themes-completion-selected
- "2.2.0")
-
-(define-obsolete-face-alias
- 'modus-themes-completion-key-binding
- 'modus-themes-key-binding
- "2.2.0")
-
(defface modus-themes-completion-selected nil
"Face for current selection in completion UIs.
The actual styling of the face is done by `modus-themes-faces'."
@@ -1934,20 +1911,22 @@ For example:
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Org agenda"))
-(defcustom modus-themes-fringes nil
- "Define the visibility of fringes.
+(defcustom modus-themes-fringes 'subtle
+ "Control the visibility of fringes.
+
+When the value is nil, do not apply a distinct background color.
-Nil means the fringes have no background color. Option `subtle'
-will apply a grayscale value that is visible yet close to the
-main buffer background color. Option `intense' will use a more
-pronounced grayscale value."
+With a value of `subtle' use a gray background color that is
+visible yet close to the main background color.
+
+With `intense' use a more pronounced gray background color."
:group 'modus-themes
- :package-version '(modus-themes . "1.0.0")
- :version "28.1"
+ :package-version '(modus-themes . "3.0.0")
+ :version "29.1"
:type '(choice
- (const :format "[%v] %t\n" :tag "No visible fringes (default)" nil)
- (const :format "[%v] %t\n" :tag "Subtle grayscale background" subtle)
- (const :format "[%v] %t\n" :tag "Intense grayscale background"
intense))
+ (const :format "[%v] %t\n" :tag "No visible fringes" nil)
+ (const :format "[%v] %t\n" :tag "Subtle gray background" subtle)
+ (const :format "[%v] %t\n" :tag "Intense gray background" intense))
:set #'modus-themes--set-option
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Fringes"))
@@ -2212,13 +2191,16 @@ interest of optimizing for such a use-case."
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Diffs"))
-(defcustom modus-themes-completions nil
+(defcustom modus-themes-completions
+ '((selection . (intense))
+ (popup . (intense)))
"Control the style of completion user interfaces.
This affects Company, Corfu, Flx, Helm, Icomplete/Fido, Ido, Ivy,
-Mct, Orderless, Selectrum, Vertico. The value is an alist that
-takes the form of a (key . properties) combination. Here is a
-sample, followed by a description of the particularities:
+Orderless, Selectrum, Vertico. The value is an alist that takes
+the form of a (KEY . PROPERTIES) combination. KEY is a symbol,
+while PROPERTIES is a list. Here is a sample, followed by a
+description of the particularities:
(setq modus-themes-completions
(quote ((matches . (extrabold background intense))
@@ -2226,10 +2208,11 @@ sample, followed by a description of the
particularities:
(popup . (accented)))))
The `matches' key refers to the highlighted characters that
-correspond to the user's input. By default (nil or an empty
-list), they have a bold weight and a colored foreground. The
-list of properties may include any of the following symbols
-regardless of the order they may appear in:
+correspond to the user's input. When its properties are nil or
+an empty list, matching characters in the user interface will
+have a bold weight and a colored foreground. The list of
+properties may include any of the following symbols regardless of
+the order they may appear in:
- `background' to add a background color;
@@ -2246,10 +2229,10 @@ regardless of the order they may appear in:
that bold will be used.
The `selection' key applies to the current line or currently
-matched candidate, depending on the specifics of the User
-Interface. By default (nil or an empty list), it has a subtle
-gray background, a bold weight, and the base foreground value
-for the text. The list of properties it accepts is as
+matched candidate, depending on the specifics of the user
+interface. When its properties are nil or an empty list, it has
+a subtle gray background, a bold weight, and the base foreground
+value for the text. The list of properties it accepts is as
follows (order is not significant):
- `accented' to make the background colorful instead of gray;
@@ -2268,7 +2251,11 @@ follows (order is not significant):
variable `modus-themes-weights'. The absence of a weight means
that bold will be used.
-The `popup' key takes the same values as `selection'.
+The `popup' key takes the same values as `selection'. The only
+difference is that it applies specifically to user interfaces
+that display an inline popup and thus have slightly different
+styling requirements than the minibuffer. The two prominent
+packages are `company' and `corfu'.
Apart from specifying each key separately, a fallback list is
accepted. This is only useful when the desired aesthetic is the
@@ -2290,22 +2277,14 @@ the corresponding key is simply ignored (`matches' does
not have
`accented' and `text-also', while `selection' and `popup' do not
have `background').
-A concise expression of those associations can be written as
-follows, where the `car' is always the key and the `cdr' is the
-list of properties (whatever order they may appear in):
-
- (setq modus-themes-completions
- (quote ((matches extrabold background intense)
- (selection semibold accented intense)
- (popup accented))))
-
Check the manual for tweaking `bold' and `italic' faces: Info
node `(modus-themes) Configure bold and italic faces'.
-Also refer to the Orderless documentation for its intersection
-with Company (if you choose to use those in tandem)."
+Also refer to the documentation of the `orderless' package for
+its intersection with `company' (if you choose to use those in
+tandem)."
:group 'modus-themes
- :package-version '(modus-themes . "2.3.0")
+ :package-version '(modus-themes . "3.0.0")
:version "29.1"
:type `(set
(cons :tag "Matches"
@@ -2420,11 +2399,11 @@ In user configuration files the form may look like this:
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Command prompts"))
-(defcustom modus-themes-hl-line nil
- "Control the current line highlight of HL-line mode.
+(defcustom modus-themes-hl-line '(intense)
+ "Control the current line highlight of `hl-line-mode'.
The value is a list of properties, each designated by a symbol.
-The default (a nil value or an empty list) is a subtle gray
+With a nil value, or an empty list, the style is a subtle gray
background color.
The property `accented' changes the background to a colored
@@ -2450,11 +2429,12 @@ In user configuration files the form may look like this:
(setq modus-themes-hl-line (quote (underline accented)))
-Set `x-underline-at-descent-line' to a non-nil value for better
-results with underlines."
+Set `x-underline-at-descent-line' to a non-nil value so that the
+placement of the underline coincides with the lower boundary of
+the colored background."
:group 'modus-themes
- :package-version '(modus-themes . "1.5.0")
- :version "28.1"
+ :package-version '(modus-themes . "3.0.0")
+ :version "29.1"
:type '(set :tag "Properties" :greedy t
(const :tag "Colored background" accented)
(const :tag "Underline" underline)
@@ -2522,8 +2502,6 @@ Also check the variables `org-hide-emphasis-markers',
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Markup"))
-(make-obsolete 'modus-themes-intense-markup 'modus-themes-markup "2.1.0")
-
(defcustom modus-themes-paren-match nil
"Control the style of matching parentheses or delimiters.
@@ -3225,11 +3203,6 @@ an alternative to the default value."
"Get cdr of KEY in ALIST."
(cdr (assoc key alist)))
-(define-obsolete-variable-alias
- 'modus-themes--heading-weights
- 'modus-themes-weights
- "2.1.0")
-
(defconst modus-themes-weights
'( thin ultralight extralight light semilight regular medium
semibold bold heavy extrabold ultrabold)
@@ -3582,9 +3555,6 @@ foreground unspecified."
(list deuteran)
(list main)))
-(make-obsolete 'modus-themes--completion 'modus-themes--completion-line
"2.3.0")
-(make-obsolete 'modus-themes--completion 'modus-themes--completion-match
"2.3.0")
-
(defun modus-themes--completion-line (key bg fg bgintense fgintense &optional
bgaccent bgaccentintense)
"Styles for `modus-themes-completions'.
KEY is the key of a cons cell. BG and FG are the main colors.
@@ -4309,8 +4279,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
magenta-subtle-bg magenta-intense))))
`(modus-themes-completion-match-1
((,class ,@(modus-themes--completion-match
- 'matches bg-special-faint-cold cyan
- cyan-subtle-bg cyan-intense))))
+ 'matches bg-special-faint-cold blue
+ blue-subtle-bg blue-intense))))
`(modus-themes-completion-match-2
((,class ,@(modus-themes--completion-match
'matches bg-special-faint-mild green
@@ -4798,9 +4768,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(consult-line-number-prefix ((,class :foreground ,fg-unfocused)))
`(consult-narrow-indicator ((,class :foreground ,magenta-alt)))
`(consult-preview-cursor ((,class :inherit modus-themes-intense-blue)))
- `(consult-preview-error ((,class :inherit modus-themes-intense-red)))
`(consult-preview-insertion ((,class :inherit modus-themes-special-warm)))
- `(consult-preview-line ((,class :background ,bg-hl-alt-intense)))
;;;;; corfu
`(corfu-current ((,class :inherit modus-themes-completion-selected-popup)))
`(corfu-bar ((,class :background ,fg-alt)))
@@ -4928,16 +4896,12 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; diff-hl
`(diff-hl-change ((,class :inherit modus-themes-fringe-yellow)))
`(diff-hl-delete ((,class :inherit modus-themes-fringe-red)))
- `(diff-hl-dired-change ((,class :inherit diff-hl-change)))
- `(diff-hl-dired-delete ((,class :inherit diff-hl-delete)))
- `(diff-hl-dired-ignored ((,class :inherit dired-ignored)))
- `(diff-hl-dired-insert ((,class :inherit diff-hl-insert)))
- `(diff-hl-dired-unknown ((,class :inherit dired-ignored)))
`(diff-hl-insert ((,class :inherit modus-themes-grue-background-active)))
`(diff-hl-reverted-hunk-highlight ((,class :background ,fg-main
:foreground ,bg-main)))
;;;;; diff-mode
`(diff-added ((,class :inherit modus-themes-diff-added)))
`(diff-changed ((,class :inherit modus-themes-diff-changed :extend t)))
+ `(diff-changed-unspecified ((,class :inherit diff-changed)))
`(diff-context ((,class ,@(unless (eq modus-themes-diffs 'bg-only) (list
:foreground fg-unfocused)))))
`(diff-error ((,class :inherit modus-themes-intense-red)))
`(diff-file-header ((,class :inherit (bold diff-header))))
@@ -5741,17 +5705,43 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;; HACK 2022-06-23: The :inverse-video prevents hl-line-mode from
;; overriding the background. Such an override really defeats the
;; purpose of setting those highlights.
- `(hi-aquamarine ((,class :background ,bg-main :foreground ,cyan
:inverse-video t)))
+ ;;
+ ;; NOTE 2022-10-04: We do not use the ,class here but instead
+ ;; hardcode color values. We have to do this as the themes lack
+ ;; entries in their palette for such an edge case. Defining those
+ ;; entries is not appropriate.
+ `(hi-aquamarine ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#227f9f" :inverse-video
t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#66cbdc" :inverse-video
t)))
`(hi-black-b ((,class :inverse-video t)))
`(hi-black-hb ((,class :background ,bg-main :foreground ,fg-alt
:inverse-video t)))
- `(hi-blue ((,class :background ,bg-main :foreground ,blue-alt
:inverse-video t)))
+ `(hi-blue ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#3366dd" :inverse-video t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#aaccff" :inverse-video t)))
`(hi-blue-b ((,class :inherit (bold hi-blue))))
- `(hi-green ((,class :background ,bg-main :foreground ,green :inverse-video
t)))
+ `(hi-green ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#008a00" :inverse-video t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#66dd66" :inverse-video t)))
`(hi-green-b ((,class :inherit (bold hi-green))))
- `(hi-pink ((,class :background ,bg-main :foreground ,magenta
:inverse-video t)))
- `(hi-red-b ((,class :inherit bold :background ,bg-main :foreground ,red
:inverse-video t)))
- `(hi-salmon ((,class :background ,bg-main :foreground ,red-alt-faint
:inverse-video t)))
- `(hi-yellow ((,class :background ,bg-main :foreground ,yellow-alt
:inverse-video t)))
+ `(hi-pink ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#bd30aa" :inverse-video t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#ff88ee" :inverse-video t)))
+ `(hi-red-b ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#dd0000" :inverse-video t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#f06666" :inverse-video t)))
+ `(hi-salmon ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#bf555a" :inverse-video t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#e08a50" :inverse-video t)))
+ `(hi-yellow ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#af6400" :inverse-video t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#faea00" :inverse-video t)))
`(highlight ((,class ,@(if modus-themes-intense-mouseovers
(list :background blue-intense-bg :foreground
fg-main)
(list :background cyan-subtle-bg :foreground
fg-main)))))
@@ -5800,6 +5790,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(iflipb-other-buffer-face ((,class :inherit shadow)))
;;;;; image-dired
`(image-dired-thumb-flagged ((,class :background ,red-intense-bg)))
+ `(image-dired-thumb-header-file-name ((,class :inherit bold)))
+ `(image-dired-thumb-header-file-size ((,class :foreground ,blue-active)))
`(image-dired-thumb-mark ((,class :inherit
modus-themes-grue-background-intense)))
;;;;; imenu-list
`(imenu-list-entry-face-0 ((,class :foreground ,cyan)))
@@ -6485,6 +6477,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(nxml-prolog-keyword ((,class :inherit font-lock-keyword-face)))
`(nxml-ref ((,class :inherit modus-themes-bold :foreground
,fg-special-mild)))
`(rng-error ((,class :inherit error)))
+;;;;; olivetti
+ `(olivetti-fringe ((,class :background ,bg-main)))
;;;;; orderless
`(orderless-match-face-0 ((,class :inherit
modus-themes-completion-match-0)))
`(orderless-match-face-1 ((,class :inherit
modus-themes-completion-match-1)))
@@ -7109,17 +7103,13 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; table (built-in table.el)
`(table-cell ((,class :background ,blue-nuanced-bg)))
;;;;; telega
- ;; FIXME 2021-03-28: Some aspects of `telega' are not fully
- ;; supported or have not been tested thoroughly. Please understand
- ;; that I do not use that service because it requires a smartphone
- ;; and I have none. Help with testing is appreciated.
`(telega-button ((,class :box t :foreground ,blue)))
`(telega-button-active ((,class :box ,blue-intense-bg :background
,blue-intense-bg :foreground ,fg-main)))
`(telega-button-highlight ((,class :inherit modus-themes-subtle-magenta)))
`(telega-chat-prompt ((,class :inherit bold)))
- `(telega-entity-type-code ((,class :inherit modus-themes-fixed-pitch)))
+ `(telega-entity-type-code ((,class :inherit modus-themes-markup-verbatim)))
`(telega-entity-type-mention ((,class :foreground ,cyan)))
- `(telega-entity-type-pre ((,class :inherit modus-themes-fixed-pitch)))
+ `(telega-entity-type-pre ((,class :inherit modus-themes-markup-code)))
`(telega-entity-type-spoiler ((,class :background ,fg-main :foreground
,fg-main)))
`(telega-msg-heading ((,class :background ,bg-alt)))
`(telega-msg-self-title ((,class :inherit bold)))
@@ -7168,7 +7158,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(term-color-yellow ((,class :background ,yellow :foreground ,yellow)))
`(term-underline ((,class :underline t)))
;;;;; textsec
- `(textsec-suspicious ((,class :inherit modus-themes-refine-red)))
+ `(textsec-suspicious (()))
;;;;; tomatinho
`(tomatinho-ok-face ((,class :foreground ,blue-intense)))
`(tomatinho-pause-face ((,class :foreground ,yellow-intense)))
diff --git a/etc/themes/modus-vivendi-theme.el
b/etc/themes/modus-vivendi-theme.el
index 02c2d9e129..aefef540a1 100644
--- a/etc/themes/modus-vivendi-theme.el
+++ b/etc/themes/modus-vivendi-theme.el
@@ -1,4 +1,4 @@
-;;; modus-vivendi-theme.el --- Elegant, highly legible and customizable light
theme -*- lexical-binding:t -*-
+;;; modus-vivendi-theme.el --- Elegant, highly legible and customizable dark
theme -*- lexical-binding:t -*-
;; Copyright (C) 2019-2022 Free Software Foundation, Inc.
@@ -6,7 +6,7 @@
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
-;; Version: 2.7.1
+;; Version: 3.0.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: faces, theme, accessibility
@@ -71,6 +71,7 @@ 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))
+;;;###theme-autoload
+(put 'modus-vivendi 'theme-properties '(:background-mode dark :kind
color-scheme :family modus))
;;; modus-vivendi-theme.el ends here
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index a4f0196a78..2ca8e25dac 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -1221,7 +1221,7 @@ SORTFUN is passed to `sort' to change the default
ordering."
(defface abbrev-table-name
'((t :inherit font-lock-function-name-face))
- "Face used for displaying the abbrev table name in `edit-abbrev-mode'."
+ "Face used for displaying the abbrev table name in `edit-abbrevs-mode'."
:version "29.1")
(defvar edit-abbrevs-mode-font-lock-keywords
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index 7a65777d32..4eab2c11c6 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -2177,7 +2177,7 @@ Operation is inhibited by
`allout-inhibit-body-modification-handler'."
;; ?? Escapes removal (before changes) is not done when edits span multiple
;; items, recognizing that item structure is being preserved, including
;; escaping of item-prefix-like text within bodies. See
-;; `allout-before-modification-handler' and
+;; `allout-body-modification-handler' and
;; `allout-inhibit-body-modification-handler'.
;;
;; Adds the overlay to the `allout-unresolved-body-mod-workroster' during
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 6f1c270c23..5e7015db54 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -418,7 +418,7 @@ and it should apply face FACE to the text between BEG and
END.")
(setq ansi-color-for-comint-mode 'filter))
;;;###autoload
-(defun ansi-color-process-output (ignored)
+(defun ansi-color-process-output (_ignored)
"Maybe translate SGR control sequences of comint output into text properties.
Depending on variable `ansi-color-for-comint-mode' the comint output is
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 51d939151c..354b28da5a 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -135,7 +135,7 @@ If this contains a %s, that will be replaced by the
matching rule."
(if (eq major-mode (default-value 'major-mode))
(sh-mode))))
- (ada-mode . ada-header)
+ (ada-mode . ada-skel-initial-string)
(("\\.[1-9]\\'" . "Man page skeleton")
"Short description: "
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 576659675b..e3d66c04bc 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -297,9 +297,10 @@ You should set this variable through Custom."
(defcustom auto-revert-notify-exclude-dir-regexp
(concat
;; No mounted file systems.
- "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/"))
+ mounted-file-systems
;; No remote files.
- (unless auto-revert-remote-files "\\|^/[^/|:][^/|]+:"))
+ (unless auto-revert-remote-files
+ (rx (| "" (: bol "/" (not (any "/:|")) (1+ (not (any "/|"))) ":")))))
"Regular expression of directories to be excluded from file notifications."
:group 'auto-revert
:type 'regexp
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 2e32128274..c1ad5f7520 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1029,6 +1029,14 @@ if `inhibit-field-text-motion' is non-nil."
(define-key global-map [XF86Back] 'previous-buffer)
(put 'previous-buffer :advertised-binding [?\C-x left])
+(defvar-keymap buffer-navigation-repeat-map
+ :doc "Keymap to repeat `next-buffer' and `previous-buffer'. Used in
`repeat-mode'."
+ "<right>" #'next-buffer
+ "<left>" #'previous-buffer)
+
+(put 'next-buffer 'repeat-map 'buffer-navigation-repeat-map)
+(put 'previous-buffer 'repeat-map 'buffer-navigation-repeat-map)
+
(let ((map minibuffer-local-map))
(define-key map "\en" 'next-history-element)
(define-key map [next] 'next-history-element)
diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el
index b9b1194ccc..3d89419364 100644
--- a/lisp/cedet/ede/locate.el
+++ b/lisp/cedet/ede/locate.el
@@ -172,7 +172,7 @@ You cannot create projects for the baseclass."
(defclass ede-locate-locate (ede-locate-base)
()
"EDE Locator using the locate command.
-Configure the Emacs `locate-program' variable to also
+Configure the Emacs `locate-command' variable to also
configure the use of EDE locate.")
(cl-defmethod ede-locate-ok-in-project ((_loc (subclass ede-locate-locate))
@@ -315,7 +315,7 @@ that created this EDE locate object."
()
"EDE Locator using Cscope.
Configure EDE's use of Cscope through the cedet-cscope.el
-file name searching variable `cedet-cscope-file-command'.")
+file name searching variable `cedet-cscope-command'.")
(cl-defmethod initialize-instance ((loc ede-locate-cscope)
&rest _slots)
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index 55eeef453e..b13dc99456 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -38,7 +38,7 @@
(defvar wisent-lex-lookahead nil
"Extra lookahead token.
-When non-nil it is directly returned by `wisent-lex-function'.")
+When non-nil it is directly returned by `wisent-lexer-function'.")
(defmacro wisent-lex-eoi ()
"Return an End-Of-Input lexical token.
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index ee32c9c945..e043d9bc17 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1546,7 +1546,7 @@ If TYPE is `groups', include only groups."
"*Customize Apropos*")))
;;;###autoload
-(defun customize-apropos-options (regexp &optional ignored)
+(defun customize-apropos-options (regexp &optional _ignored)
"Customize all loaded customizable options matching REGEXP."
(interactive (list (apropos-read-pattern "options")))
(customize-apropos regexp 'options))
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index 90680ff68f..b891f24154 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -142,7 +142,7 @@ remove them from your saved Custom file.\n\n")
(widget-create 'push-button
:tag " Revert "
:help-echo "Revert this buffer to its original state."
- :action (lambda (&rest ignored) (revert-buffer)))
+ :action (lambda (&rest _ignored) (revert-buffer)))
(widget-insert "\n\nTheme name : ")
(setq custom-theme-name
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 9add96c260..327a4f038b 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -3478,7 +3478,7 @@ Use \\[dired-hide-all] to (un)hide all directories."
(dired-next-subdir 1 t))))
;;;###autoload
-(defun dired-hide-all (&optional ignored)
+(defun dired-hide-all (&optional _ignored)
"Hide all subdirectories, leaving only their header lines.
If there is already something hidden, make everything visible again.
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
diff --git a/lisp/dired.el b/lisp/dired.el
index 85a7131570..209e270942 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1457,9 +1457,9 @@ wildcards, erases the buffer, and builds the subdir-alist
anew
(if (eq (car attributes) t)
(set-visited-file-modtime (file-attribute-modification-time
attributes))))
- (set-buffer-modified-p nil)
(when dired-make-directory-clickable
(dired--make-directory-clickable))
+ (set-buffer-modified-p nil)
;; No need to narrow since the whole buffer contains just
;; dired-readin's output, nothing else. The hook can
;; successfully use dired functions (e.g. dired-get-filename)
@@ -1911,11 +1911,15 @@ mouse-2: visit this file in other window"
(defun dired--make-directory-clickable ()
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "^ /" nil t 1)
+ (while (re-search-forward
+ (if (memq system-type '(windows-nt ms-dos))
+ "^ \\([a-zA-Z]:/\\|//\\)"
+ "^ /")
+ nil t 1)
(let ((bound (line-end-position))
(segment-start (point))
(inhibit-read-only t)
- (dir "/"))
+ (dir (substring (match-string 0) 2)))
(while (search-forward "/" bound t 1)
(setq dir (concat dir (buffer-substring segment-start (point))))
(add-text-properties
diff --git a/lisp/dom.el b/lisp/dom.el
index f8c794a300..01bdef3a07 100644
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -30,23 +30,17 @@
(defsubst dom-tag (node)
"Return the NODE tag."
;; Called on a list of nodes. Use the first.
- (if (consp (car node))
- (caar node)
- (car node)))
+ (car (if (consp (car node)) (car node) node)))
(defsubst dom-attributes (node)
"Return the NODE attributes."
;; Called on a list of nodes. Use the first.
- (if (consp (car node))
- (cadr (car node))
- (cadr node)))
+ (cadr (if (consp (car node)) (car node) node)))
(defsubst dom-children (node)
"Return the NODE children."
;; Called on a list of nodes. Use the first.
- (if (consp (car node))
- (cddr (car node))
- (cddr node)))
+ (cddr (if (consp (car node)) (car node) node)))
(defun dom-non-text-children (node)
"Return all non-text-node children of NODE."
@@ -62,10 +56,11 @@
(defun dom-set-attribute (node attribute value)
"Set ATTRIBUTE in NODE to VALUE."
(setq node (dom-ensure-node node))
- (let ((old (assoc attribute (cadr node))))
+ (let* ((attributes (cadr node))
+ (old (assoc attribute attributes)))
(if old
(setcdr old value)
- (setcar (cdr node) (nconc (cadr node) (list (cons attribute value)))))))
+ (setcar (cdr node) (cons (cons attribute value) attributes)))))
(defun dom-remove-attribute (node attribute)
"Remove ATTRIBUTE from NODE."
@@ -80,7 +75,7 @@ A typical attribute is `href'."
(defun dom-text (node)
"Return all the text bits in the current node concatenated."
- (mapconcat 'identity (cl-remove-if-not 'stringp (dom-children node)) " "))
+ (mapconcat #'identity (cl-remove-if-not #'stringp (dom-children node)) " "))
(defun dom-texts (node &optional separator)
"Return all textual data under NODE concatenated with SEPARATOR in-between."
@@ -195,9 +190,7 @@ ATTRIBUTE would typically be `class', `id' or the like."
(defun dom-node (tag &optional attributes &rest children)
"Return a DOM node with TAG and ATTRIBUTES."
- (if children
- `(,tag ,attributes ,@children)
- (list tag attributes)))
+ `(,tag ,attributes ,@children))
(defun dom-append-child (node child)
"Append CHILD to the end of NODE's children."
@@ -215,11 +208,7 @@ If BEFORE is nil, make CHILD NODE's first child."
(let ((pos (if before
(cl-position before children)
0)))
- (if (zerop pos)
- ;; First child.
- (setcdr (cdr node) (cons child (cddr node)))
- (setcdr (nthcdr (1- pos) children)
- (cons child (nthcdr pos children))))))
+ (push child (nthcdr (+ 2 pos) node))))
node)
(defun dom-ensure-node (node)
@@ -247,7 +236,7 @@ white-space."
(insert (format "(%S . %S)" (car elem) (cdr elem)))
(if (zerop (cl-decf times))
(insert ")")
- (insert "\n" (make-string column ? ))))))
+ (insert "\n" (make-string column ?\s))))))
(let* ((children (if remove-empty
(cl-remove-if
(lambda (child)
@@ -258,16 +247,16 @@ white-space."
(times (length children)))
(if (null children)
(insert ")")
- (insert "\n" (make-string (1+ column) ? ))
+ (insert "\n" (make-string (1+ column) ?\s))
(dolist (child children)
(if (stringp child)
- (if (or (not remove-empty)
- (not (string-match "\\`[\n\r\t ]*\\'" child)))
+ (if (not (and remove-empty
+ (string-match "\\`[\n\r\t ]*\\'" child)))
(insert (format "%S" child)))
(dom-pp child remove-empty))
(if (zerop (cl-decf times))
(insert ")")
- (insert "\n" (make-string (1+ column) ? ))))))))
+ (insert "\n" (make-string (1+ column) ?\s))))))))
(defun dom-print (dom &optional pretty xml)
"Print DOM at point as HTML/XML.
@@ -279,18 +268,19 @@ If XML, generate XML instead of HTML."
(dolist (elem attr)
;; In HTML, these are boolean attributes that should not have
;; an = value.
- (if (and (memq (car elem)
- '(async autofocus autoplay checked
- contenteditable controls default
- defer disabled formNoValidate frameborder
- hidden ismap itemscope loop
- multiple muted nomodule novalidate open
- readonly required reversed
- scoped selected typemustmatch))
- (cdr elem)
- (not xml))
- (insert (format " %s" (car elem)))
- (insert (format " %s=%S" (car elem) (cdr elem))))))
+ (insert (if (and (memq (car elem)
+ '(async autofocus autoplay checked
+ contenteditable controls default
+ defer disabled formNoValidate frameborder
+ hidden ismap itemscope loop
+ multiple muted nomodule novalidate open
+ readonly required reversed
+ scoped selected typemustmatch))
+ (cdr elem)
+ (not xml))
+ (format " %s" (car elem))
+ (format " %s=\"%s\"" (car elem)
+ (url-insert-entities-in-string (cdr elem)))))))
(let* ((children (dom-children dom))
(non-text nil))
(if (null children)
@@ -301,7 +291,7 @@ If XML, generate XML instead of HTML."
(insert child)
(setq non-text t)
(when pretty
- (insert "\n" (make-string (+ column 2) ? )))
+ (insert "\n" (make-string (+ column 2) ?\s)))
(dom-print child pretty xml)))
;; If we inserted non-text child nodes, or a text node that
;; ends with a newline, then we indent the end tag.
@@ -310,7 +300,7 @@ If XML, generate XML instead of HTML."
non-text))
(unless (bolp)
(insert "\n"))
- (insert (make-string column ? )))
+ (insert (make-string column ?\s)))
(insert (format "</%s>" (dom-tag dom)))))))
(provide 'dom)
diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el
index 54d60c84d4..b532ef95e7 100644
--- a/lisp/ecomplete.el
+++ b/lisp/ecomplete.el
@@ -88,7 +88,8 @@ string that was matched."
(defcustom ecomplete-filter-regexp nil
"Regular expression of addresses that should not be stored by ecomplete."
- :type 'regexp
+ :type '(choice (const :tag "None" nil)
+ (regexp :tag "Regexp"))
:version "29.1")
;;; Internal variables.
@@ -189,7 +190,7 @@ FORCE is non-nil, use TEXT exactly as is."
If CHOOSE, allow the user to choose interactively between the
matches.
-Auto-select when `ecomplete-message-display-abbrev-auto-select' is
+Auto-select when `ecomplete-auto-select' is
non-nil and there is only a single completion option available."
(let* ((matches (ecomplete-get-matches type word))
(match-list (and matches (split-string matches "\n")))
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index 90bf1fe35b..75a3612df9 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -53,8 +53,8 @@
`(;; GNU GPL
("is free software[:;] you can redistribute it" .
,(rx (or (seq "If not, see " (? "<")
- "http" (? "s") "://www.gnu.org/licenses/"
- (? ">") (? " "))
+ "http" (? "s") "://www.gnu.org/licenses"
+ (? "/") (? ">") (? " "))
(seq "Boston, MA " (? " ")
"0211" (or "1-1307" "0-1301")
(or " " ", ") "USA")
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 4ffe6f573c..d461698c88 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -753,7 +753,7 @@ property for use by navigation."
(defun backtrace--line-length-or-nil ()
"Return `backtrace-line-length' if valid, nil else."
- ;; mirror the logic in `cl-print-to-string-with-limits'
+ ;; mirror the logic in `cl-print-to-string-with-limit'
(and (natnump backtrace-line-length)
(not (zerop backtrace-line-length))
backtrace-line-length))
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-opt.el b/lisp/emacs-lisp/byte-opt.el
index 5ef2d7fe82..a7e1df3622 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -178,7 +178,7 @@ Earlier variables shadow later ones with the same name.")
;; be displayed when the function's source file will be
;; compiled anyway, but more importantly we would otherwise
;; emit spurious warnings here because we don't have the full
- ;; context, such as `declare-functions' placed earlier in the
+ ;; context, such as `declare-function's placed earlier in the
;; source file's code or `with-suppressed-warnings' that
;; surrounded the `defsubst'.
(byte-compile-warnings nil))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 45ff1f4a8e..4d258dab96 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2577,7 +2577,7 @@ list that represents a doc string reference.
;; macroexpand-all.
;; (if (memq byte-optimize '(t source))
;; (setq form (byte-optimize-form form for-effect)))
- (cconv-closure-convert form))
+ (cconv-closure-convert form byte-compile-bound-variables))
;; byte-hunk-handlers cannot call this!
(defun byte-compile-toplevel-file-form (top-level-form)
@@ -4675,13 +4675,6 @@ Return the offset in the form (VAR . OFFSET)."
(byte-compile-form (cadr clause))
(byte-compile-push-constant nil)))))
-(defun byte-compile-not-lexical-var-p (var)
- (or (not (symbolp var))
- (special-variable-p var)
- (memq var byte-compile-bound-variables)
- (memq var '(nil t))
- (keywordp var)))
-
(defun byte-compile-bind (var init-lexenv)
"Emit byte-codes to bind VAR and update `byte-compile--lexical-environment'.
INIT-LEXENV should be a lexical-environment alist describing the
@@ -4690,7 +4683,7 @@ Return non-nil if the TOS value was popped."
;; The mix of lexical and dynamic bindings mean that we may have to
;; juggle things on the stack, to move them to TOS for
;; dynamic binding.
- (if (and lexical-binding (not (byte-compile-not-lexical-var-p var)))
+ (if (not (cconv--not-lexical-var-p var byte-compile-bound-variables))
;; VAR is a simple stack-allocated lexical variable.
(progn (push (assq var init-lexenv)
byte-compile--lexical-environment)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 23d0f12194..f3431db415 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -64,20 +64,12 @@
;;
;;; Code:
-;; PROBLEM cases found during conversion to lexical binding.
-;; We should try and detect and warn about those cases, even
-;; for lexical-binding==nil to help prepare the migration.
-;; - Uses of run-hooks, and friends.
-;; - Cases where we want to apply the same code to different vars depending on
-;; some test. These sometimes use a (let ((foo (if bar 'a 'b)))
-;; ... (symbol-value foo) ... (set foo ...)).
-
;; TODO: (not just for cconv but also for the lexbind changes in general)
;; - let (e)debug find the value of lexical variables from the stack.
;; - make eval-region do the eval-sexp-add-defvars dance.
;; - byte-optimize-form should be applied before cconv.
;; OTOH, the warnings emitted by cconv-analyze need to come before optimize
-;; since afterwards they can because obnoxious (warnings about an "unused
+;; since afterwards they can become obnoxious (warnings about an "unused
;; variable" should not be emitted when the variable use has simply been
;; optimized away).
;; - let macros specify that some let-bindings come from the same source,
@@ -87,33 +79,9 @@
;; - canonize code in macro-expand so we don't have to handle (let (var) body)
;; and other oddities.
;; - new byte codes for unwind-protect so that closures aren't needed at all.
-;; - a reference to a var that is known statically to always hold a constant
-;; should be turned into a byte-constant rather than a byte-stack-ref.
-;; Hmm... right, that's called constant propagation and could be done here,
-;; but when that constant is a function, we have to be careful to make sure
-;; the bytecomp only compiles it once.
;; - Since we know here when a variable is not mutated, we could pass that
;; info to the byte-compiler, e.g. by using a new `immutable-let'.
;; - call known non-escaping functions with `goto' rather than `call'.
-;; - optimize mapc to a dolist loop.
-
-;; (defmacro dlet (binders &rest body)
-;; ;; Works in both lexical and non-lexical mode.
-;; (declare (indent 1) (debug let))
-;; `(progn
-;; ,@(mapcar (lambda (binder)
-;; `(defvar ,(if (consp binder) (car binder) binder)))
-;; binders)
-;; (let ,binders ,@body)))
-
-;; (defmacro llet (binders &rest body)
-;; ;; Only works in lexical-binding mode.
-;; `(funcall
-;; (lambda ,(mapcar (lambda (binder) (if (consp binder) (car binder)
binder))
-;; binders)
-;; ,@body)
-;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
-;; binders)))
(eval-when-compile (require 'cl-lib))
@@ -142,13 +110,19 @@ is less than this number.")
;; interactive forms.
(make-hash-table :test #'eq :weakness 'key))
+(defvar cconv--dynbound-variables nil
+ "List of variables known to be dynamically bound.")
+
;;;###autoload
-(defun cconv-closure-convert (form)
+(defun cconv-closure-convert (form &optional dynbound-vars)
"Main entry point for closure conversion.
FORM is a piece of Elisp code after macroexpansion.
+DYNBOUND-VARS is a list of symbols that should be considered as
+using dynamic scoping.
Returns a form where all lambdas don't have any free variables."
- (let ((cconv-freevars-alist '())
+ (let ((cconv--dynbound-variables dynbound-vars)
+ (cconv-freevars-alist '())
(cconv-var-classification '()))
;; Analyze form - fill these variables with new information.
(cconv-analyze-form form '())
@@ -156,8 +130,6 @@ Returns a form where all lambdas don't have any free
variables."
(prog1 (cconv-convert form nil nil) ; Env initially empty.
(cl-assert (null cconv-freevars-alist)))))
-(defconst cconv--dummy-var (make-symbol "ignored"))
-
(defun cconv--set-diff (s1 s2)
"Return elements of set S1 that are not in set S2."
(let ((res '()))
@@ -262,9 +234,7 @@ Returns a form where all lambdas don't have any free
variables."
;; it is often non-trivial for the programmer to avoid such
;; unused vars.
(not (intern-soft var))
- (eq ?_ (aref (symbol-name var) 0))
- ;; As a special exception, ignore "ignored".
- (eq var 'ignored))
+ (eq ?_ (aref (symbol-name var) 0)))
(let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
(format "Unused lexical %s `%S'%s"
varkind (bare-symbol var)
@@ -342,7 +312,7 @@ EXTEND is a list of variables which might need to be
accessed even from places
where they are shadowed, because some part of ENV causes them to be used at
places where they originally did not directly appear."
(cl-assert (not (delq nil (mapcar (lambda (mapping)
- (if (eq (cadr mapping) 'apply-partially)
+ (if (eq (cadr mapping) #'apply-partially)
(cconv--set-diff (cdr (cddr mapping))
extend)))
env))))
@@ -634,6 +604,12 @@ places where they originally did not directly appear."
(defvar byte-compile-lexical-variables)
+(defun cconv--not-lexical-var-p (var dynbounds)
+ (or (not lexical-binding)
+ (not (symbolp var))
+ (special-variable-p var)
+ (memq var dynbounds)))
+
(defun cconv--analyze-use (vardata form varkind)
"Analyze the use of a variable.
VARDATA should be (BINDER READ MUTATED CAPTURED CALLED).
@@ -677,7 +653,7 @@ FORM is the parent form that binds this var."
;; outside of it.
(envcopy
(mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env))
- (byte-compile-bound-variables byte-compile-bound-variables)
+ (cconv--dynbound-variables cconv--dynbound-variables)
(newenv envcopy))
;; Push it before recursing, so cconv-freevars-alist contains entries in
;; the order they'll be used by closure-convert-rec.
@@ -685,7 +661,7 @@ FORM is the parent form that binds this var."
(when lexical-binding
(dolist (arg args)
(cond
- ((byte-compile-not-lexical-var-p arg)
+ ((cconv--not-lexical-var-p arg cconv--dynbound-variables)
(byte-compile-warn-x
arg
"Lexical argument shadows the dynamic variable %S"
@@ -715,6 +691,8 @@ FORM is the parent form that binds this var."
(setf (nth 3 (car env)) t))
(setq env (cdr env) envcopy (cdr envcopy))))))
+(defvar cconv--dynbindings)
+
(defun cconv-analyze-form (form env)
"Find mutated variables and variables captured by closure.
Analyze lambdas if they are suitable for lambda lifting.
@@ -730,7 +708,7 @@ This function does not return anything but instead fills the
(let ((orig-env env)
(newvars nil)
(var nil)
- (byte-compile-bound-variables byte-compile-bound-variables)
+ (cconv--dynbound-variables cconv--dynbound-variables)
(value nil))
(dolist (binder binders)
(if (not (consp binder))
@@ -743,7 +721,9 @@ This function does not return anything but instead fills the
(cconv-analyze-form value (if (eq letsym 'let*) env orig-env)))
- (unless (or (byte-compile-not-lexical-var-p var) (not
lexical-binding))
+ (if (cconv--not-lexical-var-p var cconv--dynbound-variables)
+ (when (boundp 'cconv--dynbindings)
+ (push var cconv--dynbindings))
(cl-pushnew var byte-compile-lexical-variables)
(let ((varstruct (list var nil nil nil nil)))
(push (cons binder (cdr varstruct)) newvars)
@@ -797,7 +777,8 @@ This function does not return anything but instead fills the
(cconv-analyze-form protected-form env)
(unless lexical-binding
(setq var nil))
- (when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
+ (when (and var (symbolp var)
+ (cconv--not-lexical-var-p var cconv--dynbound-variables))
(byte-compile-warn-x
var "Lexical variable shadows the dynamic variable %S" var))
(let* ((varstruct (list var nil nil nil nil)))
@@ -813,9 +794,9 @@ This function does not return anything but instead fills the
(cconv-analyze-form form env)
(cconv--analyze-function () body env form))
- (`(defvar ,var) (push var byte-compile-bound-variables))
+ (`(defvar ,var) (push var cconv--dynbound-variables))
(`(,(or 'defconst 'defvar) ,var ,value . ,_)
- (push var byte-compile-bound-variables)
+ (push var cconv--dynbound-variables)
(cconv-analyze-form value env))
(`(,(or 'funcall 'apply) ,fun . ,args)
@@ -847,5 +828,78 @@ This function does not return anything but instead fills
the
(setf (nth 1 dv) t))))))
(define-obsolete-function-alias 'cconv-analyse-form #'cconv-analyze-form
"25.1")
+(defun cconv-fv (form lexvars dynvars)
+ "Return the list of free variables in FORM.
+LEXVARS is the list of statically scoped vars in the context
+and DYNVARS is the list of dynamically scoped vars in the context.
+Returns a pair (LEXV . DYNV) of those vars actually used by FORM."
+ (let* ((fun
+ ;; Wrap FORM into a function because the analysis code we
+ ;; have only computes freevars for functions.
+ ;; In practice FORM is always already of the form
+ ;; #'(lambda ...), so optimize for this case.
+ (if (and (eq 'function (car-safe form))
+ (eq 'lambda (car-safe (cadr form)))
+ ;; To get correct results, FUN needs to be a "simple lambda"
+ ;; without nested forms that aren't part of the body. :-(
+ (not (assq 'interactive (cadr form)))
+ (not (assq ':documentation (cadr form))))
+ form
+ `#'(lambda () ,form)))
+ (analysis-env (mapcar (lambda (v) (list v nil nil nil nil)) lexvars))
+ (cconv--dynbound-variables dynvars)
+ (byte-compile-lexical-variables nil)
+ (cconv--dynbindings nil)
+ (cconv-freevars-alist '())
+ (cconv-var-classification '()))
+ (let* ((body (cddr (cadr fun))))
+ ;; Analyze form - fill these variables with new information.
+ (cconv-analyze-form fun analysis-env)
+ (setq cconv-freevars-alist (nreverse cconv-freevars-alist))
+ (unless (equal (if (eq :documentation (car-safe (car body)))
+ (cdr body) body)
+ (caar cconv-freevars-alist))
+ (message "BOOH!\n%S\n%S"
+ body (caar cconv-freevars-alist)))
+ (cl-assert (equal (if (eq :documentation (car-safe (car body)))
+ (cdr body) body)
+ (caar cconv-freevars-alist)))
+ (let ((fvs (nreverse (cdar cconv-freevars-alist)))
+ (dyns (delq nil (mapcar (lambda (var) (car (memq var dynvars)))
+ (delete-dups cconv--dynbindings)))))
+ (cons fvs dyns)))))
+
+(defun cconv-make-interpreted-closure (fun env)
+ (cl-assert (eq (car-safe fun) 'lambda))
+ (let ((lexvars (delq nil (mapcar #'car-safe env))))
+ (if (null lexvars)
+ ;; The lexical environment is empty, so there's no need to
+ ;; look for free variables.
+ `(closure ,env . ,(cdr fun))
+ ;; We could try and cache the result of the macroexpansion and
+ ;; `cconv-fv' analysis. Not sure it's worth the trouble.
+ (let* ((form `#',fun)
+ (expanded-form
+ (let ((lexical-binding t) ;; Tell macros which dialect is in use.
+ ;; Make the macro aware of any defvar declarations in scope.
+ (macroexp--dynvars
+ (if macroexp--dynvars
+ (append env macroexp--dynvars) env)))
+ (macroexpand-all form macroexpand-all-environment)))
+ ;; Since we macroexpanded the body, we may as well use that.
+ (expanded-fun-cdr
+ (pcase expanded-form
+ (`#'(lambda . ,cdr) cdr)
+ (_ (cdr fun))))
+
+ (dynvars (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env)))
+ (fvs (cconv-fv expanded-form lexvars dynvars))
+ (newenv (nconc (mapcar (lambda (fv) (assq fv env)) (car fvs))
+ (cdr fvs))))
+ ;; Never return a nil env, since nil means to use the dynbind
+ ;; dialect of ELisp.
+ `(closure ,(or newenv '(t)) . ,expanded-fun-cdr)))))
+
+
(provide 'cconv)
;;; cconv.el ends here
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/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 8cff06a383..1338ae6e13 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -96,7 +96,7 @@ Integer values are handled in the `range' slot.")
`comp-common-supertype'.")
(subtype-p-mem (make-hash-table :test #'equal) :type hash-table
:documentation "Serve memoization for
-`comp-subtype-p-mem'.")
+`comp-cstr-ctxt-subtype-p-mem'.")
(union-1-mem-no-range (make-hash-table :test #'equal) :type hash-table
:documentation "Serve memoization for
`comp-cstr-union-1'.")
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 5a05fe4854..863e895efd 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -57,7 +57,7 @@
:safe #'integerp
:version "28.1")
-(defcustom native-comp-debug (if (eq 'windows-nt system-type) 1 0)
+(defcustom native-comp-debug 0
"Debug level for native compilation, a number between 0 and 3.
This is intended for debugging the compiler itself.
0 no debug output.
@@ -67,7 +67,7 @@ This is intended for debugging the compiler itself.
passes and libgccjit log file."
:type 'natnum
:safe #'natnump
- :version "28.1")
+ :version "29.1")
(defcustom native-comp-verbose 0
"Compiler verbosity for native compilation, a number between 0 and 3.
@@ -2057,9 +2057,10 @@ and the annotation emission."
"Lexically-scoped FUNCTION."
(let ((args (comp-func-l-args function)))
(cons (make-comp-mvar :constant (comp-args-base-min args))
- (make-comp-mvar :constant (if (comp-args-p args)
- (comp-args-max args)
- 'many)))))
+ (make-comp-mvar :constant (cond
+ ((comp-args-p args) (comp-args-max args))
+ ((comp-nargs-rest args) 'many)
+ (t (comp-nargs-nonrest args)))))))
(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d))
"Dynamically scoped FUNCTION."
@@ -3689,8 +3690,7 @@ Prepare every function for final compilation and drive
the C back-end."
(print-circle t)
(print-escape-multibyte t)
(expr `((require 'comp)
- (setf comp-no-spawn t
- native-comp-verbose ,native-comp-verbose
+ (setf 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
@@ -3716,7 +3716,8 @@ Prepare every function for final compilation and drive
the C back-end."
(if (zerop
(call-process (expand-file-name invocation-name
invocation-directory)
- nil t t "--batch" "-l" temp-file))
+ nil t t "-no-comp-spawn" "--batch" "-l"
+ temp-file))
(progn
(delete-file temp-file)
output)
@@ -3948,7 +3949,6 @@ display a message."
source-file (comp-el-to-eln-filename source-file))))
do (let* ((expr `((require 'comp)
(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
@@ -4005,7 +4005,8 @@ display a message."
:command (list
(expand-file-name invocation-name
invocation-directory)
- "--batch" "-l" temp-file)
+ "-no-comp-spawn" "--batch" "-l"
+ temp-file)
:sentinel
(lambda (process _event)
(run-hook-with-args
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index 6d4b29b552..8e61797315 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -201,7 +201,7 @@ This function is modeled after
`minibuffer-complete-and-exit'."
(if doexit (exit-minibuffer))))
(defun crm--choose-completion-string (choice buffer base-position
- &rest ignored)
+ &rest _ignored)
"Completion string chooser for `completing-read-multiple'.
This is called from `choose-completion-string-functions'.
It replaces the string that is currently being completed, without
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/hierarchy.el b/lisp/emacs-lisp/hierarchy.el
index 6c95d86b47..fb5d518b22 100644
--- a/lisp/emacs-lisp/hierarchy.el
+++ b/lisp/emacs-lisp/hierarchy.el
@@ -71,7 +71,8 @@
(:conc-name hierarchy--))
(roots (list)) ; list of the hierarchy roots (no parent)
(parents (make-hash-table :test 'equal)) ; map an item to its parent
- (children (make-hash-table :test 'equal)) ; map an item to its childre
+ (children (make-hash-table :test 'equal)) ; map an item to its children
+ (delaying-parents (make-hash-table :test 'equal)) ; map an item to its
childrenfn
;; cache containing the set of all items in the hierarchy
(seen-items (make-hash-table :test 'equal))) ; map an item to t
@@ -133,7 +134,8 @@ keys are :key and :test."
"Create a hierarchy and return it."
(hierarchy--make))
-(defun hierarchy-add-tree (hierarchy item parentfn &optional childrenfn
acceptfn)
+(defun hierarchy-add-tree (hierarchy item parentfn
+ &optional childrenfn acceptfn
delay-children-p)
"In HIERARCHY, add ITEM.
PARENTFN is either nil or a function defining the child-to-parent
@@ -151,27 +153,39 @@ CHILDRENFN are expected to be coherent with each other.
ACCEPTFN is a function returning non-nil if its parameter (any object)
should be an item of the hierarchy. By default, ACCEPTFN returns non-nil
-if its parameter is non-nil."
+if its parameter is non-nil.
+
+DELAY-CHILDREN-P is a predicate determining whether the children that would
+normally be processed by CHILDRENFN should, instead, have their processing be
+delayed and stored to be processed by CHILDRENFN when the child is selected
+during use of the hierarchy."
(unless (hierarchy-has-item hierarchy item)
(let ((acceptfn (or acceptfn #'identity)))
(hierarchy--seen-items-add hierarchy item)
(let ((parent (and parentfn (funcall parentfn item))))
(when (funcall acceptfn parent)
(hierarchy--add-relation hierarchy item parent acceptfn)
- (hierarchy-add-tree hierarchy parent parentfn childrenfn)))
- (let ((children (and childrenfn (funcall childrenfn item))))
- (mapc (lambda (child)
- (when (funcall acceptfn child)
- (hierarchy--add-relation hierarchy child item acceptfn)
- (hierarchy-add-tree hierarchy child parentfn childrenfn)))
- children)))))
-
-(defun hierarchy-add-trees (hierarchy items parentfn &optional childrenfn
acceptfn)
+ (hierarchy-add-tree hierarchy parent
+ parentfn (if delay-children-p nil childrenfn))))
+ (if (and childrenfn delay-children-p)
+ (map-put! (hierarchy--delaying-parents hierarchy) item childrenfn)
+ (let ((children (and childrenfn (funcall childrenfn item))))
+ (map-put! (hierarchy--delaying-parents hierarchy) item nil)
+ (mapc (lambda (child)
+ (when (funcall acceptfn child)
+ (hierarchy--add-relation hierarchy child item acceptfn)
+ (hierarchy-add-tree hierarchy child parentfn childrenfn)))
+ children))))))
+
+(defun hierarchy-add-trees (hierarchy items parentfn
+ &optional childrenfn acceptfn
delay-children-p)
"Call `hierarchy-add-tree' on HIERARCHY and each element of ITEMS.
-PARENTFN, CHILDRENFN and ACCEPTFN have the same meaning as in `hierarchy-add'."
+PARENTFN, CHILDRENFN, ACCEPTFN, and DELAY-CHILDREN-P have the same meaning as
in
+`hierarchy-add'."
(seq-map (lambda (item)
- (hierarchy-add-tree hierarchy item parentfn childrenfn acceptfn))
+ (hierarchy-add-tree hierarchy item parentfn
+ childrenfn acceptfn delay-children-p))
items))
(defun hierarchy-add-list (hierarchy list &optional wrap childrenfn)
@@ -541,6 +555,30 @@ nil. The buffer is returned."
buffer))
(declare-function widget-convert "wid-edit")
+(defun hierarchy--create-delayed-tree-widget (elem labelfn indent childrenfn)
+ "Return a list of tree-widgets for the children generated.
+
+ELEM is the element of the hierarchy passed from
+`hierarchy-convert-to-tree-widget'; it and the CHILDRENFN are used to generate
+the children of the element dynamically.
+
+LABELFN is the same function passed to `hierarchy-convert-to-tree-widget'.
+
+INDENT is the same function passed to `hierarchy-convert-to-tree-widget'.
+
+CHILDRENFN is the function used to discover the children of ELEM."
+ (lambda (_widget)
+ (mapcar
+ (lambda (item)
+ (widget-convert
+ 'tree-widget
+ :tag (hierarchy-labelfn-to-string labelfn item indent)
+ :expander (hierarchy--create-delayed-tree-widget
+ item
+ labelfn
+ (1+ indent)
+ childrenfn)))
+ (funcall childrenfn elem))))
(defun hierarchy-convert-to-tree-widget (hierarchy labelfn)
"Return a tree-widget for HIERARCHY.
@@ -550,10 +588,21 @@ node label."
(require 'wid-edit)
(require 'tree-widget)
(hierarchy-map-tree (lambda (item indent children)
- (widget-convert
- 'tree-widget
- :tag (hierarchy-labelfn-to-string labelfn item indent)
- :args children))
+ (let ((childrenfn (map-elt
+ (hierarchy--delaying-parents
hierarchy)
+ item)))
+ (apply
+ #'widget-convert
+ (list 'tree-widget
+ :tag (hierarchy-labelfn-to-string labelfn
item indent)
+ (if childrenfn :expander :args)
+ (if childrenfn
+ (hierarchy--create-delayed-tree-widget
+ item
+ labelfn
+ (1+ indent)
+ childrenfn)
+ children)))))
hierarchy))
(defun hierarchy-tree-display (hierarchy labelfn &optional buffer)
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/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/package.el b/lisp/emacs-lisp/package.el
index 425abfeea5..977a16a7e1 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -872,8 +872,7 @@ byte-compilation of the new package to fail."
If DEPS is non-nil, also activate its dependencies (unless they
are already activated).
If RELOAD is non-nil, also `load' any files inside the package which
-correspond to previously loaded files (those returned by
-`package--list-loaded-files')."
+correspond to previously loaded files."
(let* ((name (package-desc-name pkg-desc))
(pkg-dir (package-desc-dir pkg-desc)))
(unless pkg-dir
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 897c35b5b1..0f9b60730f 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -211,6 +211,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
(defvar reb-valid-string ""
"String in mode line showing validity of RE.")
+(put 'reb-valid-string 'risky-local-variable t)
(defconst reb-buffer "*RE-Builder*"
"Buffer to use for the RE Builder.")
@@ -308,13 +309,13 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
"Return t if display is capable of displaying colors."
(eq 'color (frame-parameter nil 'display-type)))
-(defsubst reb-lisp-syntax-p ()
+(defun reb-lisp-syntax-p ()
"Return non-nil if RE Builder uses `rx' syntax."
(eq reb-re-syntax 'rx))
-(defmacro reb-target-binding (symbol)
+(defun reb-target-value (symbol)
"Return binding for SYMBOL in the RE Builder target buffer."
- `(with-current-buffer reb-target-buffer ,symbol))
+ (buffer-local-value symbol reb-target-buffer))
(defun reb-initialize-buffer ()
"Initialize the current buffer as a RE Builder buffer."
@@ -440,7 +441,7 @@ provided in the Commentary section of this library."
(interactive)
(reb-update-regexp)
(let ((re (with-output-to-string
- (print (reb-target-binding reb-regexp)))))
+ (print (reb-target-value 'reb-regexp)))))
(setq re (substring re 1 (1- (length re))))
(setq re (string-replace "\n" "\\n" re))
(kill-new re)
@@ -518,12 +519,17 @@ An actual update is only done if the regexp has changed
or if the
optional fourth argument FORCE is non-nil."
(let ((prev-valid reb-valid-string)
(new-valid
- (condition-case nil
+ (condition-case err
(progn
(when (or (reb-update-regexp) force)
(reb-do-update))
"")
- (error " *invalid*"))))
+ (error (propertize
+ (format " %s"
+ (if (and (consp (cdr err)) (stringp (cadr err)))
+ (format "%s: %s" (car err) (cadr err))
+ (car err)))
+ 'face 'font-lock-warning-face)))))
(setq reb-valid-string new-valid)
(force-mode-line-update)
@@ -554,7 +560,7 @@ optional fourth argument FORCE is non-nil."
(if reb-subexp-mode
(format " (subexp %s)" (or reb-subexp-displayed "-"))
"")
- (if (not (reb-target-binding case-fold-search))
+ (if (not (reb-target-value 'case-fold-search))
" Case"
"")))
(force-mode-line-update))
@@ -600,7 +606,7 @@ optional fourth argument FORCE is non-nil."
(defun reb-insert-regexp ()
"Insert current RE."
- (let ((re (or (reb-target-binding reb-regexp)
+ (let ((re (or (reb-target-value 'reb-regexp)
(reb-empty-regexp))))
(cond ((eq reb-re-syntax 'read)
(print re (current-buffer)))
@@ -608,7 +614,7 @@ optional fourth argument FORCE is non-nil."
(insert "\n\"" re "\""))
;; For the Lisp syntax we need the "source" of the regexp
((reb-lisp-syntax-p)
- (insert (or (reb-target-binding reb-regexp-src)
+ (insert (or (reb-target-value 'reb-regexp-src)
(reb-empty-regexp)))))))
(defun reb-cook-regexp (re)
@@ -627,9 +633,8 @@ Return t if the (cooked) expression changed."
(prog1
(not (string= oldre re))
(setq reb-regexp re)
- ;; Only update the source re for the lisp formats
- (when (reb-lisp-syntax-p)
- (setq reb-regexp-src re-src)))))))
+ ;; Update the source re for the Lisp formats.
+ (setq reb-regexp-src re-src))))))
;; And now the real core of the whole thing
@@ -644,7 +649,7 @@ Return t if the (cooked) expression changed."
(defun reb-update-overlays (&optional subexp)
"Switch to `reb-target-buffer' and mark all matches of `reb-regexp'.
If SUBEXP is non-nil mark only the corresponding sub-expressions."
- (let* ((re (reb-target-binding reb-regexp))
+ (let* ((re (reb-target-value 'reb-regexp))
(subexps (reb-count-subexps re))
(matches 0)
(submatches 0)
diff --git a/lisp/emacs-lisp/tabulated-list.el
b/lisp/emacs-lisp/tabulated-list.el
index c01f3fd4fe..206c10a773 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -374,7 +374,7 @@ Optional arg POS is a buffer position where to look for a
fake header;
defaults to `point-min'."
(overlays-at (or pos (point-min))))
-(defun tabulated-list-revert (&rest ignored)
+(defun tabulated-list-revert (&rest _ignored)
"The `revert-buffer-function' for `tabulated-list-mode'.
It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
(interactive)
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index c590b45fd2..8759282a2a 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -62,7 +62,7 @@
;; You can customize the prefix and the face used to display it,
;; `erc-capab-identify-unidentified'. If the value of
;; `erc-capab-identify-prefix' is nil or you disable this module (see
-;; `erc-capab-identify-disable'), no prefix will be inserted, but the
+;; `erc-capab-identify-activated'), no prefix will be inserted, but the
;; flag sent by the server will still be stripped.
;;; Code:
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 2c8f8fb72b..d8fb879819 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1256,7 +1256,7 @@ Signal an error when the network cannot be determined."
;; but aren't being proxied through to a real network. The
;; service may send a 422 but no NETWORK param (or *any* 005s).
(let ((m (concat "Failed to determine network. Please set entry for "
- erc-server-announced-name " in `erc-network-alist'.")))
+ erc-server-announced-name " in `erc-networks-alist'.")))
(erc-display-error-notice parsed m)
(erc-error "Failed to determine network"))) ; beep
(setq erc-network name))
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 3516592fc3..7199db3e44 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -635,13 +635,10 @@ 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.
diff --git a/lisp/files.el b/lisp/files.el
index 3fa0f2f3b8..a282532258 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3863,7 +3863,7 @@ If these settings come from directory-local variables,
then
DIR-NAME is the name of the associated directory. Otherwise it is nil."
;; Find those variables that we may want to save to
;; `safe-local-variable-values'.
- (let (all-vars risky-vars unsafe-vars ignored)
+ (let (all-vars risky-vars unsafe-vars)
(dolist (elt variables)
(let ((var (car elt))
(val (cdr elt)))
diff --git a/lisp/follow.el b/lisp/follow.el
index adf1c1b762..c26949985e 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -1301,7 +1301,7 @@ non-first windows in Follow mode."
"The buffer current at the last call to `follow-adjust-window' or nil.
`follow-mode' is not necessarily enabled in this buffer.")
-;; This function is added to `pre-display-function' and is thus called
+;; This function is added to `pre-redisplay-function' and is thus called
;; before each redisplay operation. It supersedes (2018-09) the
;; former use of the post command hook, and now does the right thing
;; when a program calls `redisplay' or `sit-for'.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 3bea1a4c1d..814d21823d 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -26,7 +26,6 @@
(eval-when-compile (require 'cl-lib))
(defvar tool-bar-map)
-(defvar w3m-minor-mode-map)
(require 'gnus)
(require 'gnus-sum)
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index 18732218c9..29d963984b 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -65,7 +65,7 @@
;; http://thread.gmane.org/v9fxx9fkm4.fsf@marauder.physik.uni-ulm.de
;; FIXME: Check if `gnus-bookmark.el' should use
-;; `bookmark-make-cell-function'.
+;; `bookmark-make-record-function'.
;; Cf. http://article.gmane.org/gmane.emacs.gnus.general/66076
(defgroup gnus-bookmark nil
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index 32c475239e..5a0cf77a32 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -41,10 +41,7 @@ The following commands are available:\\<widget-keymap>
\\[widget-forward] Move to next button or editable field.
\\[widget-backward] Move to previous button or editable field.
\\[widget-button-click] Activate button under the mouse pointer.
-\\[widget-button-press] Activate button under point.
-
-Entry to this mode calls the value of `gnus-custom-mode-hook'
-if that value is non-nil."
+\\[widget-button-press] Activate button under point."
(use-local-map widget-keymap)
;; Emacs stuff:
(when (and (facep 'custom-button-face)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 8d9e50059f..4963fd083f 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1810,7 +1810,7 @@ where unread is an integer count of calculated unread
messages (or nil), and info is a regular gnus info entry.
The info element is shared with the same element of
-`gnus-newrc-alist', so as to conserve space."
+`gnus-newsrc-alist', so as to conserve space."
(let ((alist gnus-newsrc-alist)
(ohashtb gnus-newsrc-hashtb)
info method gname rest methods)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index a714e31876..24cba97718 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -4385,7 +4385,7 @@ it is left unchanged."
(setq method (or (cdr server) res))
(throw 'exit nil))))
((and (stringp (car server))
- (string= (car server) from))
+ (string-equal-ignore-case (car server) from))
(setq method (cdr server))
(throw 'exit nil)))))
(when method
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index 9045966df5..44ce1c9485 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -189,24 +189,8 @@ If TYPE is `text/plain' CRLF->LF translation may occur."
(quoted-printable-decode-region (point-min) (point-max))
t)
((eq encoding 'base64)
- (base64-decode-region
- (point-min)
- (save-excursion
- ;; Some mailers insert whitespace junk at the end which
- ;; base64-decode-region dislikes.
- (goto-char (point-min))
- (while (re-search-forward "^[\t ]*\r?\n" nil t)
- (delete-region (match-beginning 0) (match-end 0)))
- ;; Also ignore junk which could have been added by
- ;; mailing list software by finding the final line with
- ;; base64 text.
- (goto-char (point-max))
- (beginning-of-line)
- (while (and (not (mm-base64-line-p))
- (not (bobp)))
- (forward-line -1))
- (forward-line 1)
- (point))))
+ ;; MIME says to ignore any non-base64 junk
+ (base64-decode-region (point-min) (point-max) nil t))
((memq encoding '(nil 7bit 8bit binary))
;; Do nothing.
t)
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index 7bb116d0c5..409befc242 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -152,7 +152,7 @@ certificate."
(defcustom smime-CA-file (car (gnutls-trustfiles))
"File containing certificates for CAs you trust.
The file should contain certificates in PEM format. By default,
-this is initialized from the `gnutls-trusfiles' variable."
+this is initialized from the `gnutls-trustfiles' variable."
:version "29.1"
:type '(choice (const :tag "none" nil)
file))
diff --git a/lisp/help.el b/lisp/help.el
index 0f5342b77d..b25a8ce299 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -55,66 +55,68 @@
This variable is bound to t during the preparation of a *Help*
buffer.")
-(defvar help-map
- (let ((map (make-sparse-keymap)))
- (define-key map (char-to-string help-char) 'help-for-help)
- (define-key map [help] 'help-for-help)
- (define-key map [f1] 'help-for-help)
- (define-key map "." 'display-local-help)
- (define-key map "?" 'help-for-help)
-
- (define-key map "\C-a" 'about-emacs)
- (define-key map "\C-c" 'describe-copying)
- (define-key map "\C-d" 'view-emacs-debugging)
- (define-key map "\C-e" 'view-external-packages)
- (define-key map "\C-f" 'view-emacs-FAQ)
- (define-key map "\C-m" 'view-order-manuals)
- (define-key map "\C-n" 'view-emacs-news)
- (define-key map "\C-o" 'describe-distribution)
- (define-key map "\C-p" 'view-emacs-problems)
- (define-key map "\C-s" 'search-forward-help-for-help)
- (define-key map "\C-t" 'view-emacs-todo)
- (define-key map "\C-w" 'describe-no-warranty)
-
- ;; This does not fit the pattern, but it is natural given the C-\ command.
- (define-key map "\C-\\" 'describe-input-method)
-
- (define-key map "C" 'describe-coding-system)
- (define-key map "F" 'Info-goto-emacs-command-node)
- (define-key map "I" 'describe-input-method)
- (define-key map "K" 'Info-goto-emacs-key-command-node)
- (define-key map "L" 'describe-language-environment)
- (define-key map "S" 'info-lookup-symbol)
-
- (define-key map "a" 'apropos-command)
- (define-key map "b" 'describe-bindings)
- (define-key map "c" 'describe-key-briefly)
- (define-key map "d" 'apropos-documentation)
- (define-key map "e" 'view-echo-area-messages)
- (define-key map "f" 'describe-function)
- (define-key map "g" 'describe-gnu-project)
- (define-key map "h" 'view-hello-file)
-
- (define-key map "i" 'info)
- (define-key map "4i" 'info-other-window)
-
- (define-key map "k" 'describe-key)
- (define-key map "l" 'view-lossage)
- (define-key map "m" 'describe-mode)
- (define-key map "o" 'describe-symbol)
- (define-key map "n" 'view-emacs-news)
- (define-key map "p" 'finder-by-keyword)
- (define-key map "P" 'describe-package)
- (define-key map "r" 'info-emacs-manual)
- (define-key map "R" 'info-display-manual)
- (define-key map "s" 'describe-syntax)
- (define-key map "t" 'help-with-tutorial)
- (define-key map "v" 'describe-variable)
- (define-key map "w" 'where-is)
- (define-key map "x" 'describe-command)
- (define-key map "q" 'help-quit-or-quick)
- map)
- "Keymap for characters following the Help key.")
+(defun help-key ()
+ "Return `help-char' in a format suitable for the `keymap-set' KEY argument."
+ (key-description (char-to-string help-char)))
+
+(defvar-keymap help-map
+ :doc "Keymap for characters following the Help key."
+ (help-key) #'help-for-help
+ "<help>" #'help-for-help
+ "<f1>" #'help-for-help
+ "." #'display-local-help
+ "?" #'help-for-help
+
+ "C-a" #'about-emacs
+ "C-c" #'describe-copying
+ "C-d" #'view-emacs-debugging
+ "C-e" #'view-external-packages
+ "C-f" #'view-emacs-FAQ
+ "RET" #'view-order-manuals
+ "C-n" #'view-emacs-news
+ "C-o" #'describe-distribution
+ "C-p" #'view-emacs-problems
+ "C-s" #'search-forward-help-for-help
+ "C-t" #'view-emacs-todo
+ "C-w" #'describe-no-warranty
+
+ ;; This does not fit the pattern, but it is natural given the C-\ command.
+ "C-\\" #'describe-input-method
+
+ "C" #'describe-coding-system
+ "F" #'Info-goto-emacs-command-node
+ "I" #'describe-input-method
+ "K" #'Info-goto-emacs-key-command-node
+ "L" #'describe-language-environment
+ "S" #'info-lookup-symbol
+
+ "a" #'apropos-command
+ "b" #'describe-bindings
+ "c" #'describe-key-briefly
+ "d" #'apropos-documentation
+ "e" #'view-echo-area-messages
+ "f" #'describe-function
+ "g" #'describe-gnu-project
+ "h" #'view-hello-file
+
+ "i" #'info
+ "4 i" #'info-other-window
+
+ "k" #'describe-key
+ "l" #'view-lossage
+ "m" #'describe-mode
+ "o" #'describe-symbol
+ "n" #'view-emacs-news
+ "p" #'finder-by-keyword
+ "P" #'describe-package
+ "r" #'info-emacs-manual
+ "R" #'info-display-manual
+ "s" #'describe-syntax
+ "t" #'help-with-tutorial
+ "v" #'describe-variable
+ "w" #'where-is
+ "x" #'describe-command
+ "q" #'help-quit-or-quick)
(define-key global-map (char-to-string help-char) 'help-command)
(define-key global-map [help] 'help-command)
@@ -745,7 +747,7 @@ or a buffer name."
(setq-local outline-level (lambda () 1))
(setq-local outline-minor-mode-cycle t
outline-minor-mode-highlight t
- outline-minor-mode-insert-buttons t)
+ outline-minor-mode-use-buttons 'insert)
(outline-minor-mode 1)
(save-excursion
(goto-char (point-min))
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 19afdaa278..0a63e0a1dd 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -139,7 +139,7 @@ See `icomplete-delay-completions-threshold'."
(defvar icomplete-in-buffer nil
"If non-nil, also use Icomplete when completing in non-mini buffers.
-This affects commands like `complete-in-region', but not commands
+This affects commands like `completion-in-region', but not commands
that use their own completions setup.")
(defcustom icomplete-minibuffer-setup-hook nil
diff --git a/lisp/ido.el b/lisp/ido.el
index 1d0082da97..77e4dd447d 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -3915,7 +3915,7 @@ If `ido-change-word-sub' cannot be found in WORD, return
nil."
"Return dotted pair (RES . 1)."
(cons res 1))
-(defun ido-choose-completion-string (choice &rest ignored)
+(defun ido-choose-completion-string (choice &rest _ignored)
(when (ido-active)
;; Insert the completion into the buffer where completion was requested.
(and ido-completion-buffer
diff --git a/lisp/image/image-dired-external.el
b/lisp/image/image-dired-external.el
index 026a84560d..b1f8a6c228 100644
--- a/lisp/image/image-dired-external.el
+++ b/lisp/image/image-dired-external.el
@@ -216,7 +216,7 @@ Each item has the form (ORIGINAL-FILE TARGET-FILE).")
"Maximum number of concurrent jobs permitted for generating images.
Increase at own risk. If you want to experiment with this,
consider setting `image-dired-debug' to a non-nil value to see
-the time spent on generating thumbnails. Run `image-clear-cache'
+the time spent on generating thumbnails. Run `clear-image-cache'
and remove the cached thumbnail files between each trial run.")
(defun image-dired-pngnq-thumb (spec)
diff --git a/lisp/info.el b/lisp/info.el
index fabba2734a..02dde50dd6 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1883,6 +1883,9 @@ See `completing-read' for a description of arguments and
usage."
(t (complete-with-action
code Info-read-node-completion-table string predicate))))
+(defvar Info-minibuf-history nil
+ "History for `Info-read-node-name'.")
+
;; Arrange to highlight the proper letters in the completion list buffer.
(defun Info-read-node-name (prompt &optional default)
"Read an Info node name with completion, prompting with PROMPT.
@@ -2481,7 +2484,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))
@@ -2540,7 +2542,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/mule-cmds.el b/lisp/international/mule-cmds.el
index 48e5c9aa1f..61a26b504c 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1208,6 +1208,16 @@ Arguments are the same as `set-language-info'."
(list 'const lang))
(sort (mapcar 'car language-info-alist) 'string<))))))
+(defun set-language-info-setup-keymap (lang-env alist describe-map setup-map)
+ "Setup menu items for LANG-ENV.
+See `set-language-info-alist' for details of other arguments."
+ (let ((doc (assq 'documentation alist)))
+ (when doc
+ (define-key-after describe-map (vector (intern lang-env))
+ (cons lang-env 'describe-specified-language-support))))
+ (define-key-after setup-map (vector (intern lang-env))
+ (cons lang-env 'setup-specified-language-environment)))
+
(defun set-language-info-alist (lang-env alist &optional parents)
"Store ALIST as the definition of language environment LANG-ENV.
ALIST is an alist of KEY and INFO values. See the documentation of
@@ -1222,51 +1232,44 @@ in the European submenu in each of those two menus."
(setq lang-env (symbol-name lang-env)))
((stringp lang-env)
(setq lang-env (purecopy lang-env))))
- (let ((describe-map describe-language-environment-map)
- (setup-map setup-language-environment-map))
- (if parents
- (let ((l parents)
- map parent-symbol parent prompt)
- (while l
- (if (symbolp (setq parent-symbol (car l)))
- (setq parent (symbol-name parent))
- (setq parent parent-symbol parent-symbol (intern parent)))
- (setq map (lookup-key describe-map (vector parent-symbol)))
- ;; This prompt string is for define-prefix-command, so
- ;; that the map it creates will be suitable for a menu.
- (or map (setq prompt (format "%s Environment" parent)))
- (if (not map)
- (progn
- (setq map (intern (format "describe-%s-environment-map"
- (downcase parent))))
- (define-prefix-command map nil prompt)
- (define-key-after describe-map (vector parent-symbol)
- (cons parent map))))
- (setq describe-map (symbol-value map))
- (setq map (lookup-key setup-map (vector parent-symbol)))
- (if (not map)
- (progn
- (setq map (intern (format "setup-%s-environment-map"
- (downcase parent))))
- (define-prefix-command map nil prompt)
- (define-key-after setup-map (vector parent-symbol)
- (cons parent map))))
- (setq setup-map (symbol-value map))
- (setq l (cdr l)))))
-
- ;; Set up menu items for this language env.
- (let ((doc (assq 'documentation alist)))
- (when doc
- (define-key-after describe-map (vector (intern lang-env))
- (cons lang-env 'describe-specified-language-support))))
- (define-key-after setup-map (vector (intern lang-env))
- (cons lang-env 'setup-specified-language-environment))
-
- (dolist (elt alist)
- (set-language-info-internal lang-env (car elt) (cdr elt)))
-
- (if (equal lang-env current-language-environment)
- (set-language-environment lang-env))))
+ (if parents
+ (while parents
+ (let (describe-map setup-map parent-symbol parent prompt)
+ (if (symbolp (setq parent-symbol (car parents)))
+ (setq parent (symbol-name parent))
+ (setq parent parent-symbol parent-symbol (intern parent)))
+ (setq describe-map (lookup-key describe-language-environment-map
+ (vector parent-symbol)))
+ ;; This prompt string is for define-prefix-command, so
+ ;; that the map it creates will be suitable for a menu.
+ (or describe-map (setq prompt (format "%s Environment" parent)))
+ (unless describe-map
+ (setq describe-map (intern (format "describe-%s-environment-map"
+ (downcase parent))))
+ (define-prefix-command describe-map nil prompt)
+ (define-key-after
+ describe-language-environment-map
+ (vector parent-symbol) (cons parent describe-map)))
+ (setq setup-map (lookup-key setup-language-environment-map
+ (vector parent-symbol)))
+ (unless setup-map
+ (setq setup-map (intern (format "setup-%s-environment-map"
+ (downcase parent))))
+ (define-prefix-command setup-map nil prompt)
+ (define-key-after
+ setup-language-environment-map
+ (vector parent-symbol) (cons parent setup-map)))
+ (setq parents (cdr parents))
+ (set-language-info-setup-keymap
+ lang-env alist
+ (symbol-value describe-map) (symbol-value setup-map))))
+ (set-language-info-setup-keymap
+ lang-env alist
+ describe-language-environment-map setup-language-environment-map))
+ (dolist (elt alist)
+ (set-language-info-internal lang-env (car elt) (cdr elt)))
+ (if (equal lang-env current-language-environment)
+ (set-language-environment lang-env)))
(defun read-language-name (key prompt &optional default)
"Read a language environment name which has information for KEY.
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index cdf2e527e2..6e49c9cb21 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -812,7 +812,7 @@ but still contains full information about each coding
system."
(declare-function font-info "font.c" (name &optional frame))
-(defun describe-font-internal (font-info &optional ignored)
+(defun describe-font-internal (font-info &optional _ignored)
"Print information about a font in FONT-INFO.
The IGNORED argument is ignored."
(print-list "name (opened by):" (aref font-info 0))
diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el
index 82eba1b5d5..f8ff89c314 100644
--- a/lisp/international/textsec.el
+++ b/lisp/international/textsec.el
@@ -156,7 +156,7 @@ Levels are (in decreasing order of restrictiveness)
`ascii-only',
tibetan)))
;; The string is covered by Latin and any one other Recommended
;; script, except Cyrillic, Greek.
- 'moderately-retrictive)
+ 'moderately-restrictive)
;; Fixme `minimally-restrictive' -- needs well-formedness criteria
;; and Identifier Profile.
(t
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index c34017d9b3..230db3b100 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -253,7 +253,7 @@ in this language environment."))
(documentation . "\
Language environment for Gāndhārī, Sanskrit, and other languages
using the Kharoṣṭhī script."))
- '("Misc"))
+ '("Indian"))
(let ((consonant "[\U00010A00\U00010A10-\U00010A35]")
(vowel "[\U00010A01-\U00010A06]")
diff --git a/lisp/loadup.el b/lisp/loadup.el
index e940a32100..2a9aff4c1f 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -366,6 +366,11 @@
(load "emacs-lisp/shorthands")
(load "emacs-lisp/eldoc")
+(load "emacs-lisp/cconv")
+(when (and (compiled-function-p (symbol-function 'cconv-fv))
+ (compiled-function-p (symbol-function 'macroexpand-all)))
+ (setq internal-make-interpreted-closure-function
+ #'cconv-make-interpreted-closure))
(load "cus-start") ;Late to reduce customize-rogue (needs loaddefs.el anyway)
(if (not (eq system-type 'ms-dos))
(load "tooltip"))
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index b959f45250..0144a34e5e 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -50,6 +50,23 @@ Setting this option to nil might speed up the generation of
summaries."
:type 'boolean
:group 'rmail-summary)
+(defcustom rmail-summary-apply-filters-consecutively nil
+ "If non-nil, Rmail summary commands apply filtering on top existing
filtering.
+When this variable is non-nil, `rmail-summary-by-*' commands work on the
+current summary, and so their filtering can be stacked one on top of another.
+This allows gradual narrowing of the selection of the messages."
+ :type 'boolean
+ :version "29.1"
+ :group 'rmail-summary)
+
+(defvar rmail-summary-currently-displayed-msgs nil
+ "String made of `y' and `n'.
+The character at position i tells wether message i is shown in the
+summary or not. First character is ignored.
+Used when applying `rmail-summary-by-*' commands consecutively. Filled
+by `rmail-summary-fill-displayed-messages'.")
+(put 'rmail-summary-currently-displayed-msgs 'permanent-local t)
+
(defvar rmail-summary-font-lock-keywords
'(("^ *[0-9]+D.*" . font-lock-string-face) ; Deleted.
("^ *[0-9]+-.*" . font-lock-type-face) ; Unread.
@@ -267,6 +284,34 @@ Setting this option to nil might speed up the generation
of summaries."
(defun rmail-update-summary (&rest _)
(apply (car rmail-summary-redo) (cdr rmail-summary-redo)))
+(defun rmail-summary-fill-displayed-messages ()
+ "Fill the rmail-summary-currently-displayed-msgs string."
+ (with-current-buffer rmail-buffer
+ (with-current-buffer rmail-summary-buffer
+ (setq rmail-summary-currently-displayed-msgs
+ (make-string (1+ rmail-total-messages) ?n))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (aset rmail-summary-currently-displayed-msgs
+ (string-to-number (thing-at-point 'line))
+ ?y)
+ (forward-line 1)))))
+
+(defun rmail-summary-negate ()
+ "Toggle display of messages that match the summary and those which do not."
+ (interactive)
+ (rmail-summary-fill-displayed-messages)
+ (rmail-new-summary "Negate"
+ '(rmail-summary-by-regexp ".*")
+ (lambda (msg)
+ (if
+ (= (aref rmail-summary-currently-displayed-msgs msg)
+ ?n)
+ (progn
+ (aset rmail-summary-currently-displayed-msgs msg
?y) t)
+ (progn
+ (aset rmail-summary-currently-displayed-msgs msg ?n)
nil)))))
+
;;;###autoload
(defun rmail-summary ()
"Display a summary of all messages, one line per message."
@@ -282,9 +327,16 @@ LABELS should be a string containing the desired labels,
separated by commas."
(setq labels (or rmail-last-multi-labels
(error "No label specified"))))
(setq rmail-last-multi-labels labels)
+ (if rmail-summary-apply-filters-consecutively
+ (rmail-summary-fill-displayed-messages))
(rmail-new-summary (concat "labels " labels)
(list 'rmail-summary-by-labels labels)
- 'rmail-message-labels-p
+ (if rmail-summary-apply-filters-consecutively
+ (lambda (msg l)
+ (and (= (aref rmail-summary-currently-displayed-msgs
msg)
+ ?y)
+ (rmail-message-labels-p msg l)))
+ 'rmail-message-labels-p)
(concat " \\("
(mail-comma-list-regexp labels)
"\\)\\(,\\|\\'\\)")))
@@ -297,10 +349,18 @@ but if PRIMARY-ONLY is non-nil (prefix arg given),
only look in the To and From fields.
RECIPIENTS is a regular expression."
(interactive "sRecipients to summarize by: \nP")
+ (if rmail-summary-apply-filters-consecutively
+ (rmail-summary-fill-displayed-messages))
(rmail-new-summary
(concat "recipients " recipients)
(list 'rmail-summary-by-recipients recipients primary-only)
- 'rmail-message-recipients-p recipients primary-only))
+ (if rmail-summary-apply-filters-consecutively
+ (lambda (msg r &optional po)
+ (and (= (aref rmail-summary-currently-displayed-msgs msg)
+ ?y)
+ (rmail-message-recipients-p msg r po)))
+ 'rmail-message-recipients-p)
+ recipients primary-only))
(defun rmail-message-recipients-p (msg recipients &optional primary-only)
(rmail-apply-in-message msg 'rmail-message-recipients-p-1
@@ -328,9 +388,16 @@ Emacs will list the message in the summary."
(setq regexp (or rmail-last-regexp
(error "No regexp specified"))))
(setq rmail-last-regexp regexp)
+ (if rmail-summary-apply-filters-consecutively
+ (rmail-summary-fill-displayed-messages))
(rmail-new-summary (concat "regexp " regexp)
(list 'rmail-summary-by-regexp regexp)
- 'rmail-message-regexp-p
+ (if rmail-summary-apply-filters-consecutively
+ (lambda (msg r)
+ (and (= (aref rmail-summary-currently-displayed-msgs
msg)
+ ?y)
+ (rmail-message-regexp-p msg r)))
+ 'rmail-message-regexp-p)
regexp))
(defun rmail-message-regexp-p (msg regexp)
@@ -365,7 +432,7 @@ Emacs will list the message in the summary."
;;;###autoload
(defun rmail-summary-by-topic (subject &optional whole-message)
"Display a summary of all messages with the given SUBJECT.
-Normally checks just the Subject field of headers; but with prefix
+Normally checks just the Subject field of headers; but when prefix
argument WHOLE-MESSAGE is non-nil, looks in the whole message.
SUBJECT is a regular expression."
(interactive
@@ -376,10 +443,18 @@ SUBJECT is a regular expression."
(if subject ", default current subject" "")
"): ")))
(list (read-string prompt nil nil subject) current-prefix-arg)))
+ (if rmail-summary-apply-filters-consecutively
+ (rmail-summary-fill-displayed-messages))
(rmail-new-summary
(concat "about " subject)
(list 'rmail-summary-by-topic subject whole-message)
- 'rmail-message-subject-p subject whole-message))
+ (if rmail-summary-apply-filters-consecutively
+ (lambda (msg s &optional wm)
+ (and (= (aref rmail-summary-currently-displayed-msgs msg)
+ ?y)
+ (rmail-message-subject-p msg s wm)))
+ 'rmail-message-subject-p)
+ subject whole-message))
(defun rmail-message-subject-p (msg subject &optional whole-message)
(if whole-message
@@ -402,9 +477,18 @@ sender of the current message."
(if sender ", default this message's sender" "")
"): ")))
(list (read-string prompt nil nil sender))))
+ (if rmail-summary-apply-filters-consecutively
+ (rmail-summary-fill-displayed-messages))
(rmail-new-summary
(concat "senders " senders)
- (list 'rmail-summary-by-senders senders) 'rmail-message-senders-p senders))
+ (list 'rmail-summary-by-senders senders)
+ (if rmail-summary-apply-filters-consecutively
+ (lambda (msg s)
+ (and (= (aref rmail-summary-currently-displayed-msgs msg)
+ ?y)
+ (rmail-message-senders-p msg s)))
+ 'rmail-message-senders-p)
+ senders))
(defun rmail-message-senders-p (msg senders)
(string-match senders (or (rmail-get-header "From" msg) "")))
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 387792eb31..3f75faa077 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -550,10 +550,10 @@ This also saves the value of `send-mail-function' via
Customize."
#'mail-send-and-exit)
;;;###autoload
-(defun sendmail-user-agent-compose (&optional to subject other-headers
- continue switch-function yank-action
- send-actions return-action
- &rest ignored)
+(defun sendmail-user-agent-compose ( &optional to subject other-headers
+ continue switch-function yank-action
+ send-actions return-action
+ &rest _ignored )
(if switch-function
(funcall switch-function "*mail*"))
(let ((cc (cdr (assoc-string "cc" other-headers t)))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 9f26e4f7f9..4898dfdb98 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -972,10 +972,18 @@ ALL-COMPLETIONS is the function that lists the
completions (it should
follow the calling convention of `completion-all-completions'),
and DOC describes the way this style of completion works.")
+(defun completion--update-styles-options (widget)
+ "Function to keep updated the options in `completion-category-overrides'."
+ (let ((lst (mapcar (lambda (x)
+ (list 'const (car x)))
+ completion-styles-alist)))
+ (widget-put widget :args (mapcar #'widget-convert lst))
+ widget))
+
(defconst completion--styles-type
`(repeat :tag "insert a new menu to add more styles"
- (choice ,@(mapcar (lambda (x) (list 'const (car x)))
- completion-styles-alist))))
+ (choice :convert-widget completion--update-styles-options)))
+
(defconst completion--cycling-threshold-type
'(choice (const :tag "No cycling" nil)
(const :tag "Always cycle" t)
@@ -1237,9 +1245,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/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/ldap.el b/lisp/net/ldap.el
index ccad8c4edb..de553468b1 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -156,7 +156,7 @@ Valid properties include:
"The name of the ldapsearch command line program."
:type '(string :tag "`ldapsearch' Program"))
-(defcustom ldap-ldapsearch-args '("-LLL" "-tt")
+(defcustom ldap-ldapsearch-args nil
"A list of additional arguments to pass to `ldapsearch'."
:type '(repeat :tag "`ldapsearch' Arguments"
(string :tag "Argument")))
@@ -609,7 +609,8 @@ an alist of attribute/value pairs."
(sizelimit (plist-get search-plist 'sizelimit))
(withdn (plist-get search-plist 'withdn))
(numres 0)
- arglist dn name value record result)
+ (arglist (list "-LLL" "-tt"))
+ dn name value record result)
(if (or (null filter)
(equal "" filter))
(error "No search filter"))
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index f65ef522f2..af196ccecf 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -40,7 +40,6 @@
;; Silence warnings
(defvar newsticker-groups)
-(defvar w3m-minor-mode-map)
(defvar newsticker--retrieval-timer-list nil
"List of timers for news retrieval.
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index eadaf00c4b..b7eeab1735 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1049,7 +1049,7 @@ Each element has the form (TYPE HANDLE), where TYPE is a
string
and HANDLE is either the symbol `immediate' or `deferred'.
Messages in an immediate batch are handled just like regular
messages, while deferred messages are stored in
-`rcirc-batch-messages'.")
+`rcirc-batched-messages'.")
(defvar-local rcirc-batch-attributes nil
"Alist mapping batch IDs to parameters.")
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 381e1fcd4f..b2caa62e51 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -385,7 +385,7 @@ Return the buffer associated with the connection."
(defun sieve-manage-open (server &optional port stream auth buffer)
"Open a network connection to a managesieve SERVER (string).
Optional argument PORT is port number (integer) on remote server.
-Optional argument STREAM is any of `sieve-manage-streams' (a symbol).
+Optional argument STREAM is any of `sieve-manage-stream' (a symbol).
Optional argument AUTH indicates authenticator to use, see
`sieve-manage-authenticators' for available authenticators.
If nil, chooses the best stream the server is capable of.
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 4d7d35a4de..912ea5f8bb 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -601,19 +601,30 @@ PROPERTIES is a list of file properties (strings)."
(remove-hook 'kill-emacs-hook
#'tramp-dump-connection-properties)))
+;;;###tramp-autoload
+(defcustom tramp-completion-use-cache t
+ "Whether to use the Tramp cache for completion of user and host names.
+Set it to nil if there are invalid entries in the cache, for
+example if the host configuration changes often, or if you plug
+your laptop to different networks frequently."
+ :group 'tramp
+ :version "29.1"
+ :type 'boolean)
+
;;;###tramp-autoload
(defun tramp-parse-connection-properties (method)
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from connection history."
- (mapcar
- (lambda (key)
- (and (tramp-file-name-p key)
- (string-equal method (tramp-file-name-method key))
- (not (tramp-file-name-localname key))
- (list (tramp-file-name-user key)
- (tramp-file-name-host key))))
- (hash-table-keys tramp-cache-data)))
+ (and tramp-completion-use-cache
+ (mapcar
+ (lambda (key)
+ (and (tramp-file-name-p key)
+ (string-equal method (tramp-file-name-method key))
+ (not (tramp-file-name-localname key))
+ (list (tramp-file-name-user key)
+ (tramp-file-name-host key))))
+ (hash-table-keys tramp-cache-data))))
;; When "emacs -Q" has been called, both variables are nil. We do not
;; load the persistency file then, in order to have a clean test environment.
diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el
index e104babed2..328625b776 100644
--- a/lisp/net/tramp-container.el
+++ b/lisp/net/tramp-container.el
@@ -101,7 +101,8 @@
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
- (when-let ((raw-list (shell-command-to-string
+ (when-let ((default-directory tramp-compat-temporary-file-directory)
+ (raw-list (shell-command-to-string
(concat tramp-docker-program
" ps --format '{{.ID}}\t{{.Names}}'")))
(lines (split-string raw-list "\n" 'omit))
@@ -121,7 +122,8 @@ see its function help for a description of the format."
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
- (when-let ((raw-list (shell-command-to-string
+ (when-let ((default-directory tramp-compat-temporary-file-directory)
+ (raw-list (shell-command-to-string
(concat tramp-kubernetes-program
" get pods --no-headers "
"-o custom-columns=NAME:.metadata.name")))
@@ -130,6 +132,24 @@ see its function help for a description of the format."
(list nil name))
names)))
+(defun tramp-kubernetes--current-context-data (vec)
+ "Return Kubernetes current context data as JSON string."
+ (with-temp-buffer
+ (when (zerop
+ (tramp-call-process
+ vec tramp-kubernetes-program nil t nil
+ "config" "current-context"))
+ (goto-char (point-min))
+ (let ((current-context (buffer-substring (point) (line-end-position))))
+ (erase-buffer)
+ (when (zerop
+ (tramp-call-process
+ vec tramp-kubernetes-program nil t nil
+ "config" "view" "-o"
+ (format
+ "jsonpath='{.contexts[?(@.name == \"%s\")]}'"
current-context)))
+ (buffer-string))))))
+
;;;###tramp-autoload
(defvar tramp-default-remote-shell) ;; Silence byte compiler.
@@ -165,6 +185,7 @@ see its function help for a description of the format."
("-it")
("--")
("%l")))
+ (tramp-config-check tramp-kubernetes--current-context-data)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-i" "-c"))))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index d74afc8412..cfecd32aba 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -4472,7 +4472,8 @@ process to set up. VEC specifies the connection."
;; Check whether the output of "uname -sr" has been changed. If
;; yes, this is a strong indication that we must expire all
;; connection properties. We start again with
- ;; `tramp-maybe-open-connection', it will be caught there.
+ ;; `tramp-maybe-open-connection', it will be caught there. The same
+ ;; check will be applied with the function kept in `tramp-config-check'.
(tramp-message vec 5 "Checking system information")
(let* ((old-uname (tramp-get-connection-property vec "uname"))
(uname
@@ -4481,8 +4482,23 @@ process to set up. VEC specifies the connection."
old-uname
(tramp-set-connection-property
vec "uname"
- (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))))
- (when (and (stringp old-uname) (not (string-equal old-uname uname)))
+ (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
+ (config-check-function
+ (tramp-get-method-parameter vec 'tramp-config-check))
+ (old-config-check
+ (and config-check-function
+ (tramp-get-connection-property vec "config-check-data")))
+ (config-check
+ (and config-check-function
+ ;; If we are in `make-process', we don't need to recompute.
+ (if (and old-config-check
+ (tramp-get-connection-property vec "process-name"))
+ old-config-check
+ (tramp-set-connection-property
+ vec "config-check-data"
+ (tramp-compat-funcall config-check-function vec))))))
+ (when (and (stringp old-uname) (stringp uname)
+ (not (string-equal old-uname uname)))
(tramp-message
vec 3
"Connection reset, because remote host changed from `%s' to `%s'"
@@ -4490,6 +4506,15 @@ process to set up. VEC specifies the connection."
;; We want to keep the password.
(tramp-cleanup-connection vec t t)
(throw 'uname-changed (tramp-maybe-open-connection vec)))
+ (when (and (stringp old-config-check) (stringp config-check)
+ (not (string-equal old-config-check config-check)))
+ (tramp-message
+ vec 3
+ "Connection reset, because remote configuration changed from `%s' to
`%s'"
+ old-config-check config-check)
+ ;; We want to keep the password.
+ (tramp-cleanup-connection vec t t)
+ (throw 'uname-changed (tramp-maybe-open-connection vec)))
;; Try to set up the coding system correctly.
;; CCC this can't be the right way to do it. Hm.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index c06adb01e8..63f313dc50 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -281,6 +281,13 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
Until now, just \"ssh\"-based, \"sshfs\"-based and
\"adb\"-based methods do.
+ * `tramp-config-check'
+ A function to be called with one argument, VEC. It should
+ return a string which is used to check, whether the
+ configuration of the remote host has been changed (which
+ would require to flush the cache data). This string is kept
+ as connection property \"config-check-data\".
+
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
the file; this might be the absolute filename of scp or the name of
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/org/org-agenda.el b/lisp/org/org-agenda.el
index 35f19cf03b..e43950f13a 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -5306,7 +5306,7 @@ of what a project is and how to check if it stuck,
customize the variable
"Hook run when the fancy diary buffer is cleaned up.")
(defun org-agenda-cleanup-fancy-diary ()
- "Remove unwanted stuff in buffer created by `fancy-diary-display'.
+ "Remove unwanted stuff in buffer created by `diary-fancy-display'.
This gets rid of the date, the underline under the date, and the
dummy entry installed by Org mode to ensure non-empty diary for
each date. It also removes lines that contain only whitespace."
diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el
index 76a1a71fab..1452f36c11 100644
--- a/lisp/org/ox-ascii.el
+++ b/lisp/org/ox-ascii.el
@@ -456,7 +456,7 @@ Optional argument JUSTIFY can specify any type of
justification
among `left', `center', `right' or `full'. A nil value is
equivalent to `left'. For a justification that doesn't also fill
string, see `org-ascii--justify-lines' and
-`org-ascii--justify-block'.
+`org-ascii--justify-element'.
Return nil if S isn't a string."
(when (stringp s)
diff --git a/lisp/outline.el b/lisp/outline.el
index 2209964577..ef5249a146 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -281,40 +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-minor-mode-insert-buttons nil
- "Non-nil when it's allowed to modify buffer to insert buttons.")
+(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 "🔽")
@@ -487,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)
@@ -511,25 +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
- (when (eq (current-buffer) (window-buffer))
- (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
- #'outline--fix-buttons-after-change 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
@@ -554,18 +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
- (when (eq (current-buffer) (window-buffer))
- (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.
@@ -1657,120 +1641,98 @@ With a prefix argument, show headings up to that
LEVEL."
;;; Button/margin indicators
-(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))))
- ;; 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.
- (if outline-minor-mode-insert-buttons
- (let ((inhibit-read-only t))
- (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))))
- (overlay-put
- o 'before-string
- (propertize " "
- 'display
- (or (plist-get icon 'image)
- (plist-get icon 'string))))))
- 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))))
- (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 outline-minor-mode-insert-buttons
- (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)
+(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)
- (if use-margins
- (outline--make-margin-overlay 'close)
- (when outline-minor-mode-insert-buttons
- (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)))))))
+ (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 (or outline--use-buttons outline--use-margins)
+ (when outline-minor-mode-use-buttons
(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)))
+ (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)))
- (when outline--use-buttons
- (remove-overlays beg end 'outline-button t))
- (when outline--use-margins
- (remove-overlays beg end 'outline-margin t))
+ (remove-overlays beg end 'outline-button t)
(outline--fix-up-all-buttons beg end))
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index e3a9507f1c..a470f23dfe 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -312,7 +312,7 @@ run a specific program. The program must be a member of
(insert " ")))
(forward-char 1)))
(setq i (1+ i))
- (sit-for 0 2)))
+ (sit-for 0.002)))
(zone-pgm-jitter))
(defun zone-pgm-explode ()
@@ -347,7 +347,7 @@ run a specific program. The program must be a member of
(upcase i)))
(setq i (+ i (1+ (random 5)))))
(translate-region (point-min) (point-max) tbl)
- (sit-for 0 2))))
+ (sit-for 0.002))))
(defun zone-pgm-putz-with-case ()
(goto-char (point-min))
@@ -359,7 +359,7 @@ run a specific program. The program must be a member of
'downcase-region) (1- np) np)
(setq np (+ np (1+ (random 5))))))
(goto-char (point-min))
- (sit-for 0 2)))
+ (sit-for 0.002)))
;;;; rotating
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index e71560fa25..d730fddeb0 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -6693,8 +6693,7 @@ comment at the start of cc-engine.el for more info."
;; syntactic ws.
(when (and cfd-match-pos (< cfd-match-pos syntactic-pos))
(goto-char syntactic-pos)
- (c-forward-syntactic-ws
- (min (+ (point) 2000) (point-max)))
+ (c-forward-syntactic-ws cfd-limit)
(and cfd-continue-pos
(< cfd-continue-pos (point))
(setq cfd-token-pos (point))))
@@ -6735,8 +6734,7 @@ comment at the start of cc-engine.el for more info."
;; can't be nested, and that's already been done in
;; `c-find-decl-prefix-search'.
(when (> cfd-continue-pos cfd-token-pos)
- (c-forward-syntactic-ws
- (min (+ (point) 2000) (point-max)))
+ (c-forward-syntactic-ws cfd-limit)
(setq cfd-token-pos (point)))
;; Continue if the following token fails the
@@ -8196,7 +8194,8 @@ multi-line strings (but not C++, for example)."
;; treat possible types (i.e. those that it normally returns 'maybe or
;; 'found for) as actual types (and always return 'found for them).
;; This means that it records them in `c-record-type-identifiers' if
-;; that is set, and that it adds them to `c-found-types'.
+;; that is set, and that if its value is t (not 'just-one), it adds
+;; them to `c-found-types'.
(defvar c-promote-possible-types nil)
;; Dynamically bound variable that instructs `c-forward-<>-arglist' to
@@ -9193,10 +9192,11 @@ 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 (save-excursion
- (goto-char id-end)
- (c-backward-syntactic-ws)
- (point)))
+ (when (not (eq c-promote-possible-types 'just-one))
+ (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
@@ -10031,7 +10031,8 @@ This function might do hidden buffer changes."
;; This identifier is bound only in the inner let.
'(setq start id-start))))
-(defun c-forward-decl-or-cast-1 (preceding-token-end context last-cast-end)
+(defun c-forward-decl-or-cast-1 (preceding-token-end context last-cast-end
+ &optional inside-macro)
;; Move forward over a declaration or a cast if at the start of one.
;; The point is assumed to be at the start of some token. Nil is
;; returned if no declaration or cast is recognized, and the point
@@ -10120,6 +10121,10 @@ This function might do hidden buffer changes."
;; matched. In that case it's used to discover chains of casts like
;; "(a) (b) c".
;;
+ ;; INSIDE-MACRO is t when we definitely know we're inside a macro, nil
+ ;; otherwise. We use it to disambiguate things like "(a) (b);", which is
+ ;; likely a function call in a macro, but a cast outside of one.
+ ;;
;; This function records identifier ranges on
;; `c-record-type-identifiers' and `c-record-ref-identifiers' if
;; `c-record-type-identifiers' is non-nil.
@@ -11104,11 +11109,17 @@ This function might do hidden buffer changes."
;; Check if the expression begins with a prefix keyword.
(match-beginning 2)
(if (match-beginning 1)
- ;; Expression begins with an ambiguous operator. Treat
- ;; it as a cast if it's a type decl or if we've
- ;; recognized the type somewhere else.
- (or at-decl-or-cast
- (memq at-type '(t known found)))
+ ;; Expression begins with an ambiguous operator.
+ (cond
+ ((match-beginning c-per-&*+--match)
+ (memq at-type '(t known found)))
+ ((match-beginning c-per-++---match)
+ t)
+ ((match-beginning c-per-\(-match)
+ (or
+ (memq at-type '(t known found))
+ (not inside-macro)))
+ (t nil))
;; Unless it's a keyword, it's the beginning of a primary
;; expression.
(not (looking-at c-keywords-regexp)))))
@@ -11134,18 +11145,33 @@ This function might do hidden buffer changes."
;; surrounding parens).
(looking-at c-simple-stmt-key)
(and
- ;; Check that it isn't a close paren (block close is ok,
- ;; though).
- (not (memq (char-before) '(?\) ?\])))
+ ;; Check that it isn't a close paren (block close , or a
+ ;; macro arglist is ok, though).
+ (or
+ (not (memq (char-before) '(?\) ?\])))
+ ;; Have we moved back to a macro arglist?
+ (and c-opt-cpp-prefix
+ (eq (char-before) ?\))
+ (save-excursion
+ (and
+ (c-go-list-backward)
+ (let (pos)
+ (c-backward-syntactic-ws)
+ (and (setq pos (c-on-identifier))
+ (goto-char pos)))
+ (zerop (c-backward-token-2 2))
+ (looking-at c-opt-cpp-macro-define-start)))))
+
;; Check that it isn't a nonsymbol identifier.
(not (c-on-identifier)))))))))
;; Handle the cast.
(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))
+ (not (eq at-type t)))
+ (let ((c-promote-possible-types (if (eq at-type 'maybe)
+ 'just-one
+ t)))
(goto-char type-start)
(c-forward-type)))
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index aa16da7070..9444828a0e 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1,4 +1,4 @@
-;;; cc-fonts.el --- font lock support for CC Mode -*- lexical-binding: t -*-
+;; cc-fonts.el --- font lock support for CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 2002-2022 Free Software Foundation, Inc.
@@ -115,6 +115,7 @@
;; used for preprocessor directives.
'font-lock-builtin-face)
((and (c-face-name-p 'font-lock-reference-face)
+ (boundp 'font-lock-reference-face)
(eq font-lock-reference-face 'font-lock-reference-face))
'font-lock-reference-face)
(t 'font-lock-constant-face)))
@@ -128,6 +129,7 @@
;; suite.)
'font-lock-label-face)
((and (c-face-name-p 'font-lock-constant-face)
+ (boundp 'font-lock-constant-face)
(eq font-lock-constant-face 'font-lock-constant-face))
;; Test both if font-lock-constant-face exists and that it's
;; not an alias for something else. This is important since
@@ -138,20 +140,24 @@
(defconst c-constant-face-name
(if (and (c-face-name-p 'font-lock-constant-face)
+ (boundp 'font-lock-constant-face)
(eq font-lock-constant-face 'font-lock-constant-face))
;; This doesn't exist in some earlier versions of XEmacs 21.
'font-lock-constant-face
c-label-face-name))
(defconst c-reference-face-name
- (with-no-warnings
- (if (and (c-face-name-p 'font-lock-reference-face)
- (eq font-lock-reference-face 'font-lock-reference-face))
- ;; This is considered obsolete in Emacs, but it still maps well
- ;; to this use. (Another reason to do this is to get unique
- ;; faces for the test suite.)
- 'font-lock-reference-face
- c-label-face-name)))
+ (cond
+ ((and (c-face-name-p 'font-lock-reference-face)
+ (boundp 'font-lock-reference-face)
+ (eq font-lock-reference-face 'font-lock-reference-face))
+ ;; This is considered obsolete in Emacs, but it still maps well
+ ;; to this use. (Another reason to do this is to get unique
+ ;; faces for the test suite.)
+ 'font-lock-reference-face)
+ ((c-face-name-p 'font-lock-constant-face)
+ 'font-lock-constant-face)
+ (t c-label-face-name)))
;; This should not mapped to a face that also is used to fontify things
;; that aren't comments or string literals.
@@ -586,7 +592,8 @@ stuff. Used on level 1 and higher."
(c-lang-const c-opt-cpp-macro-define)
(c-lang-const c-nonempty-syntactic-ws)
"\\(" (c-lang-const ; 1 + ncle + nsws
- c-symbol-key) "\\)"
+ c-symbol-key)
+ "\\)"
(concat "\\(" ; 2 + ncle + nsws + c-sym-key
;; Macro with arguments - a "function".
"\\((\\)" ; 3 + ncle + nsws + c-sym-key
@@ -1211,134 +1218,145 @@ casts and declarations are fontified. Used on level
2 and higher."
(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) ?\()
- (save-excursion
- (goto-char match-pos)
- (backward-char)
- (c-backward-token-2)
- (cond
- ((looking-at c-paren-stmt-key)
- ;; Allow comma separated <> arglists in for statements.
- (cons nil nil))
- ((or (looking-at c-block-stmt-2-key)
- (looking-at c-block-stmt-1-2-key)
- (looking-at c-typeof-key))
- (cons nil t))
- (t nil)))))
- ;; Near BOB.
- ((<= match-pos (point-min))
- (cons 'arglist t))
- ;; Got a cached hit in a declaration arglist.
- ((eq type 'c-decl-arg-start)
- (cons 'decl nil))
- ;; We're inside (probably) a brace list.
- ((eq type 'c-not-decl)
- (cons 'not-decl nil))
- ;; Inside a C++11 lambda function arglist.
- ((and (c-major-mode-is 'c++-mode)
- (eq (char-before match-pos) ?\()
- (save-excursion
- (goto-char match-pos)
- (c-backward-token-2)
- (and
- (c-safe (goto-char (scan-sexps (point) -1)))
- (c-looking-at-c++-lambda-capture-list))))
- (c-put-char-property (1- match-pos) 'c-type
- 'c-decl-arg-start)
- (cons 'decl nil))
- ;; We're inside a brace list.
- ((and (eq (char-before match-pos) ?{)
- (c-inside-bracelist-p (1- match-pos)
- (cdr (c-parse-state))
- nil))
- (c-put-char-property (1- match-pos) 'c-type
- 'c-not-decl)
- (cons 'not-decl nil))
- ;; We're inside an "ordinary" open brace.
- ((eq (char-before match-pos) ?{)
- (cons (and toplev 'top) nil))
- ;; Inside an angle bracket arglist.
- ((or (eq type 'c-<>-arg-sep)
- (eq (char-before match-pos) ?<))
- (cons '<> nil))
- ;; Got a cached hit in some other type of arglist.
- (type
- (cons 'arglist t))
- ;; We're at a C++ uniform initialization.
- ((and (c-major-mode-is 'c++-mode)
- (eq (char-before match-pos) ?\()
- (save-excursion
- (goto-char match-pos)
- (and
- (zerop (c-backward-token-2 2))
- (looking-at c-identifier-start)
- (c-got-face-at (point)
- '(font-lock-variable-name-face)))))
- (cons 'not-decl nil))
- ((and not-front-decl
+ ((not (memq (char-before match-pos) '(?\( ?, ?\[ ?< ?{)))
+ (cons (and toplev 'top) nil))
+ ;; A control flow expression or a decltype
+ ((and (eq (char-before match-pos) ?\()
+ (save-excursion
+ (goto-char match-pos)
+ (backward-char)
+ (c-backward-token-2)
+ (cond
+ ((looking-at c-paren-stmt-key)
+ ;; Allow comma separated <> arglists in for statements.
+ (cons nil nil))
+ ((or (looking-at c-block-stmt-2-key)
+ (looking-at c-block-stmt-1-2-key)
+ (looking-at c-typeof-key))
+ (cons nil t))
+ (t nil)))))
+ ;; Near BOB.
+ ((<= match-pos (point-min))
+ (cons 'arglist t))
+ ;; Got a cached hit in a declaration arglist.
+ ((eq type 'c-decl-arg-start)
+ (cons 'decl nil))
+ ;; We're inside (probably) a brace list.
+ ((eq type 'c-not-decl)
+ (cons 'not-decl nil))
+ ;; Inside a C++11 lambda function arglist.
+ ((and (c-major-mode-is 'c++-mode)
+ (eq (char-before match-pos) ?\()
+ (save-excursion
+ (goto-char match-pos)
+ (c-backward-token-2)
+ (and
+ (c-safe (goto-char (scan-sexps (point) -1)))
+ (c-looking-at-c++-lambda-capture-list))))
+ (c-put-char-property (1- match-pos) 'c-type
+ 'c-decl-arg-start)
+ (cons 'decl nil))
+ ;; We're inside a brace list.
+ ((and (eq (char-before match-pos) ?{)
+ (c-inside-bracelist-p (1- match-pos)
+ (cdr (c-parse-state))
+ nil))
+ (c-put-char-property (1- match-pos) 'c-type
+ 'c-not-decl)
+ (cons 'not-decl nil))
+ ;; We're inside an "ordinary" open brace.
+ ((eq (char-before match-pos) ?{)
+ (cons (and toplev 'top) nil))
+ ;; Inside an angle bracket arglist.
+ ((or (eq type 'c-<>-arg-sep)
+ (eq (char-before match-pos) ?<))
+ (cons '<> nil))
+ ;; Got a cached hit in some other type of arglist.
+ (type
+ (cons 'arglist t))
+ ;; We're at a C++ uniform initialization.
+ ((and (c-major-mode-is 'c++-mode)
+ (eq (char-before match-pos) ?\()
+ (save-excursion
+ (goto-char match-pos)
+ (and
+ (zerop (c-backward-token-2 2))
+ (looking-at c-identifier-start)
+ (c-got-face-at (point)
+ '(font-lock-variable-name-face)))))
+ (cons 'not-decl nil))
+ ((and not-front-decl
;; The point is within the range of a previously
;; encountered type decl expression, so the arglist
;; is probably one that contains declarations.
;; However, if `c-recognize-paren-inits' is set it
;; might also be an initializer arglist.
- (or (not c-recognize-paren-inits)
- (save-excursion
- (goto-char match-pos)
- (not (c-back-over-member-initializers)))))
- ;; The result of this check is cached with a char
- ;; property on the match token, so that we can look
- ;; it up again when refontifying single lines in a
- ;; multiline declaration.
- (c-put-char-property (1- match-pos)
- 'c-type 'c-decl-arg-start)
- (cons 'decl nil))
- ;; Got (an) open paren(s) preceded by an arith operator.
- ((and (eq (char-before match-pos) ?\()
- (save-excursion
- (goto-char match-pos)
- (while
- (and (zerop (c-backward-token-2))
- (eq (char-after) ?\()))
- (looking-at c-arithmetic-op-regexp)))
- (cons nil nil))
- ;; In a C++ member initialization list.
- ((and (eq (char-before match-pos) ?,)
- (c-major-mode-is 'c++-mode)
- (save-excursion
- (goto-char match-pos)
- (c-back-over-member-initializers)))
- (c-put-char-property (1- match-pos) 'c-type 'c-not-decl)
- (cons 'not-decl nil))
- ;; At start of a declaration inside a declaration paren.
- ((save-excursion
+ (or (not c-recognize-paren-inits)
+ (save-excursion
+ (goto-char match-pos)
+ (not (c-back-over-member-initializers)))))
+ ;; The result of this check is cached with a char
+ ;; property on the match token, so that we can look
+ ;; it up again when refontifying single lines in a
+ ;; multiline declaration.
+ (c-put-char-property (1- match-pos)
+ 'c-type 'c-decl-arg-start)
+ (cons 'decl nil))
+ ;; Got (an) open paren(s) preceded by an arith operator.
+ ((and (eq (char-before match-pos) ?\()
+ (save-excursion
(goto-char match-pos)
- (and (memq (char-before match-pos) '(?\( ?\,))
- (c-go-up-list-backward match-pos
- ; c-determine-limit is too slow, here.
- (max (- (point) 2000) (point-min)))
- (eq (char-after) ?\()
- (let ((type (c-get-char-property (point) 'c-type)))
- (or (memq type '(c-decl-arg-start c-decl-type-start))
- (and
- (progn (c-backward-syntactic-ws) t)
- (or
- (and
- (c-back-over-compound-identifier)
- (progn
- (c-backward-syntactic-ws)
- (or (bobp)
- (progn
- (setq type (c-get-char-property (1- (point))
- 'c-type))
- (memq type '(c-decl-arg-start
- c-decl-type-start))))))
- (and (zerop (c-backward-token-2))
- (looking-at c-fun-name-substitute-key))))))))
- (cons 'decl nil))
- (t (cons 'arglist t)))))
+ (while
+ (and (zerop (c-backward-token-2))
+ (eq (char-after) ?\()))
+ (looking-at c-arithmetic-op-regexp)))
+ (cons nil nil))
+ ;; In a C++ member initialization list.
+ ((and (eq (char-before match-pos) ?,)
+ (c-major-mode-is 'c++-mode)
+ (save-excursion
+ (goto-char match-pos)
+ (c-back-over-member-initializers)))
+ (c-put-char-property (1- match-pos) 'c-type 'c-not-decl)
+ (cons 'not-decl nil))
+ ;; At start of a declaration inside a declaration paren.
+ ((save-excursion
+ (goto-char match-pos)
+ (and (memq (char-before match-pos) '(?\( ?\,))
+ (c-go-up-list-backward match-pos
+ ; c-determine-limit is too slow, here.
+ (max (- (point) 2000) (point-min)))
+ (eq (char-after) ?\()
+ (let ((type (c-get-char-property (point) 'c-type)))
+ (or (memq type '(c-decl-arg-start c-decl-type-start))
+ (progn
+ (c-backward-syntactic-ws)
+ (cond
+ ((and toplev
+ (eq (char-before) ?\)))
+ (save-excursion
+ (and (c-go-list-backward nil (max (- (point) 2000)
+ (point-min)))
+ (eq (char-after) ?\()
+ (progn (c-backward-syntactic-ws)
+ (c-back-over-compound-identifier)))))
+ ((save-excursion
+ (and
+ (c-back-over-compound-identifier)
+ (progn
+ (c-backward-syntactic-ws)
+ (or (bobp)
+ (progn
+ (setq type (c-get-char-property (1- (point))
+ 'c-type))
+ (memq type '(c-decl-arg-start
+ c-decl-type-start))))))))
+ ((and (zerop (c-backward-token-2))
+ (looking-at c-fun-name-substitute-key)))))))))
+ ;; Cache the result of this test for next time around.
+ (c-put-char-property (1- match-pos) 'c-type 'c-decl-arg-start)
+ (cons 'decl nil))
+ (t (cons 'arglist t)))))
(defun c-font-lock-single-decl (limit decl-or-cast match-pos context toplev)
;; Try to fontify a single declaration, together with all its declarators.
@@ -1578,7 +1596,7 @@ casts and declarations are fontified. Used on level 2
and higher."
nil)
(setq decl-or-cast
(c-forward-decl-or-cast-1
- match-pos context last-cast-end))
+ match-pos context last-cast-end inside-macro))
;; Ensure that c-<>-arg-sep c-type properties are in place
on the
;; commas separating the arguments inside template/generic
<..>s.
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 6ccd6c30df..291af038b7 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -2319,7 +2319,7 @@ Note that an alternative if the second part doesn't hold
is
`c-type-list-kwds'. Keywords on this list are typically also present
on one of the `*-decl-kwds' lists."
t nil
- c '("struct" "union" "enum")
+ (c objc) '("struct" "union" "enum")
c++ (append '("class" "typename")
(c-lang-const c-type-prefix-kwds c)))
@@ -3489,76 +3489,179 @@ Note that Java specific rules are currently applied to
tell this from
(c-lang-defvar c-regular-keywords-regexp
(c-lang-const c-regular-keywords-regexp))
-(c-lang-defconst c-primary-expr-regexp
- ;; Regexp matching the start of any primary expression, i.e. any
- ;; literal, symbol, prefix operator, and '('. It doesn't need to
- ;; exclude keywords; they are excluded afterwards unless the second
- ;; submatch matches. If the first but not the second submatch
- ;; matches then it is an ambiguous primary expression; it could also
- ;; be a match of e.g. an infix operator. (The case with ambiguous
- ;; keyword operators isn't handled.)
-
+(c-lang-defconst c-primary-expr-regexp-details
+ ;; A list of c-primary-expr-regexp and three numbers identifying particular
+ ;; matches in it.
t (let* ((prefix-ops
+ ;All prefix ops
(c-filter-ops (c-lang-const c-operators)
'(prefix)
(lambda (op)
;; Filter out the special case prefix
;; operators that are close parens.
(not (string-match "\\s)" op)))))
-
- (nonkeyword-prefix-ops
- (c-filter-ops prefix-ops
- t
- "\\`\\(\\s.\\|\\s(\\|\\s)\\)+\\'"))
+ (postfix-ops
+ ;; All postfix ops.
+ (c-filter-ops (c-lang-const c-operators)
+ '(postfix)
+ (lambda (op) (not (string-match "\\s)" op)))))
(in-or-postfix-ops
+ ;; All ops which are postfix, etc.
(c-filter-ops (c-lang-const c-operators)
'(postfix
postfix-if-paren
left-assoc
right-assoc
right-assoc-sequence)
- t)))
+ t))
- (concat
- "\\("
- ;; Take out all symbol class operators from `prefix-ops' and make the
- ;; first submatch from them together with `c-primary-expr-kwds'.
- (c-make-keywords-re t
- (append (c-lang-const c-primary-expr-kwds)
- (c--set-difference prefix-ops nonkeyword-prefix-ops
- :test 'string-equal)))
-
- "\\|"
- ;; Match all ambiguous operators.
- (c-make-keywords-re nil
- (c--intersection nonkeyword-prefix-ops in-or-postfix-ops
- :test 'string-equal))
- "\\)"
-
- "\\|"
- ;; Now match all other symbols.
- (c-lang-const c-symbol-start)
-
- "\\|"
- ;; The chars that can start integer and floating point
- ;; constants.
- "\\.?[0-9]"
-
- "\\|"
- ;; The unambiguous operators from `prefix-ops'.
- (c-make-keywords-re nil
- (c--set-difference nonkeyword-prefix-ops in-or-postfix-ops
- :test 'string-equal))
-
- "\\|"
- ;; Match string and character literals.
- "\\s\""
- (if (memq 'gen-string-delim c-emacs-features)
- "\\|\\s|"
- ""))))
+ (nonkeyword-prefix-ops
+ ;; All prefix ops apart from those which are keywords.
+ (c-filter-ops prefix-ops
+ t
+ "\\`\\(\\s.\\|\\s(\\|\\s)\\)+\\'"))
+ (nonkeyword-postfix-ops
+ ;; All postfix ops apart from those which are keywords.
+ (c-filter-ops postfix-ops
+ t
+ "\\`\\(\\s.\\|\\s(\\|\\s)\\)+\\'"))
+
+ (cast-ops
+ ;; All prefix ops which have syntax open-paren.
+ (c-filter-ops prefix-ops
+ t
+ "\\`\\s(\\'"))
+
+ (ambiguous-pre/postfix-ops
+ ;; All non-keyword ops which are both prefix and postfix, apart
+ ;; from (.
+ (c--set-difference (c--intersection nonkeyword-prefix-ops
+ nonkeyword-postfix-ops
+ :test 'string-equal)
+ cast-ops :test 'string-equal))
+ (unambiguous-prefix-ops
+ ;; All non-keyword ops which are prefix ops and not any other type
+ ;; of op.
+ (c--set-difference nonkeyword-prefix-ops
+ in-or-postfix-ops
+ :test 'string-equal))
+ (ambiguous-prefix-ops
+ ;; All non-keyword ops which are prefix ops and also some other
+ ;; type of op.
+ (c--intersection nonkeyword-prefix-ops
+ in-or-postfix-ops
+ :test 'string-equal)) ; This has everything we
+ ; need, plus (, ++, --.
+
+ (ambiguous-prefix-non-postfix-ops
+ ;; All non-keyword prefix ops which are also other types of ops
+ ;; apart from postfix ops.
+ (c--set-difference (c--set-difference ambiguous-prefix-ops
+ ambiguous-pre/postfix-ops
+ :test 'string-equal)
+ cast-ops :test 'string-equal))
+
+ (primary-expression-keywords-string
+ ;; Take out all symbol class operators from `prefix-ops' and make
+ ;; the first submatch from them together with
+ ;; `c-primary-expr-kwds'.
+ (c-make-keywords-re t
+ (append (c-lang-const c-primary-expr-kwds)
+ (c--set-difference prefix-ops nonkeyword-prefix-ops
+ :test 'string-equal))))
+ (primary-expression-keywords-string-depth
+ (regexp-opt-depth primary-expression-keywords-string))
+
+ (ambiguous-pre/postfix-string
+ (c-make-keywords-re nil ambiguous-pre/postfix-ops))
+ (ambiguous-pre/postfix-string-depth
+ (regexp-opt-depth ambiguous-pre/postfix-string))
+
+ (ambiguous-prefix-non-postfix-string
+ (c-make-keywords-re nil ambiguous-prefix-non-postfix-ops))
+ (ambiguous-prefix-non-postfix-string-depth
+ (regexp-opt-depth ambiguous-prefix-non-postfix-string))
+
+ (per-++---match (+ 2 primary-expression-keywords-string-depth))
+ (per-&*+--match (+ 1 per-++---match
+ ambiguous-pre/postfix-string-depth))
+ (per-\(-match (+ 1 per-&*+--match
+ ambiguous-prefix-non-postfix-string-depth)))
+
+ (list
+ (concat
+ "\\(" ; 1
+ primary-expression-keywords-string
+ "\\|"
+ ;; Match all ambiguous operators.
+ "\\(" ; 2 + primary-expression-keywords-string-depth
+ ambiguous-pre/postfix-string
+ "\\)\\|\\(" ; 3 + primary-expression-keywords-string-depth
+ ; + ambiguous-pre/postfix-string-depth
+ ambiguous-prefix-non-postfix-string
+ "\\)\\|"
+ "\\((\\)" ; 4 + primary-expression-keywords-string-depth
+ ; + ambiguous-pre/postfix-string-depth
+ ; + ambiguous-prefix-non-postfix-string-depth
+ "\\)"
+
+ "\\|"
+ ;; Now match all other symbols.
+ (c-lang-const c-symbol-start)
+
+ "\\|"
+ ;; The chars that can start integer and floating point
+ ;; constants.
+ "\\.?[0-9]"
+
+ "\\|"
+ ;; The unambiguous operators from `prefix-ops'.
+ (c-make-keywords-re nil
+ ;; (c--set-difference nonkeyword-prefix-ops in-or-postfix-ops
+ ;; :test 'string-equal)
+ unambiguous-prefix-ops
+ )
+
+ "\\|"
+ ;; Match string and character literals.
+ "\\s\""
+ (if (memq 'gen-string-delim c-emacs-features)
+ "\\|\\s|"
+ ""))
+ per-++---match
+ per-&*+--match
+ per-\(-match)))
+
+(c-lang-defconst c-primary-expr-regexp
+ ;; Regexp matching the start of any primary expression, i.e. any
+ ;; literal, symbol, prefix operator, and '('. It doesn't need to
+ ;; exclude keywords; they are excluded afterwards unless the second
+ ;; submatch matches. If the first but not the second submatch
+ ;; matches then it is an ambiguous primary expression; it could also
+ ;; be a match of e.g. an infix operator. (The case with ambiguous
+ ;; keyword operators isn't handled.)
+ t (car (c-lang-const c-primary-expr-regexp-details)))
(c-lang-defvar c-primary-expr-regexp (c-lang-const c-primary-expr-regexp))
+(c-lang-defconst c-per-++---match
+ ;; Match number for group in `c-primary-expr-regexp' which matches (in C)
+ ;; the ++ and -- operators, and any similar ones in other languages.
+ t (cadr (c-lang-const c-primary-expr-regexp-details)))
+(c-lang-defvar c-per-++---match (c-lang-const c-per-++---match))
+
+(c-lang-defconst c-per-&*+--match
+ ;; Match number for group in `c-primary-expr-regexp' which matches (in C)
+ ;; the &, *, +, and - operators, and any similar ones in other languages.
+ t (car (cddr (c-lang-const c-primary-expr-regexp-details))))
+(c-lang-defvar c-per-&*+--match (c-lang-const c-per-&*+--match))
+
+(c-lang-defconst c-per-\(-match
+ ;; Match number for group in `c-primary-expr-regexp' which matches (in C)
+ ;; the ( operator, and any similar ones in other languages.
+ t (cadr (cddr (c-lang-const c-primary-expr-regexp-details))))
+(c-lang-defvar c-per-\(-match (c-lang-const c-per-\(-match))
+
;;; Additional constants for parser-level constructs.
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 6473b50778..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")
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index ada8b01fec..c587061837 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -81,7 +81,8 @@
;; 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.
+;; and `eglot-managed-mode-hook' to adjust things to their
+;; preferences.
;;
;; * On occasion, to enable new features, Eglot can have soft
;; dependencies on popular libraries that are not in Emacs core.
@@ -186,7 +187,8 @@ chosen (interactively or automatically)."
(python-mode
. ,(eglot-alternatives
'("pylsp" "pyls" ("pyright-langserver"
"--stdio") "jedi-language-server")))
- ((js-mode typescript-mode)
+ ((js-json-mode json-mode) .
,(eglot-alternatives '(("vscode-json-language-server" "--stdio")
("json-languageserver" "--stdio"))))
+ ((js-mode ts-mode typescript-mode)
. ("typescript-language-server" "--stdio"))
(sh-mode . ("bash-language-server" "start"))
((php-mode phps-mode)
@@ -218,17 +220,17 @@ language-server/bin/php-language-server.php"))
. ("digestif"))
(erlang-mode . ("erlang_ls" "--transport"
"stdio"))
(yaml-mode . ("yaml-language-server"
"--stdio"))
- (nix-mode . ("rnix-lsp"))
+ (nix-mode . ,(eglot-alternatives '("nil"
"rnix-lsp")))
(gdscript-mode . ("localhost" 6008))
((fortran-mode f90-mode) . ("fortls"))
(futhark-mode . ("futhark" "lsp"))
- (lua-mode . ("lua-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-mode clojurescript-mode
clojurec-mode)
. ("clojure-lsp"))
(csharp-mode . ("omnisharp" "-lsp"))
(purescript-mode .
("purescript-language-server" "--stdio"))
@@ -321,13 +323,15 @@ 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")
+ :type '(choice (const :tag "Reconnect automatically" t)
+ (const :tag "Never reconnect" nil)
(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)
+ :type '(choice (number :tag "Number of seconds")
+ (const :tag "Never time out" nil)))
(defcustom eglot-sync-connect 3
"Control blocking of LSP connection attempts.
@@ -335,8 +339,9 @@ 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")))
+ :type '(choice (const :tag "Block for `eglot-connect-timeout' seconds" t)
+ (const :tag "Never block" nil)
+ (integer :tag "Number of seconds to block")))
(defcustom eglot-autoshutdown nil
"If non-nil, shut down server after killing last managed buffer."
@@ -361,7 +366,7 @@ done by `eglot-reconnect'."
(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)))
+ (const :tag "Show confirmation prompt" confirm)))
(defcustom eglot-extend-to-xref nil
"If non-nil, activate Eglot in cross-referenced non-project files."
@@ -613,7 +618,7 @@ Honour `eglot-strict-mode'."
(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'."
+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))
@@ -1077,6 +1082,7 @@ MANAGED-MAJOR-MODE, which matters to a minority of
servers.
INTERACTIVE is t if called interactively."
(interactive (append (eglot--guess-contact t) '(t)))
+ (setq managed-major-mode (eglot--ensure-list managed-major-mode))
(let* ((current-server (eglot-current-server))
(live-p (and current-server (jsonrpc-running-p current-server))))
(if (and live-p
@@ -1626,6 +1632,8 @@ and just return it. PROMPT shouldn't end with a question
mark."
(cl-loop for (k _v) on plist by #'cddr collect k))
(defun eglot--ensure-list (x) (if (listp x) x (list x)))
+(when (fboundp 'ensure-list) ; Emacs 28 or later
+ (define-obsolete-function-alias 'eglot--ensure-list #'ensure-list "29.1"))
;;; Minor modes
@@ -2456,7 +2464,7 @@ may be called multiple times (respecting the protocol of
(defun eglot-xref-backend () "Eglot xref backend." 'eglot)
(defvar eglot--temp-location-buffers (make-hash-table :test #'equal)
- "Helper variable for `eglot--handling-xrefs'.")
+ "Helper variable for `eglot--collecting-xrefs'.")
(defvar eglot-xref-lessp-function #'ignore
"Compare two `xref-item' objects for sorting.")
@@ -2897,7 +2905,7 @@ for which LSP on-type-formatting should be requested."
(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
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 85c5992998..cbdb0994cb 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1,7 +1,6 @@
;;; etags.el --- etags facility for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2022 Free
-;; Software Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -2006,16 +2005,15 @@ see the doc of that variable if you want to add names
to the list."
(set-buffer-modified-p nil)
(select-tags-table-mode))
-(defvar select-tags-table-mode-map ; Doc string?
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map button-buffer-map)
- (define-key map "t" 'push-button)
- (define-key map " " 'next-line)
- (define-key map "\^?" 'previous-line)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
- (define-key map "q" 'select-tags-table-quit)
- map))
+(defvar-keymap select-tags-table-mode-map
+ :doc "Keymap for `select-tags-table-mode'."
+ :parent button-buffer-map
+ "t" #'push-button
+ "SPC" #'next-line
+ "DEL" #'previous-line
+ "n" #'next-line
+ "p" #'previous-line
+ "q" #'select-tags-table-quit)
(define-derived-mode select-tags-table-mode special-mode "Select Tags Table"
"Major mode for choosing a current tags table among those already loaded."
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 5bbbfa822f..294cf47087 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -1360,8 +1360,9 @@ default) no filter is applied."
flymake-mode-line-warning-counter
flymake-mode-line-note-counter "]")
"Mode-line construct for formatting Flymake diagnostic counters.
-This is a suitable place for placing the `flymake-error-counter',
-`flymake-warning-counter' and `flymake-note-counter' constructs.
+This is a suitable place for placing the `flymake-mode-line-error-counter',
+`flymake-mode-line-warning-counter' and `flymake-mode-line-note-counter'
+constructs.
Separating each of these with space is not necessary."
:type '(repeat (choice string symbol)))
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 6791e2fc9f..9a68c0e6fd 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -957,7 +957,7 @@ With non-nil ARG, uncomments the region."
(set-marker save-point nil)))
;; uncomment-region calls this with 3 args.
-(defun fortran-uncomment-region (start end &optional ignored)
+(defun fortran-uncomment-region (start end &optional _ignored)
"Uncomment every line in the region."
(fortran-comment-region start end t))
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 0de3d213a4..dff677e785 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -4359,7 +4359,7 @@ member."
"Mapping of local variable names to a string with their value.")
(defun gdb-locals-values-handler-custom ()
- "Store the values of local variables in `gdb-locals-value-map'."
+ "Store the values of local variables in `gdb-locals-values-table'."
(let ((locals-list (bindat-get-field (gdb-mi--partial-output) 'variables)))
(dolist (local locals-list)
(let ((name (bindat-get-field local 'name))
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 281762fb0a..9b7d7a0535 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -752,7 +752,12 @@ It should return a list of completion strings.")
If COMMAND-LINE names a program FILE to debug, gdb will run in
a buffer named *gud-FILE*, and the directory containing FILE
becomes the initial working directory and source-file directory
-for your debugger.
+for your debugger. If you don't want `default-directory' to
+change to the directory of FILE, specify FILE without leading
+directories, in which case FILE should reside either in the
+directory of the buffer from which this command is invoked, or
+it can be found by searching PATH.
+
If COMMAND-LINE requests that gdb attaches to a process PID, gdb
will run in *gud-PID*, otherwise it will run in *gud*; in these
cases the initial working directory is the `default-directory' of
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 5f26521299..4cee361df3 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -1,6 +1,6 @@
;;; make-mode.el --- makefile editing commands for Emacs -*- lexical-binding:t
-*-
-;; Copyright (C) 1992, 1994, 1999-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2022 Free Software Foundation, Inc.
;; Author: Thomas Neumann <tom@smart.bo.open.de>
;; Eric S. Raymond <esr@snark.thyrsus.com>
@@ -37,7 +37,7 @@
;;
;; The command C-c C-f adds certain filenames in the current directory
;; as targets. You can filter out filenames by setting the variable
-;; makefile-ignored-files-in-pickup-regex.
+;; `makefile-ignored-files-in-pickup-regex'.
;;
;; The command C-c C-u grinds for a bit, then pops up a report buffer
;; showing which target names are up-to-date with respect to their
@@ -49,11 +49,14 @@
;; all marked items back in the Makefile with C-c TAB.
;;
;; The command C-c TAB in the makefile buffer inserts a GNU make builtin.
-;; You will be prompted for the builtin's args.
+;; You will be prompted for the builtin's arguments.
;;
;; There are numerous other customization variables.
-;;
+
+
+;;; Code:
+
;; To Do:
;;
;; * Add missing doc strings, improve terse doc strings.
@@ -65,7 +68,7 @@
;; indentation and slashification done automatically. Hard.
;; * Consider removing browser mode. It seems useless.
;; * ":" should notice when a new target is made and add it to the
-;; list (or at least set makefile-need-target-pickup).
+;; list (or at least set `makefile-need-target-pickup').
;; * Make browser into a major mode.
;; * Clean up macro insertion stuff. It is a mess.
;; * Browser entry and exit is weird. Normalize.
@@ -78,15 +81,7 @@
;; * Update texinfo manual.
;; * Update files.el.
-
-
-;;; Code:
-
-;; Sadly we need this for a macro.
-(eval-when-compile
- (require 'imenu)
- (require 'dabbrev)
- (require 'add-log))
+(require 'subr-x) ; `string-limit'
;;; ------------------------------------------------------------
;;; Configurable stuff
@@ -541,7 +536,7 @@ This should identify a `make' command that can handle the
`-q' option."
'makefile-query-one-target-method-function "29.1")
(defcustom makefile-query-one-target-method-function
- 'makefile-query-by-make-minus-q
+ #'makefile-query-by-make-minus-q
"Function to call to determine whether a make target is up to date.
The function must satisfy this calling convention:
@@ -566,34 +561,31 @@ The function must satisfy this calling convention:
(define-abbrev-table 'makefile-mode-abbrev-table ()
"Abbrev table in use in Makefile buffers.")
-(defvar makefile-mode-map
- (let ((map (make-sparse-keymap)))
- ;; set up the keymap
- (define-key map "\C-c:" 'makefile-insert-target-ref)
- (if makefile-electric-keys
- (progn
- (define-key map "$" 'makefile-insert-macro-ref)
- (define-key map ":" 'makefile-electric-colon)
- (define-key map "=" 'makefile-electric-equal)
- (define-key map "." 'makefile-electric-dot)))
- (define-key map "\C-c\C-f" 'makefile-pickup-filenames-as-targets)
- (define-key map "\C-c\C-b" 'makefile-switch-to-browser)
- (define-key map "\C-c\C-c" 'comment-region)
- (define-key map "\C-c\C-p" 'makefile-pickup-everything)
- (define-key map "\C-c\C-u" 'makefile-create-up-to-date-overview)
- (define-key map "\C-c\C-i" 'makefile-insert-gmake-function)
- (define-key map "\C-c\C-\\" 'makefile-backslash-region)
- (define-key map "\C-c\C-m\C-a" 'makefile-automake-mode)
- (define-key map "\C-c\C-m\C-b" 'makefile-bsdmake-mode)
- (define-key map "\C-c\C-m\C-g" 'makefile-gmake-mode)
- (define-key map "\C-c\C-m\C-i" 'makefile-imake-mode)
- (define-key map "\C-c\C-m\C-m" 'makefile-mode)
- (define-key map "\C-c\C-m\C-p" 'makefile-makepp-mode)
- (define-key map "\M-p" 'makefile-previous-dependency)
- (define-key map "\M-n" 'makefile-next-dependency)
- (define-key map "\e\t" 'completion-at-point)
- map)
- "The keymap that is used in Makefile mode.")
+(defvar-keymap makefile-mode-map
+ :doc "The keymap that is used in Makefile mode."
+ "C-c :" #'makefile-insert-target-ref
+ "C-c C-f" #'makefile-pickup-filenames-as-targets
+ "C-c C-b" #'makefile-switch-to-browser
+ "C-c C-c" #'comment-region
+ "C-c C-p" #'makefile-pickup-everything
+ "C-c C-u" #'makefile-create-up-to-date-overview
+ "C-c TAB" #'makefile-insert-gmake-function
+ "C-c C-\\" #'makefile-backslash-region
+ "C-c RET C-a" #'makefile-automake-mode
+ "C-c RET C-b" #'makefile-bsdmake-mode
+ "C-c RET C-g" #'makefile-gmake-mode
+ "C-c RET TAB" #'makefile-imake-mode
+ "C-c RET RET" #'makefile-mode
+ "C-c RET C-p" #'makefile-makepp-mode
+ "M-p" #'makefile-previous-dependency
+ "M-n" #'makefile-next-dependency
+ "C-M-i" #'completion-at-point)
+
+(when makefile-electric-keys
+ (define-key makefile-mode-map "$" #'makefile-insert-macro-ref)
+ (define-key makefile-mode-map ":" #'makefile-electric-colon)
+ (define-key makefile-mode-map "=" #'makefile-electric-equal)
+ (define-key makefile-mode-map "." #'makefile-electric-dot))
(easy-menu-define makefile-mode-menu makefile-mode-map
"Menu for Makefile mode."
@@ -649,22 +641,20 @@ The function must satisfy this calling convention:
:selected (eq major-mode 'makefile-makepp-mode)])))
-(defvar makefile-browser-map
- (let ((map (make-sparse-keymap)))
- (define-key map "n" 'makefile-browser-next-line)
- (define-key map "\C-n" 'makefile-browser-next-line)
- (define-key map "p" 'makefile-browser-previous-line)
- (define-key map "\C-p" 'makefile-browser-previous-line)
- (define-key map " " 'makefile-browser-toggle)
- (define-key map "i" 'makefile-browser-insert-selection)
- (define-key map "I" 'makefile-browser-insert-selection-and-quit)
- (define-key map "\C-c\C-m" 'makefile-browser-insert-continuation)
- (define-key map "q" 'makefile-browser-quit)
- ;; disable horizontal movement
- (define-key map "\C-b" 'undefined)
- (define-key map "\C-f" 'undefined)
- map)
- "The keymap that is used in the macro- and target browser.")
+(defvar-keymap makefile-browser-map
+ :doc "The keymap that is used in the macro- and target browser."
+ "n" #'makefile-browser-next-line
+ "C-n" #'makefile-browser-next-line
+ "p" #'makefile-browser-previous-line
+ "C-p" #'makefile-browser-previous-line
+ "SPC" #'makefile-browser-toggle
+ "i" #'makefile-browser-insert-selection
+ "I" #'makefile-browser-insert-selection-and-quit
+ "C-c RET" #'makefile-browser-insert-continuation
+ "q" #'makefile-browser-quit
+ ;; disable horizontal movement
+ "C-b" #'undefined
+ "C-f" #'undefined)
(defvar makefile-mode-syntax-table
@@ -1001,15 +991,15 @@ Anywhere else just self-inserts."
(self-insert-command arg)))
(defun makefile-insert-macro (macro-name)
- "Prepare definition of a new macro."
+ "Prepare definition of a new macro named MACRO-NAME.
+Interactively, prompt for the name of the macro."
(interactive "sMacro Name: ")
(makefile-pickup-macros)
- (if (not (zerop (length macro-name)))
- (progn
- (beginning-of-line)
- (insert macro-name makefile-macro-assign)
- (setq makefile-need-macro-pickup t)
- (makefile-remember-macro macro-name))))
+ (unless (zerop (length macro-name))
+ (beginning-of-line)
+ (insert macro-name makefile-macro-assign)
+ (setq makefile-need-macro-pickup t)
+ (makefile-remember-macro macro-name)))
(defun makefile-insert-macro-ref (macro-name)
"Complete on a list of known macros, then insert complete ref at point."
@@ -1023,24 +1013,23 @@ Anywhere else just self-inserts."
(defun makefile-insert-target (target-name)
"Prepare definition of a new target (dependency line)."
(interactive "sTarget: ")
- (if (not (zerop (length target-name)))
- (progn
- (beginning-of-line)
- (insert target-name makefile-target-colon)
- (makefile-forward-after-target-colon)
- (end-of-line)
- (setq makefile-need-target-pickup t)
- (makefile-remember-target target-name))))
+ (unless (zerop (length target-name))
+ (beginning-of-line)
+ (insert target-name makefile-target-colon)
+ (makefile-forward-after-target-colon)
+ (end-of-line)
+ (setq makefile-need-target-pickup t)
+ (makefile-remember-target target-name)))
(defun makefile-insert-target-ref (target-name)
"Complete on a list of known targets, then insert TARGET-NAME at point."
(interactive
(list
(progn
- (makefile-pickup-targets)
- (completing-read "Refer to target: " makefile-target-table nil nil nil))))
- (if (not (zerop (length target-name)))
- (insert target-name " ")))
+ (makefile-pickup-targets)
+ (completing-read "Refer to target: " makefile-target-table nil nil
nil))))
+ (unless (zerop (length target-name))
+ (insert target-name " ")))
(defun makefile-electric-colon (arg)
"Prompt for name of new target.
@@ -1081,7 +1070,7 @@ Anywhere else just self-inserts."
(skip-chars-forward " \t")
(not (or (eolp) (eq (char-after) ?:)))))
(forward-line)))
- (message "Read targets OK.")))
+ (message "Read targets OK")))
(defun makefile-pickup-macros ()
"Notice names of all macro definitions in Makefile."
@@ -1101,11 +1090,11 @@ Anywhere else just self-inserts."
(message "Picked up macro \"%s\" from line %d"
macro-name (line-number-at-pos))))
(forward-line)))
- (message "Read macros OK.")))
+ (message "Read macros OK")))
(defun makefile-pickup-everything (arg)
"Notice names of all macros and targets in Makefile.
-Prefix arg means force pickups to be redone."
+Prefix argument ARG means force pickups to be redone."
(interactive "P")
(if arg
(setq makefile-need-target-pickup t
@@ -1173,8 +1162,8 @@ and adds all qualifying names to the list of known
targets."
(defun makefile-backslash-region (from to delete-flag)
"Insert, align, or delete end-of-line backslashes on the lines in the region.
-With no argument, inserts backslashes and aligns existing backslashes.
-With an argument, deletes the backslashes.
+With no argument, insert backslashes and align existing backslashes.
+With an argument, delete the backslashes.
This function does not modify the last line of the region if the region ends
right at the start of the following line; it does not modify blank lines
@@ -1189,9 +1178,9 @@ definition and conveniently use this command."
(when (and makefile-backslash-align (not delete-flag))
(while (< (point) to)
(end-of-line)
- (if (= (preceding-char) ?\\)
- (progn (forward-char -1)
- (skip-chars-backward " \t")))
+ (when (= (preceding-char) ?\\)
+ (forward-char -1)
+ (skip-chars-backward " \t"))
(setq column (max column (1+ (current-column))))
(forward-line 1))
;; Adjust upward to a tab column, if that doesn't push
@@ -1358,18 +1347,16 @@ Fill comments, backslashed lines, and variable
definitions specially."
(defun makefile-browser-next-line ()
"Move the browser selection cursor to the next line."
(interactive)
- (if (not (makefile-last-line-p))
- (progn
- (forward-line 1)
- (forward-char makefile-browser-cursor-column))))
+ (unless (makefile-last-line-p)
+ (forward-line 1)
+ (forward-char makefile-browser-cursor-column)))
(defun makefile-browser-previous-line ()
"Move the browser selection cursor to the previous line."
(interactive)
- (if (not (makefile-first-line-p))
- (progn
- (forward-line -1)
- (forward-char makefile-browser-cursor-column))))
+ (unless (makefile-first-line-p)
+ (forward-line -1)
+ (forward-char makefile-browser-cursor-column)))
;;;
;;; Quitting the browser (returns to client buffer)
@@ -1469,14 +1456,17 @@ Insertion takes place at point."
(if (zerop (+ (length targets) (length macros)))
(progn
(beep)
- (message "No macros or targets to browse! Consider running
`makefile-pickup-everything'"))
+ (message
+ (substitute-command-keys
+ (concat "No macros or targets to browse! "
+ "Consider running \\[makefile-pickup-everything]"))))
(let ((browser-buffer (get-buffer-create makefile-browser-buffer-name)))
- (pop-to-buffer browser-buffer)
- (makefile-browser-fill targets macros)
- (shrink-window-if-larger-than-buffer)
- (setq-local makefile-browser-selection-vector
- (make-vector (+ (length targets) (length macros)) nil))
- (makefile-browser-start-interaction))))
+ (pop-to-buffer browser-buffer)
+ (makefile-browser-fill targets macros)
+ (shrink-window-if-larger-than-buffer)
+ (setq-local makefile-browser-selection-vector
+ (make-vector (+ (length targets) (length macros)) nil))
+ (makefile-browser-start-interaction))))
(defun makefile-switch-to-browser ()
(interactive)
@@ -1504,60 +1494,44 @@ dependency in the makefile."
;; writing the current contents of the makefile buffer.
;;
(let ((saved-target-table makefile-target-table)
- (this-buffer (current-buffer))
- (makefile-up-to-date-buffer
- (get-buffer-create makefile-up-to-date-buffer-name))
- (filename (makefile-save-temporary))
- ;;
- ;; Forget the target table because it may contain picked-up
filenames
- ;; that are not really targets in the current makefile.
- ;; We don't want to query these, so get a new target-table with
just the
- ;; targets that can be found in the makefile buffer.
- ;; The 'old' target table will be restored later.
- ;;
- (real-targets (progn
- (makefile-pickup-targets)
- makefile-target-table))
- (prereqs makefile-has-prereqs)
- )
-
- (set-buffer makefile-up-to-date-buffer)
- (setq buffer-read-only nil)
- (erase-buffer)
- (makefile-query-targets filename real-targets prereqs)
- (if (zerop (buffer-size)) ; if it did not get us anything
- (progn
- (kill-buffer (current-buffer))
- (message "No overview created!")))
- (set-buffer this-buffer)
- (setq makefile-target-table saved-target-table)
- (if (get-buffer makefile-up-to-date-buffer-name)
- (progn
- (pop-to-buffer (get-buffer makefile-up-to-date-buffer-name))
- (shrink-window-if-larger-than-buffer)
- (sort-lines nil (point-min) (point-max))
- (setq buffer-read-only t))))))
+ (this-buffer (current-buffer))
+ (makefile-up-to-date-buffer
+ (get-buffer-create makefile-up-to-date-buffer-name))
+ (filename (makefile-save-temporary))
+ ;;
+ ;; Forget the target table because it may contain picked-up
filenames
+ ;; that are not really targets in the current makefile.
+ ;; We don't want to query these, so get a new target-table with
just the
+ ;; targets that can be found in the makefile buffer.
+ ;; The 'old' target table will be restored later.
+ ;;
+ (real-targets (progn
+ (makefile-pickup-targets)
+ makefile-target-table))
+ (prereqs makefile-has-prereqs))
+ (unwind-protect
+ (progn
+ (set-buffer makefile-up-to-date-buffer)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (makefile-query-targets filename real-targets prereqs)
+ (when (zerop (buffer-size)) ; if it did not get us anything
+ (kill-buffer (current-buffer))
+ (message "No overview created!"))
+ (set-buffer this-buffer)
+ (setq makefile-target-table saved-target-table)
+ (when (get-buffer makefile-up-to-date-buffer-name)
+ (pop-to-buffer (get-buffer makefile-up-to-date-buffer-name))
+ (shrink-window-if-larger-than-buffer)
+ (sort-lines nil (point-min) (point-max))
+ (setq buffer-read-only t)))
+ (ignore-errors (delete-file filename))))))
(defun makefile-save-temporary ()
"Create a temporary file from the current makefile buffer."
- (let ((filename (makefile-generate-temporary-filename)))
+ (let ((filename (make-temp-name "mktmp.")))
(write-region (point-min) (point-max) filename nil 0)
- filename)) ; return the filename
-
-(defun makefile-generate-temporary-filename ()
- "Create a filename suitable for use in `makefile-save-temporary'.
-Be careful to allow brain-dead file systems (DOS, SYSV ...) to cope
-with the generated name!"
- (let ((my-name (user-login-name))
- (my-uid (int-to-string (user-uid))))
- (concat "mktmp"
- (if (> (length my-name) 3)
- (substring my-name 0 3)
- my-name)
- "."
- (if (> (length my-uid) 3)
- (substring my-uid 0 3)
- my-uid))))
+ filename))
(defun makefile-query-targets (filename target-table prereq-list)
"Fill the up-to-date overview buffer.
@@ -1728,14 +1702,13 @@ matched in a rule action."
(defun makefile-remember-target (target-name &optional has-prereqs)
"Remember a given target if it is not already remembered for this buffer."
- (if (not (zerop (length target-name)))
- (progn
- (if (not (assoc target-name makefile-target-table))
- (setq makefile-target-table
- (cons (list target-name) makefile-target-table)))
- (if has-prereqs
- (setq makefile-has-prereqs
- (cons target-name makefile-has-prereqs))))))
+ (unless (zerop (length target-name))
+ (if (not (assoc target-name makefile-target-table))
+ (setq makefile-target-table
+ (cons (list target-name) makefile-target-table)))
+ (if has-prereqs
+ (setq makefile-has-prereqs
+ (cons target-name makefile-has-prereqs)))))
(defun makefile-remember-macro (macro-name)
"Remember a given macro if it is not already remembered for this buffer."
@@ -1824,6 +1797,13 @@ If it isn't in one, return nil."
(setq found (replace-regexp-in-string "\\`[ \t]+" "" found)))
found)))
+(defun makefile-generate-temporary-filename ()
+ "Create a filename suitable for use in `makefile-save-temporary'."
+ (declare (obsolete make-temp-name "29.1"))
+ (format "mktmp%s.%s"
+ (string-limit (user-login-name) 3)
+ (string-limit (int-to-string (user-uid)) 3)))
+
(provide 'make-mode)
;;; make-mode.el ends here
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index c5d5d703fc..db9df67279 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -223,7 +223,7 @@
(regexp-opt perl--syntax-exp-intro-keywords)
;; A HERE document as an argument to printf?
;; when printing to a filehandle.
- "\\|printf?[ \t]*$?[_[:alpha:]][_[:alnum:]]*"
+ "\\|printf?[ \t]*\\$?[_[:alpha:]][_[:alnum:]]*"
"\\|=>"
"\\|[?:.,;|&*=!~({[]"
"\\|[^-+][-+]" ;Bug#42168: `+' is intro but `++' isn't!
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index f8edc2b1f7..6e2c2513b0 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1311,7 +1311,7 @@ With prefix argument ARG, restart the Prolog process if
running before."
(prolog-mode-variables)
))
-(defun prolog-inferior-guess-flavor (&optional ignored)
+(defun prolog-inferior-guess-flavor (&optional _ignored)
(setq-local prolog-system
(when (or (numberp prolog-system) (markerp prolog-system))
(save-excursion
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index 89482d86ce..6355b17e4a 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -278,24 +278,22 @@ If nil, use `temporary-file-directory'."
;; Variables.
-(defvar ps-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-v" #'ps-run-boundingbox)
- (define-key map "\C-c\C-u" #'ps-mode-uncomment-region)
- (define-key map "\C-c\C-t" #'ps-mode-epsf-rich)
- (define-key map "\C-c\C-s" #'ps-run-start)
- (define-key map "\C-c\C-r" #'ps-run-region)
- (define-key map "\C-c\C-q" #'ps-run-quit)
- (define-key map "\C-c\C-p" #'ps-mode-print-buffer)
- (define-key map "\C-c\C-o" #'ps-mode-comment-out-region)
- (define-key map "\C-c\C-k" #'ps-run-kill)
- (define-key map "\C-c\C-j" #'ps-mode-other-newline)
- (define-key map "\C-c\C-l" #'ps-run-clear)
- (define-key map "\C-c\C-b" #'ps-run-buffer)
- ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead?
- (define-key map "\177" #'ps-mode-backward-delete-char)
- map)
- "Local keymap to use in PostScript mode.")
+(defvar-keymap ps-mode-map
+ :doc "Local keymap to use in PostScript mode."
+ "C-c C-v" #'ps-run-boundingbox
+ "C-c C-u" #'ps-mode-uncomment-region
+ "C-c C-t" #'ps-mode-epsf-rich
+ "C-c C-s" #'ps-run-start
+ "C-c C-r" #'ps-run-region
+ "C-c C-q" #'ps-run-quit
+ "C-c C-p" #'ps-mode-print-buffer
+ "C-c C-o" #'ps-mode-comment-out-region
+ "C-c C-k" #'ps-run-kill
+ "C-c C-j" #'ps-mode-other-newline
+ "C-c C-l" #'ps-run-clear
+ "C-c C-b" #'ps-run-buffer
+ ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead?
+ "DEL" #'ps-mode-backward-delete-char)
(defvar ps-mode-syntax-table
(let ((st (make-syntax-table)))
@@ -332,15 +330,13 @@ If nil, use `temporary-file-directory'."
st)
"Syntax table used while in PostScript mode.")
-(defvar ps-run-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map comint-mode-map)
- (define-key map "\C-c\C-q" #'ps-run-quit)
- (define-key map "\C-c\C-k" #'ps-run-kill)
- (define-key map "\C-c\C-e" #'ps-run-goto-error)
- (define-key map [mouse-2] #'ps-run-mouse-goto-error)
- map)
- "Local keymap to use in PostScript run mode.")
+(defvar-keymap ps-run-mode-map
+ :doc "Local keymap to use in PostScript run mode."
+ :parent comint-mode-map
+ "C-c C-q" #'ps-run-quit
+ "C-c C-k" #'ps-run-kill
+ "C-c C-e" #'ps-run-goto-error
+ "<mouse-2>" #'ps-run-mouse-goto-error)
(defvar ps-mode-tmp-file nil
"Name of temporary file, set by `ps-run'.")
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 1119589423..cec0d54a44 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -4375,7 +4375,9 @@ For this to work as best as possible you should call
`python-shell-send-buffer' from time to time so context in
inferior Python process is updated properly."
(let ((process (python-shell-get-process)))
- (when process
+ (when (and process
+ (python-shell-with-shell-buffer
+ (python-util-comint-end-of-output-p)))
(python-shell-completion-at-point process))))
(define-obsolete-function-alias
@@ -4800,6 +4802,8 @@ def __FFAP_get_module_path(objstr):
(defun python-ffap-module-path (module)
"Function for `ffap-alist' to return path for MODULE."
(when-let ((process (python-shell-get-process))
+ (ready (python-shell-with-shell-buffer
+ (python-util-comint-end-of-output-p)))
(module-file
(python-shell-send-string-no-output
(format "%s\nprint(__FFAP_get_module_path(%s))"
@@ -4918,7 +4922,9 @@ If not FORCE-INPUT is passed then what
`python-eldoc--get-symbol-at-point'
returns will be used. If not FORCE-PROCESS is passed what
`python-shell-get-process' returns is used."
(let ((process (or force-process (python-shell-get-process))))
- (when process
+ (when (and process
+ (python-shell-with-shell-buffer
+ (python-util-comint-end-of-output-p)))
(let* ((input (or force-input
(python-eldoc--get-symbol-at-point)))
(docstring
@@ -5664,6 +5670,13 @@ This is for compatibility with Emacs < 24.4."
comint-last-prompt)
(t nil)))
+(defun python-util-comint-end-of-output-p ()
+ "Return non-nil if the last prompt matches input prompt."
+ (when-let ((prompt (python-util-comint-last-prompt)))
+ (python-shell-comint-end-of-output-p
+ (buffer-substring-no-properties
+ (car prompt) (cdr prompt)))))
+
(defun python-util-forward-comment (&optional direction)
"Python mode specific version of `forward-comment'.
Optional argument DIRECTION defines the direction to move to."
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 955daa393c..17467b5554 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -849,7 +849,7 @@ The style of the comment is controlled by
`ruby-encoding-magic-comment-style'."
(back-to-indentation)
(current-column)))
-(defun ruby-indent-line (&optional ignored)
+(defun ruby-indent-line (&optional _ignored)
"Correct the indentation of the current Ruby line."
(interactive)
(ruby-indent-to (ruby-calculate-indent)))
@@ -1576,7 +1576,7 @@ With ARG, do it many times. Negative ARG means move
forward."
((error)))
i))))
-(defun ruby-indent-exp (&optional ignored)
+(defun ruby-indent-exp (&optional _ignored)
"Indent each line in the balanced expression following the point."
(interactive "*P")
(let ((here (point-marker)) start top column (nest t))
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index d6b8edaa36..310a9be4f6 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -9630,7 +9630,7 @@ Returns REGEXP and list of ( (signal_name
connection_name)... )."
(defun verilog-read-auto-template (module)
"Look for an auto_template for the instantiation of the given MODULE.
-If found returns `verilog-read-auto-template-inside' structure."
+If found returns `verilog-read-auto-template-middle' structure."
(save-excursion
;; Find beginning
(let ((pt (point)))
@@ -10024,7 +10024,7 @@ Used for __FLAGS__ in `verilog-expand-command'."
(defvar verilog-dir-cache-preserving nil
"If true, the directory cache is enabled, and file system changes are
ignored.
-See `verilog-dir-exists-p' and `verilog-dir-files'.")
+See `verilog-dir-file-exists-p' and `verilog-dir-files'.")
;; If adding new cached variable, add also to verilog-preserve-dir-cache
(defvar verilog-dir-cache-list nil
diff --git a/lisp/startup.el b/lisp/startup.el
index 725984b815..70267fc857 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1198,7 +1198,7 @@ please check its value")
("--user") ("--iconic") ("--icon-type") ("--quick")
("--no-blinking-cursor") ("--basic-display")
("--dump-file") ("--temacs") ("--seccomp")
- ("--init-directory")))
+ ("--init-directory" "--no-comp-spawn")))
(argi (pop args))
(orig-argi argi)
argval)
@@ -1255,6 +1255,9 @@ please check its value")
((equal argi "-no-site-file")
(setq site-run-file nil)
(put 'site-run-file 'standard-value '(nil)))
+ ((equal argi "-no-comp-spawn")
+ (defvar comp-no-spawn)
+ (setq comp-no-spawn t))
((equal argi "-debug-init")
(setq init-file-debug t))
((equal argi "-iconic")
diff --git a/lisp/subr.el b/lisp/subr.el
index e49c22158f..83e2e75c41 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1217,7 +1217,7 @@ Subkeymaps may be modified but are not canonicalized."
(defun keyboard-translate (from to)
"Translate character FROM to TO on the current terminal.
-This is a legacy function; see `keymap-translate' for the
+This is a legacy function; see `key-translate' for the
recommended function to use instead.
This function creates a `keyboard-translate-table' if necessary
@@ -1296,7 +1296,7 @@ KEY is a string or vector representing a sequence of
keystrokes."
(defun local-key-binding (keys &optional accept-default)
"Return the binding for command KEYS in current local keymap only.
-This is a legacy function; see `keymap-local-binding' for the
+This is a legacy function; see `keymap-local-lookup' for the
recommended function to use instead.
KEYS is a string or vector, a sequence of keystrokes.
@@ -1310,7 +1310,7 @@ about this."
(defun global-key-binding (keys &optional accept-default)
"Return the binding for command KEYS in current global keymap only.
-This is a legacy function; see `keymap-global-binding' for the
+This is a legacy function; see `keymap-global-lookup' for the
recommended function to use instead.
KEYS is a string or vector, a sequence of keystrokes.
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index abefd996a8..2032689c65 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."
@@ -1091,7 +1110,8 @@ Negative TAB-NUMBER counts tabs from the end of the tab
bar."
(to-number (cond ((< tab-number 0) (+ (length tabs) (1+ tab-number)))
((zerop tab-number) (1+ from-index))
(t tab-number)))
- (to-index (1- (max 1 (min to-number (length tabs))))))
+ (to-index (1- (max 1 (min to-number (length tabs)))))
+ (minibuffer-was-active (minibuffer-window-active-p
(selected-window))))
(unless (eq from-index to-index)
(let* ((from-tab (tab-bar--tab))
@@ -1117,7 +1137,7 @@ Negative TAB-NUMBER counts tabs from the end of the tab
bar."
(wc-history-back (alist-get 'wc-history-back to-tab))
(wc-history-forward (alist-get 'wc-history-forward to-tab)))
- (set-window-configuration wc)
+ (set-window-configuration wc nil t)
;; set-window-configuration does not restore the value of
;; point in the current buffer, so restore it separately.
@@ -1145,8 +1165,22 @@ Negative TAB-NUMBER counts tabs from the end of the tab
bar."
tab-bar-history-forward))))
(ws
+ ;; `window-state-put' fails when called in the minibuffer
+ (when (minibuffer-selected-window)
+ (select-window (minibuffer-selected-window)))
(window-state-put ws nil 'safe)))
+ ;; Select the minibuffer when it was active before switching tabs
+ (when (and minibuffer-was-active (active-minibuffer-window))
+ (select-window (active-minibuffer-window)))
+
+ ;; When the minibuffer was activated in one tab, but exited in
+ ;; another tab, then after going back to the first tab, it has
+ ;; such inconsistent state that the current buffer is the minibuffer,
+ ;; but its window is not active. So try to undo this mess.
+ (when (and (minibufferp) (not (active-minibuffer-window)))
+ (other-window 1))
+
(when tab-bar-history-mode
(setq tab-bar-history-omit t))
@@ -1881,7 +1915,7 @@ This navigates back in the history of window
configurations."
(cons tab-bar-history-old
(gethash (selected-frame) tab-bar-history-forward))
tab-bar-history-forward)
- (set-window-configuration wc)
+ (set-window-configuration wc nil t)
(when (and (markerp wc-point) (marker-buffer wc-point))
(goto-char wc-point)))
(message "No more tab back history"))))
@@ -1900,7 +1934,7 @@ This navigates forward in the history of window
configurations."
(cons tab-bar-history-old
(gethash (selected-frame) tab-bar-history-back))
tab-bar-history-back)
- (set-window-configuration wc)
+ (set-window-configuration wc nil t)
(when (and (markerp wc-point) (marker-buffer wc-point))
(goto-char wc-point)))
(message "No more tab forward history"))))
@@ -1916,22 +1950,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/tab-line.el b/lisp/tab-line.el
index 94e8f29a95..a4e95bbc75 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -620,7 +620,8 @@ the selected tab visible."
(let ((truncate-partial-width-windows nil)
(inhibit-modification-hooks t)
show-arrows)
- (setq truncate-lines nil)
+ (setq truncate-lines nil
+ word-wrap nil)
(erase-buffer)
(apply 'insert strings)
(goto-char (point-min))
diff --git a/lisp/textmodes/emacs-news-mode.el
b/lisp/textmodes/emacs-news-mode.el
index d57d053a7a..ebb31da9cf 100644
--- a/lisp/textmodes/emacs-news-mode.el
+++ b/lisp/textmodes/emacs-news-mode.el
@@ -75,7 +75,7 @@
(setq-local font-lock-defaults '(emacs-news-mode-font-lock-keywords t))
(setq-local outline-minor-mode-cycle t
outline-minor-mode-highlight 'append
- outline-minor-mode-use-margins t)
+ 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/page-ext.el b/lisp/textmodes/page-ext.el
index 05c02308e5..b133b1e9e3 100644
--- a/lisp/textmodes/page-ext.el
+++ b/lisp/textmodes/page-ext.el
@@ -276,19 +276,17 @@ Used by `pages-directory-for-addresses' function."
;;; Key bindings for page handling functions
-(defvar pages--ctl-x-ctl-p-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-n" #'pages-next-page)
- (define-key map "\C-p" #'pages-previous-page)
- (define-key map "\C-a" #'pages-add-new-page)
- (define-key map "\C-m" #'mark-page)
- (define-key map "\C-s" #'pages-search)
- (define-key map "s" #'pages-sort-buffer)
- (define-key map "\C-l" #'pages-set-delimiter)
- (define-key map "\C-d" #'pages-directory)
- (define-key map "d" #'pages-directory-for-addresses)
- map)
- "Keymap for subcommands of C-x C-p, which are for page handling.")
+(defvar-keymap pages--ctl-x-ctl-p-map
+ :doc "Keymap for subcommands of \\`C-x C-p', which are for page handling."
+ "C-n" #'pages-next-page
+ "C-p" #'pages-previous-page
+ "C-a" #'pages-add-new-page
+ "C-m" #'mark-page
+ "C-s" #'pages-search
+ "s" #'pages-sort-buffer
+ "C-l" #'pages-set-delimiter
+ "C-d" #'pages-directory
+ "d" #'pages-directory-for-addresses)
;; FIXME: Merely loading a package shouldn't have this kind of side-effects!
(global-unset-key "\C-x\C-p")
@@ -476,14 +474,12 @@ contain matches to the regexp.)")
(define-obsolete-variable-alias 'pages-directory-map
'pages-directory-mode-map "26.1")
-(defvar pages-directory-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" #'pages-directory-goto)
- (define-key map "\C-m" #'pages-directory-goto)
- (define-key map "\C-c\C-p\C-a" #'pages-add-new-page)
- (define-key map [mouse-2] #'pages-directory-goto)
- map)
- "Keymap for the pages-directory-buffer.")
+(defvar-keymap pages-directory-mode-map
+ :doc "Keymap for the pages-directory-buffer."
+ "C-c C-c" #'pages-directory-goto
+ "RET" #'pages-directory-goto
+ "C-c C-p C-a" #'pages-add-new-page
+ "<mouse-2>" #'pages-directory-goto)
(defvar pages-original-delimiter "^\f"
"Default page delimiter.")
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 964f94228b..f81cedc39b 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -266,11 +266,6 @@
;; all a table is still a part of text in the buffer. Only the
;; special behaviors exist inside each cell through text properties.
;;
-;; `table-generate-html' which appeared in earlier releases is
-;; deprecated in favor of `table-generate-source'. Now HTML is
-;; treated as one of the languages used for describing the table's
-;; logical structure.
-;;
;;
;; -------
;; Keymap:
diff --git a/lisp/transient.el b/lisp/transient.el
index a415858970..0919c2c3ef 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -68,26 +68,6 @@
(defvar display-line-numbers) ; since Emacs 26.1
(defvar Man-notify-method)
-(define-obsolete-function-alias 'define-transient-command
- 'transient-define-prefix "Transient 0.3.0")
-(define-obsolete-function-alias 'define-suffix-command
- 'transient-define-suffix "Transient 0.3.0")
-(define-obsolete-function-alias 'define-infix-command
- 'transient-define-infix "Transient 0.3.0")
-(define-obsolete-function-alias 'define-infix-argument
- #'transient-define-argument "Transient 0.3.0")
-
-(define-obsolete-variable-alias 'transient--source-buffer
- 'transient--original-buffer "Transient 0.2.0")
-(define-obsolete-variable-alias 'current-transient-prefix
- 'transient-current-prefix "Transient 0.3.0")
-(define-obsolete-variable-alias 'current-transient-command
- 'transient-current-command "Transient 0.3.0")
-(define-obsolete-variable-alias 'current-transient-suffixes
- 'transient-current-suffixes "Transient 0.3.0")
-(define-obsolete-variable-alias 'post-transient-hook
- 'transient-exit-hook "Transient 0.3.0")
-
(defmacro transient--with-emergency-exit (&rest body)
(declare (indent defun))
`(condition-case err
@@ -893,8 +873,20 @@ to the setup function:
(put ',name 'transient--prefix
(,(or class 'transient-prefix) :command ',name ,@slots))
(put ',name 'transient--layout
- ',(cl-mapcan (lambda (s) (transient--parse-child name s))
- suffixes)))))
+ (list ,@(cl-mapcan (lambda (s) (transient--parse-child name s))
+ suffixes))))))
+
+(defmacro transient-define-groups (name &rest groups)
+ "Define one or more GROUPS and store them in symbol NAME.
+GROUPS, defined using this macro, can be used inside the
+definition of transient prefix commands, by using the symbol
+NAME where a group vector is expected. GROUPS has the same
+form as for `transient-define-prefix'."
+ (declare (debug (&define name [&rest vectorp]))
+ (indent defun))
+ `(put ',name 'transient--layout
+ (list ,@(cl-mapcan (lambda (group) (transient--parse-child name group))
+ groups))))
(defmacro transient-define-suffix (name arglist &rest args)
"Define NAME as a transient suffix command.
@@ -1000,9 +992,8 @@ example, sets a variable use `transient-define-infix'
instead.
(push k keys)
(push v keys))))
(while (let ((arg (car args)))
- (if (vectorp arg)
- (setcar args (eval (cdr (backquote-process arg))))
- (and arg (symbolp arg))))
+ (or (vectorp arg)
+ (and arg (symbolp arg))))
(push (pop args) suffixes))
(list (if (eq (car-safe class) 'quote)
(cadr class)
@@ -1035,17 +1026,24 @@ example, sets a variable use `transient-define-infix'
instead.
(when (stringp car)
(setq args (plist-put args :description pop)))
(while (keywordp car)
- (let ((k pop))
- (if (eq k :class)
- (setq class pop)
- (setq args (plist-put args k pop)))))
- (vector (or level transient--default-child-level)
- (or class
- (if (vectorp car)
- 'transient-columns
- 'transient-column))
- args
- (cl-mapcan (lambda (s) (transient--parse-child prefix s))
spec)))))
+ (let ((key pop)
+ (val pop))
+ (cond ((eq key :class)
+ (setq class (macroexp-quote val)))
+ ((or (symbolp val)
+ (and (listp val) (not (eq (car val) 'lambda))))
+ (setq args (plist-put args key (macroexp-quote val))))
+ ((setq args (plist-put args key val))))))
+ (list 'vector
+ (or level transient--default-child-level)
+ (or class
+ (if (vectorp car)
+ (quote 'transient-columns)
+ (quote 'transient-column)))
+ (and args (cons 'list args))
+ (cons 'list
+ (cl-mapcan (lambda (s) (transient--parse-child prefix s))
+ spec))))))
(defun transient--parse-suffix (prefix spec)
(let (level class args)
@@ -1057,17 +1055,19 @@ example, sets a variable use `transient-define-infix'
instead.
(when (or (stringp car)
(vectorp car))
(setq args (plist-put args :key pop)))
- (when (or (stringp car)
- (eq (car-safe car) 'lambda)
- (and (symbolp car)
- (not (commandp car))
- (commandp (cadr spec))))
+ (cond
+ ((or (stringp car)
+ (eq (car-safe car) 'lambda))
(setq args (plist-put args :description pop)))
+ ((and (symbolp car)
+ (not (commandp car))
+ (commandp (cadr spec)))
+ (setq args (plist-put args :description (macroexp-quote pop)))))
(cond
((keywordp car)
(error "Need command, got %S" car))
((symbolp car)
- (setq args (plist-put args :command pop)))
+ (setq args (plist-put args :command (macroexp-quote pop))))
((and (commandp car)
(not (stringp car)))
(let ((cmd pop)
@@ -1076,7 +1076,7 @@ example, sets a variable use `transient-define-infix'
instead.
(or (plist-get args :description)
(plist-get args :key))))))
(defalias sym cmd)
- (setq args (plist-put args :command sym))))
+ (setq args (plist-put args :command (macroexp-quote sym)))))
((or (stringp car)
(and car (listp car)))
(let ((arg pop))
@@ -1090,11 +1090,11 @@ example, sets a variable use `transient-define-infix'
instead.
(setq args (plist-put args :shortarg shortarg)))
(setq args (plist-put args :argument arg))))
(setq args (plist-put args :command
- (intern (format "transient:%s:%s"
- prefix arg))))
+ (list 'quote (intern (format "transient:%s:%s"
+ prefix arg)))))
(cond ((and car (not (keywordp car)))
(setq class 'transient-option)
- (setq args (plist-put args :reader pop)))
+ (setq args (plist-put args :reader (macroexp-quote pop))))
((not (string-suffix-p "=" arg))
(setq class 'transient-switch))
(t
@@ -1102,17 +1102,23 @@ example, sets a variable use `transient-define-infix'
instead.
(t
(error "Needed command or argument, got %S" car)))
(while (keywordp car)
- (let ((k pop))
- (cl-case k
- (:class (setq class pop))
- (:level (setq level pop))
- (t (setq args (plist-put args k pop)))))))
+ (let ((key pop)
+ (val pop))
+ (cond ((eq key :class) (setq class val))
+ ((eq key :level) (setq level val))
+ ((eq (car-safe val) '\,)
+ (setq args (plist-put args key (cadr val))))
+ ((or (symbolp val)
+ (and (listp val) (not (eq (car val) 'lambda))))
+ (setq args (plist-put args key (macroexp-quote val))))
+ ((setq args (plist-put args key val)))))))
(unless (plist-get args :key)
(when-let ((shortarg (plist-get args :shortarg)))
(setq args (plist-put args :key shortarg))))
- (list (or level transient--default-child-level)
- (or class 'transient-suffix)
- args)))
+ (list 'list
+ (or level transient--default-child-level)
+ (macroexp-quote (or class 'transient-suffix))
+ (cons 'list args))))
(defun transient--default-infix-command ()
(cons 'lambda
@@ -1139,6 +1145,22 @@ example, sets a variable use `transient-define-infix'
instead.
(and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg)
(match-string 1 arg))))
+(defun transient-parse-suffix (prefix suffix)
+ "Parse SUFFIX, to be added to PREFIX.
+PREFIX is a prefix command, a symbol.
+SUFFIX is a suffix command or a group specification (of
+ the same forms as expected by `transient-define-prefix').
+Intended for use in PREFIX's `:setup-children' function."
+ (eval (car (transient--parse-child prefix suffix))))
+
+(defun transient-parse-suffixes (prefix suffixes)
+ "Parse SUFFIXES, to be added to PREFIX.
+PREFIX is a prefix command, a symbol.
+SUFFIXES is a list of suffix command or a group specification
+ (of the same forms as expected by `transient-define-prefix').
+Intended for use in PREFIX's `:setup-children' function."
+ (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes))
+
;;; Edit
(defun transient--insert-suffix (prefix loc suffix action &optional keep-other)
@@ -1148,6 +1170,7 @@ example, sets a variable use `transient-define-infix'
instead.
(string suffix)))
(mem (transient--layout-member loc prefix))
(elt (car mem)))
+ (setq suf (eval suf))
(cond
((not mem)
(message "Cannot insert %S into %s; %s not found"
@@ -1448,7 +1471,10 @@ probably use this instead:
transient-current-prefix)
(cl-find-if (lambda (obj)
(eq (transient--suffix-command obj)
- (or command this-command)))
+ ;; When `this-command' is `transient-set-level',
+ ;; its reader needs to know what command is being
+ ;; configured.
+ (or command this-original-command)))
(or transient--suffixes
transient-current-suffixes))
(when-let* ((obj (get (or command this-command) 'transient--suffix))
@@ -1555,32 +1581,39 @@ to `transient-predicate-map'. Also see
`transient-base-map'.")
(put 'transient-common-commands
'transient--layout
- (cl-mapcan
- (lambda (s) (transient--parse-child 'transient-common-commands s))
- `([:hide ,(lambda ()
- (and (not (memq (car (bound-and-true-p
- transient--redisplay-key))
- transient--common-command-prefixes))
- (not transient-show-common-commands)))
- ["Value commands"
- ("C-x s " "Set" transient-set)
- ("C-x C-s" "Save" transient-save)
- ("C-x C-k" "Reset" transient-reset)
- ("C-x p " "Previous value" transient-history-prev)
- ("C-x n " "Next value" transient-history-next)]
- ["Sticky commands"
- ;; Like `transient-sticky-map' except that
- ;; "C-g" has to be bound to a different command.
- ("C-g" "Quit prefix or transient" transient-quit-one)
- ("C-q" "Quit transient stack" transient-quit-all)
- ("C-z" "Suspend transient stack" transient-suspend)]
- ["Customize"
- ("C-x t" transient-toggle-common
- :description ,(lambda ()
- (if transient-show-common-commands
- "Hide common commands"
- "Show common permanently")))
- ("C-x l" "Show/hide suffixes" transient-set-level)]])))
+ (list
+ (eval
+ (car (transient--parse-child
+ 'transient-common-commands
+ (vector
+ :hide
+ (lambda ()
+ (and (not (memq
+ (car (bound-and-true-p transient--redisplay-key))
+ transient--common-command-prefixes))
+ (not transient-show-common-commands)))
+ (vector
+ "Value commands"
+ (list "C-x s " "Set" #'transient-set)
+ (list "C-x C-s" "Save" #'transient-save)
+ (list "C-x C-k" "Reset" #'transient-reset)
+ (list "C-x p " "Previous value" #'transient-history-prev)
+ (list "C-x n " "Next value" #'transient-history-next))
+ (vector
+ "Sticky commands"
+ ;; Like `transient-sticky-map' except that
+ ;; "C-g" has to be bound to a different command.
+ (list "C-g" "Quit prefix or transient" #'transient-quit-one)
+ (list "C-q" "Quit transient stack" #'transient-quit-all)
+ (list "C-z" "Suspend transient stack" #'transient-suspend))
+ (vector
+ "Customize"
+ (list "C-x t" 'transient-toggle-common :description
+ (lambda ()
+ (if transient-show-common-commands
+ "Hide common commands"
+ "Show common permanently")))
+ (list "C-x l" "Show/hide suffixes" #'transient-set-level))))))))
(defvar transient-popup-navigation-map
(let ((map (make-sparse-keymap)))
@@ -2176,7 +2209,8 @@ value. Otherwise return CHILDREN as is."
;; used to call another command
;; that also uses the minibuffer.
(equal
- (string-to-multibyte (this-command-keys))
+ (ignore-errors
+ (string-to-multibyte (this-command-keys)))
(format "\M-x%s\r" this-command))))))
(transient--debug 'post-command-hook "act: %s" act)
(when act
@@ -3501,7 +3535,7 @@ Optional support for popup buttons is also implemented
here."
(cl-defmethod transient-format-description ((obj transient-child))
"The `description' slot may be a function, in which case that is
-called inside the correct buffer (see `transient-insert-group')
+called inside the correct buffer (see `transient--insert-group')
and its value is returned to the caller."
(and-let* ((desc (oref obj description)))
(if (functionp desc)
@@ -3669,7 +3703,14 @@ manpage, then try to jump to the correct location."
(defun transient--describe-function (fn)
(describe-function (if (symbolp fn) fn 'transient--anonymous-infix-argument))
- (select-window (get-buffer-window (help-buffer))))
+ (unless (derived-mode-p 'help-mode)
+ (when-let* ((buf (get-buffer "*Help*"))
+ (win (or (and buf (get-buffer-window buf))
+ (cl-find-if (lambda (win)
+ (with-current-buffer (window-buffer win)
+ (derived-mode-p 'help-mode)))
+ (window-list)))))
+ (select-window win))))
(defun transient--anonymous-infix-argument ()
"Cannot show any documentation for this anonymous infix command.
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 147a643c9f..95c0fe14f3 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -63,9 +63,9 @@ If a list, it is a list of the types of messages to be
logged."
(and (listp url-debug) (memq tag url-debug)))
(with-current-buffer (get-buffer-create "*URL-DEBUG*")
(goto-char (point-max))
- (insert (symbol-name tag) " -> " (apply 'format args) "\n")
+ (insert (symbol-name tag) " -> " (apply #'format args) "\n")
(if (numberp url-debug)
- (apply 'message args)))))
+ (apply #'message args)))))
;;;###autoload
(defun url-parse-args (str &optional nodowncase)
@@ -125,23 +125,13 @@ conversion. Replaces these characters as follows:
< ==> <
> ==> >
\" ==> ""
- (if (string-match "[&<>\"]" string)
- (with-current-buffer (get-buffer-create " *entity*")
- (erase-buffer)
- (buffer-disable-undo (current-buffer))
- (insert string)
- (goto-char (point-min))
- (while (progn
- (skip-chars-forward "^&<>\"")
- (not (eobp)))
- (insert (cdr (assq (char-after (point))
- '((?\" . """)
- (?& . "&")
- (?< . "<")
- (?> . ">")))))
- (delete-char 1))
- (buffer-string))
- string))
+ (replace-regexp-in-string "[&<>\"]"
+ (lambda (c) (cdr (assq (aref c 0)
+ '((?\" . """)
+ (?& . "&")
+ (?< . "<")
+ (?> . ">")))))
+ string))
;;;###autoload
(defun url-normalize-url (url)
@@ -169,7 +159,7 @@ Will not do anything if `url-show-status' is nil."
(= url-lazy-message-time
(setq url-lazy-message-time (time-convert nil 'integer))))
nil
- (apply 'message args)))
+ (apply #'message args)))
;;;###autoload
(defun url-get-normalized-date (&optional specified-time)
@@ -186,7 +176,7 @@ Will not do anything if `url-show-status' is nil."
#'string-trim-left "29.1")
(define-obsolete-function-alias 'url-pretty-length
- 'file-size-human-readable "24.4")
+ #'file-size-human-readable "24.4")
;;;###autoload
(defun url-display-message (fmt &rest args)
@@ -206,7 +196,7 @@ Will not do anything if `url-show-status' is nil."
(round (* 100 (/ x (float y)))))
;;;###autoload
-(defalias 'url-basepath 'url-file-directory)
+(defalias 'url-basepath #'url-file-directory)
;;;###autoload
(defun url-file-directory (file)
@@ -395,8 +385,7 @@ if character N is allowed."
(aref url-encoding-table byte)))
(if (multibyte-string-p string)
(encode-coding-string string 'utf-8)
- string)
- ""))
+ string)))
(defconst url-host-allowed-chars
;; Allow % to avoid re-encoding %-encoded sequences.
diff --git a/lisp/url/url.el b/lisp/url/url.el
index b4ece5faeb..92057742ca 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -293,7 +293,7 @@ how long to wait for a response before giving up."
(declare-function mm-display-part "mm-decode"
(handle &optional no-default force))
-(defun url-mm-callback (&rest ignored)
+(defun url-mm-callback (&rest _ignored)
(let ((handle (mm-dissect-buffer t)))
(url-mark-buffer-as-dead (current-buffer))
(with-current-buffer
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 1fb91c6452..90903255e0 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -51,6 +51,7 @@
;; - receive-file (file rev) ?? PROBABLY NOT NEEDED
;; - unregister (file) OK
;; * checkin (files rev comment) OK
+;; - checkin-patch (patch-string comment) OK
;; * find-revision (file rev buffer) OK
;; * checkout (file &optional rev) OK
;; * revert (file &optional contents-done) OK
@@ -1189,16 +1190,31 @@ It is based on `log-edit-mode', and has Hg-specific
extensions.")
(defun vc-hg-checkin (files comment &optional _rev)
"Hg-specific version of `vc-backend-checkin'.
REV is ignored."
- (let ((amend-extract-fn
- (lambda (value)
- (when (equal value "yes")
- (list "--amend")))))
- (apply #'vc-hg-command nil 0 files
- (nconc (list "commit" "-m")
- (log-edit-extract-headers `(("Author" . "--user")
- ("Date" . "--date")
- ("Amend" . ,amend-extract-fn))
- comment)))))
+ (apply #'vc-hg-command nil 0 files
+ (nconc (list "commit" "-m")
+ (vc-hg--extract-headers comment))))
+
+(defun vc-hg-checkin-patch (patch-string comment)
+ (let ((patch-file (make-temp-file "hg-patch")))
+ (write-region patch-string nil patch-file)
+ (unwind-protect
+ (progn
+ (apply #'vc-hg-command nil 0 nil
+ (nconc (list "import" "--bypass" patch-file "-m")
+ (vc-hg--extract-headers comment)))
+ (vc-hg-command nil 0 nil
+ "update"
+ "--merge" "--tool" "internal:local"
+ "tip"))
+ (delete-file patch-file))))
+
+(defun vc-hg--extract-headers (comment)
+ (log-edit-extract-headers `(("Author" . "--user")
+ ("Date" . "--date")
+ ("Amend" . (lambda (value)
+ (when (equal value "yes")
+ (list "--amend")))))
+ comment))
(defun vc-hg-find-revision (file rev buffer)
(let ((coding-system-for-read 'binary)
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index d7b83ef34a..4238461b7e 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -272,42 +272,40 @@
indentation empty space-after-tab
space-mark tab-mark newline-mark
missing-newline-at-eof)
- "Specify which kind of blank is visualized.
+ "Determine the kinds of whitespace are visualized.
-It's a list containing some or all of the following values:
+The value is a list containing one or more of the following symbols:
- face enable all visualization via faces (see below).
+ face visualize by using faces (see below).
- trailing trailing blanks are visualized via faces.
- It has effect only if `face' (see above)
+ trailing visualize trailing blanks via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- tabs TABs are visualized via faces.
- It has effect only if `face' (see above)
+ tabs visualize TABs via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- spaces SPACEs and HARD SPACEs are visualized via
+ spaces visualize SPACEs and HARD SPACEs via
faces.
- It has effect only if `face' (see above)
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- lines lines which have columns beyond
- `whitespace-line-column' are highlighted via
- faces.
+ lines highlight lines which have columns beyond
+ `whitespace-line-column' via faces.
Whole line is highlighted.
- It has precedence over `lines-tail' and
+ This has precedence over `lines-tail' and
`lines-char' (see below).
- It has effect only if `face' (see above)
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- lines-tail lines which have columns beyond
- `whitespace-line-column' are highlighted via
- faces.
- But only the part of line which goes
- beyond `whitespace-line-column' column.
- It has effect only if `lines' (see above)
- is not present in `whitespace-style'
- and if `face' (see above) is present in
+ lines-tail highlighted lines which have columns beyond
+ `whitespace-line-column' via faces.
+ Only the part of line which goes beyond
+ `whitespace-line-column' column.
+ This has effect only if `lines' (see above)
+ is NOT present in `whitespace-style',
+ and if `face' (see above) IS present in
`whitespace-style'.
lines-char lines which have columns beyond
@@ -319,82 +317,81 @@ It's a list containing some or all of the following
values:
in `whitespace-style' and if `face' (see
above) is present in `whitespace-style'.
- newline NEWLINEs are visualized via faces.
- It has effect only if `face' (see above)
+ newline visualize NEWLINEs via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- missing-newline-at-eof Missing newline at the end of the file is
- visualized via faces.
- It has effect only if `face' (see above)
+ missing-newline-at-eof visualize missing newline at the end of
+ the file via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- empty empty lines at beginning and/or end of buffer
- are visualized via faces.
- It has effect only if `face' (see above)
+ empty visualize empty lines at beginning and/or
+ end of buffer via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- indentation::tab `tab-width' or more SPACEs at beginning of line
- are visualized via faces.
- It has effect only if `face' (see above)
+ indentation::tab visualize `tab-width' or more SPACEs at
+ beginning of line via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- indentation::space TABs at beginning of line are visualized via
+ indentation::space visualize TABs at beginning of line via
faces.
- It has effect only if `face' (see above)
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- indentation `tab-width' or more SPACEs at beginning of line
- are visualized, if `indent-tabs-mode' (which
- see) is non-nil; otherwise, TABs at beginning
- of line are visualized via faces.
- It has effect only if `face' (see above)
+ indentation visualize `tab-width' or more SPACEs at
+ beginning of line, if `indent-tabs-mode' (which
+ see) is non-nil; otherwise, visualize TABs
+ at beginning of line via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- big-indent Big indentations are visualized via faces.
- It has effect only if `face' (see above)
+ big-indent visualize big indentations via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-after-tab::tab `tab-width' or more SPACEs after a TAB
- are visualized via faces.
- It has effect only if `face' (see above)
+ space-after-tab::tab visualize `tab-width' or more SPACEs
+ after a TAB via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-after-tab::space TABs are visualized when `tab-width' or
+ space-after-tab::space visualize TABs when `tab-width' or
more SPACEs occur after a TAB, via
faces.
- It has effect only if `face' (see above)
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-after-tab `tab-width' or more SPACEs after a TAB
- are visualized, if `indent-tabs-mode'
+ space-after-tab visualize `tab-width' or more SPACEs
+ after a TAB, if `indent-tabs-mode'
(which see) is non-nil; otherwise,
- the TABs are visualized via faces.
- It has effect only if `face' (see above)
+ visualize the TABs via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-before-tab::tab SPACEs before TAB are visualized via
- faces.
- It has effect only if `face' (see above)
+ space-before-tab::tab visualize SPACEs before TAB via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-before-tab::space TABs are visualized when SPACEs occur
+ space-before-tab::space visualize TABs when SPACEs occur
before TAB, via faces.
- It has effect only if `face' (see above)
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-before-tab SPACEs before TAB are visualized, if
+ space-before-tab visualize SPACEs before TAB, if
`indent-tabs-mode' (which see) is
- non-nil; otherwise, the TABs are
- visualized via faces.
- It has effect only if `face' (see above)
+ non-nil; otherwise, visualize TABs
+ via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-mark SPACEs and HARD SPACEs are visualized via
+ space-mark visualize SPACEs and HARD SPACEs via
display table.
- tab-mark TABs are visualized via display table.
+ tab-mark visualize TABs via display table.
- newline-mark NEWLINEs are visualized via display table.
+ newline-mark visualize NEWLINEs via display table.
Any other value is ignored.
@@ -404,8 +401,7 @@ via display table.
There is an evaluation order for some values, if they are
included in `whitespace-style' list. For example, if
indentation, indentation::tab and/or indentation::space are
-included in `whitespace-style' list. The evaluation order for
-these values is:
+included in `whitespace-style' list, the evaluation order is:
* For indentation:
1. indentation
@@ -477,7 +473,9 @@ Used when `whitespace-style' includes the value `spaces'.")
(((class color) (background light))
:background "LightYellow" :foreground "lightgray")
(t :inverse-video t))
- "Face used to visualize SPACE."
+ "Face used to visualize SPACE.
+
+See `whitespace-space-regexp'."
:group 'whitespace)
@@ -492,7 +490,9 @@ Used when `whitespace-style' includes the value `spaces'.")
(((class color) (background light))
:background "LemonChiffon3" :foreground "lightgray")
(t :inverse-video t))
- "Face used to visualize HARD SPACE."
+ "Face used to visualize HARD SPACE.
+
+See `whitespace-hspace-regexp'."
:group 'whitespace)
@@ -508,7 +508,9 @@ Used when `whitespace-style' includes the value `tabs'.")
(((class color) (background light))
:background "beige" :foreground "lightgray")
(t :inverse-video t))
- "Face used to visualize TAB."
+ "Face used to visualize TAB.
+
+See `whitespace-tab-regexp'."
:group 'whitespace)
@@ -542,7 +544,9 @@ Used when `whitespace-style' includes the value
`trailing'.")
'((default :weight bold)
(((class mono)) :inverse-video t :underline t)
(t :background "red1" :foreground "yellow"))
- "Face used to visualize trailing blanks."
+ "Face used to visualize trailing blanks.
+
+See '`whitespace-trailing-regexp'."
:group 'whitespace)
@@ -570,7 +574,9 @@ Used when `whitespace-style' includes the value
`space-before-tab'.")
(defface whitespace-space-before-tab
'((((class mono)) :inverse-video t :weight bold :underline t)
(t :background "DarkOrange" :foreground "firebrick"))
- "Face used to visualize SPACEs before TAB."
+ "Face used to visualize SPACEs before TAB.
+
+See `whitespace-space-before-tab-regexp'."
:group 'whitespace)
@@ -582,13 +588,17 @@ Used when `whitespace-style' includes the value
`indentation'.")
(defface whitespace-indentation
'((((class mono)) :inverse-video t :weight bold :underline t)
(t :background "yellow" :foreground "firebrick"))
- "Face used to visualize `tab-width' or more SPACEs at beginning of line."
+ "Face used to visualize `tab-width' or more SPACEs at beginning of line.
+
+See `whitespace-indentation-regexp'."
:group 'whitespace)
(defface whitespace-big-indent
'((((class mono)) :inverse-video t :weight bold :underline t)
(t :background "red" :foreground "firebrick"))
- "Face used to visualize big indentation."
+ "Face used to visualize big indentation.
+
+See `whitespace-big-indent-regexp'."
:group 'whitespace)
(defface whitespace-missing-newline-at-eof
@@ -604,7 +614,9 @@ Used when `whitespace-style' includes the value `empty'.")
(defface whitespace-empty
'((((class mono)) :inverse-video t :weight bold :underline t)
(t :background "yellow" :foreground "firebrick" :extend t))
- "Face used to visualize empty lines at beginning and/or end of buffer."
+ "Face used to visualize empty lines at beginning and/or end of buffer.
+
+See `whitespace-empty-at-bob-regexp' and `whitespace-empty-at-eob-regexp."
:group 'whitespace)
@@ -617,14 +629,17 @@ Used when `whitespace-style' includes the value
`space-after-tab'.")
(defface whitespace-space-after-tab
'((((class mono)) :inverse-video t :weight bold :underline t)
(t :background "yellow" :foreground "firebrick"))
- "Face used to visualize `tab-width' or more SPACEs after TAB."
+ "Face used to visualize `tab-width' or more SPACEs after TAB.
+
+See `whitespace-space-after-tab-regexp'."
:group 'whitespace)
(defcustom whitespace-hspace-regexp
"\\(\u00A0+\\)"
- "Specify HARD SPACE characters regexp.
+ "Regexp to match HARD SPACE characters that should be visualized.
+The HARD SPACE characters are highlighted using the `whitespace-hspace' face.
Here are some examples:
\"\\\\(^\\xA0+\\\\)\" \
@@ -636,19 +651,21 @@ visualize leading and/or trailing HARD SPACEs.
\"\\t\\\\(\\xA0+\\\\)\\t\" \
visualize only HARD SPACEs between TABs.
-NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
+NOTE: Always enclose the elements to highlight in \\\\(...\\\\).
Use exactly one pair of enclosing \\\\( and \\\\).
-Used when `whitespace-style' includes `spaces'."
+This variable is used when `whitespace-style' includes `spaces'."
:type '(regexp :tag "HARD SPACE Chars")
:group 'whitespace)
(defcustom whitespace-space-regexp "\\( +\\)"
- "Specify SPACE characters regexp.
+ "Regexp to match SPACE characters that should be visualized.
-If you're using `mule' package, there may be other characters
-besides \" \" that should be considered SPACE.
+The SPACE characters are highlighted using the `whitespace-space' face.
+By default only ASCII SPACE character is visualized, but if you
+are typing in some non-Latin language, there may be other
+characters besides \" \" that should be considered SPACE.
Here are some examples:
@@ -658,19 +675,21 @@ Here are some examples:
visualize leading and/or trailing SPACEs.
\"\\t\\\\( +\\\\)\\t\" visualize only SPACEs between TABs.
-NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
+NOTE: Always enclose the elements to highlight in \\\\(...\\\\).
Use exactly one pair of enclosing \\\\( and \\\\).
-Used when `whitespace-style' includes `spaces'."
+This variable is used when `whitespace-style' includes `spaces'."
:type '(regexp :tag "SPACE Chars")
:group 'whitespace)
(defcustom whitespace-tab-regexp "\\(\t+\\)"
- "Specify TAB characters regexp.
+ "Regexp to match TAB characters that should be visualized.
-If you're using `mule' package, there may be other characters
-besides \"\\t\" that should be considered TAB.
+The TAB characters are highlighted using the `whitespace-tab' face.
+By default only ASCII TAB character is visualized, but if you
+are typing in some non-Latin language, there may be other
+characters besides \" \" that should be considered a TAB.
Here are some examples:
@@ -680,37 +699,40 @@ Here are some examples:
visualize leading and/or trailing TABs.
\" \\\\(\\t+\\\\) \" visualize only TABs between SPACEs.
-NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
+NOTE: Always enclose the elements to highlight in \\\\(...\\\\).
Use exactly one pair of enclosing \\\\( and \\\\).
-Used when `whitespace-style' includes `tabs'."
+This variable is used when `whitespace-style' includes `tabs'."
:type '(regexp :tag "TAB Chars")
:group 'whitespace)
(defcustom whitespace-trailing-regexp
"\\([\t \u00A0]+\\)$"
- "Specify trailing characters regexp.
+ "Regexp to match trailing characters that should be visualized.
+The trailing characters are highlighted using the `whitespace-trailing' face.
There may be other characters besides:
\" \" \"\\t\" \"\\u00A0\"
that should be considered blank.
-NOTE: Enclose always by \"\\\\(\" and \"\\\\)$\" the elements to highlight.
+NOTE: Always enclose the elements to highlight in \"\\\\(\"...\"\\\\)$\".
Use exactly one pair of enclosing elements above.
-Used when `whitespace-style' includes `trailing'."
+This variable is used when `whitespace-style' includes `trailing'."
:type '(regexp :tag "Trailing Chars")
:group 'whitespace)
(defcustom whitespace-space-before-tab-regexp "\\( +\\)\\(\t+\\)"
- "Specify SPACEs before TAB regexp.
+ "Regexp to match SPACEs before TAB that should be visualized.
-Used when `whitespace-style' includes `space-before-tab',
-`space-before-tab::tab' or `space-before-tab::space'."
+The SPACE characters are highlighted using the `whitespace-space-before-tab'
+face.
+This variable is used when `whitespace-style' includes
+`space-before-tab', `space-before-tab::tab' or `space-before-tab::space'."
:type '(regexp :tag "SPACEs Before TAB")
:group 'whitespace)
@@ -718,12 +740,15 @@ Used when `whitespace-style' includes `space-before-tab',
(defcustom whitespace-indentation-regexp
'("^\t*\\(\\( \\{%d\\}\\)+\\)[^\n\t]"
. "^ *\\(\t+\\)[^\n]")
- "Specify regexp for `tab-width' or more SPACEs at beginning of line.
+ "Regexps to match indentation whitespace that should be visualized.
-It is a cons where the cons car is used for SPACEs visualization
-and the cons cdr is used for TABs visualization.
+The value should be a cons whose car specifies the regexp to match
+visualization of SPACEs, and the cdr specifies the regexp to match
+visualization of TABs.
-Used when `whitespace-style' includes `indentation',
+The indentation characters are highlighted using the `whitespace-indentationp'
+face.
+This variable is used when `whitespace-style' includes `indentation',
`indentation::tab' or `indentation::space'."
:type '(cons (string :tag "Indentation SPACEs")
(regexp :tag "Indentation TABs"))
@@ -731,17 +756,19 @@ Used when `whitespace-style' includes `indentation',
(defcustom whitespace-empty-at-bob-regexp "\\`\\([ \t\n]*\\(?:\n\\|$\\)\\)"
- "Specify regexp for empty lines at beginning of buffer.
+ "Regexp to match empty lines at beginning of buffer that should be
visualized.
-Used when `whitespace-style' includes `empty'."
+The empty lines are highlighted using the `whitespace-empty' face.
+This variable is used when `whitespace-style' includes `empty'."
:type '(regexp :tag "Empty Lines At Beginning Of Buffer")
:group 'whitespace)
(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'"
- "Specify regexp for empty lines at end of buffer.
+ "Regexp to match empty lines at end of buffer that should be visualized.
-Used when `whitespace-style' includes `empty'."
+The empty lines are highlighted using the `whitespace-empty' face.
+This variable is used when `whitespace-style' includes `empty'."
:type '(regexp :tag "Empty Lines At End Of Buffer")
:group 'whitespace)
@@ -749,12 +776,16 @@ Used when `whitespace-style' includes `empty'."
(defcustom whitespace-space-after-tab-regexp
'("\t+\\(\\( \\{%d,\\}\\)+\\)"
. "\\(\t+\\) \\{%d,\\}")
- "Specify regexp for `tab-width' or more SPACEs after TAB.
+ "Regexps to match multiple SPACEs after TAB that should be visualized.
-It is a cons where the cons car is used for SPACEs visualization
-and the cons cdr is used for TABs visualization.
+The SPACE and TAB characters will be visualized if there at least
+as many SPACEs as `tab-width' after a TAB.
+The value should be a cons whose car is used for SPACEs visualization
+and whose cdr is used for TABs visualization.
-Used when `whitespace-style' includes `space-after-tab',
+The SPACE characters are highlighted using the `whitespace-space-after-tab'
+face.
+This variable is used when `whitespace-style' includes `space-after-tab',
`space-after-tab::tab' or `space-after-tab::space'."
:type '(cons (string :tag "SPACEs After TAB")
string)
@@ -762,28 +793,33 @@ Used when `whitespace-style' includes `space-after-tab',
(defcustom whitespace-big-indent-regexp
"^\\(\\(?:\t\\{4,\\}\\| \\{32,\\}\\)[\t ]*\\)"
- "Specify big indentation regexp.
+ "Regexp to match big indentation at BOL that should be visualized.
-If you're using `mule' package, there may be other characters
-besides \"\\t\" that should be considered TAB.
+The indentation characters are highlighted using the `whitespace-big-indent'
+face.
+If you're using non-Latin languages, there may be other characters
+besides \"\\t\" that should be considered a TAB.
-NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
+NOTE: Always enclose the elements to highlight in \\\\(...\\\\).
Use exactly one pair of enclosing \\\\( and \\\\).
-Used when `whitespace-style' includes `big-indent'."
+This variable is used when `whitespace-style' includes `big-indent'."
:version "25.1"
:type '(regexp :tag "Detect too much indentation at the beginning of a line")
:group 'whitespace)
(defcustom whitespace-line-column 80
- "Specify column beyond which the line is highlighted.
+ "Column beyond which the line is highlighted.
+
+The value must be an integer or nil. If nil, use the value
+of the `fill-column' variable.
-It must be an integer or nil. If nil, the `fill-column' variable value is
-used.
+The characters beyond the column specified by this variable are
+highlighted using the `whitespace-line' face.
-Used when `whitespace-style' includes `lines', `lines-tail' or
-`lines-char'."
+This variable is used when `whitespace-style' includes `lines',
+`lines-tail' or `lines-char'."
:type '(choice :tag "Line Length Limit"
(integer :tag "Line Length")
(const :tag "Use fill-column" nil))
@@ -811,7 +847,7 @@ Used when `whitespace-style' includes `lines', `lines-tail'
or
;; If this is a problem for you, please, comment the line below.
(tab-mark ?\t [?» ?\t] [?\\ ?\t]) ; tab - right guillemet
)
- "Specify an alist of mappings for displaying characters.
+ "Alist of mappings for displaying characters.
Each element has the following form:
@@ -831,15 +867,15 @@ KIND is the kind of character.
CHAR is the character to be mapped.
VECTOR is a vector of characters to be displayed in place of CHAR.
- The first display vector that can be displayed is used;
+ The first vector that can be displayed by the terminal is used;
if no display vector for a mapping can be displayed, then
that character is displayed unmodified.
The NEWLINE character is displayed using the face given by
`whitespace-newline' variable.
-Used when `whitespace-style' includes `tab-mark', `space-mark' or
-`newline-mark'."
+This variable is used when `whitespace-style' includes `tab-mark',
+`space-mark' or `newline-mark'."
:type '(repeat
(list :tag "Character Mapping"
(choice :tag "Char Kind"
@@ -861,8 +897,7 @@ Used when `whitespace-style' includes `tab-mark',
`space-mark' or
Global `whitespace-mode' is controlled by the command
`global-whitespace-mode'.
-If nil, means no modes have `whitespace-mode' automatically
-turned on.
+If nil, no modes have `whitespace-mode' automatically turned on.
If t, all modes that support `whitespace-mode' have it
automatically turned on.
@@ -889,16 +924,16 @@ C++ modes only."
(defcustom whitespace-action nil
"Specify which action is taken when a buffer is visited or written.
-It's a list containing some or all of the following values:
+The value is a list containing one or more of the following symbols:
nil no action is taken.
- cleanup cleanup any bogus whitespace always when local
+ cleanup always cleanup any bogus whitespace when local
whitespace is turned on.
See `whitespace-cleanup' and
`whitespace-cleanup-region'.
- report-on-bogus report if there is any bogus whitespace always
+ report-on-bogus always report if there is any bogus whitespace
when local whitespace is turned on.
auto-cleanup cleanup any bogus whitespace when buffer is
@@ -906,8 +941,8 @@ It's a list containing some or all of the following values:
See `whitespace-cleanup' and
`whitespace-cleanup-region'.
- abort-on-bogus abort if there is any bogus whitespace and the
- buffer is written.
+ abort-on-bogus signal an error when writing the buffer if there is
+ any bogus whitespace in the buffer.
warn-if-read-only give a warning if `cleanup' or `auto-cleanup'
is included in `whitespace-action' and the
diff --git a/lisp/winner.el b/lisp/winner.el
index 174b698e7b..c8354b18be 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -328,6 +328,14 @@ You may want to include buffer names such as *Help*,
*Apropos*,
map)
"Keymap for Winner mode.")
+(defvar-keymap winner-repeat-map
+ :doc "Keymap to repeat winner key sequences. Used in `repeat-mode'."
+ "<left>" #'winner-undo
+ "<right>" #'winner-redo)
+
+(put #'winner-undo 'repeat-map 'winner-repeat-map)
+(put #'winner-redo 'repeat-map 'winner-repeat-map)
+
;;;###autoload
(define-minor-mode winner-mode
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index ee80e41a22..058ab99f5c 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -675,7 +675,15 @@ with coordinates relative to the root window."
(defun x-dnd-get-drop-rectangle (window posn)
"Return the drag-and-drop rectangle at POSN on WINDOW."
(if (or dnd-scroll-margin
- (not (windowp window)))
+ (not (windowp window))
+ ;; Drops on the scroll bar aren't allowed, but the mouse
+ ;; rectangle can be set while still on the scroll bar,
+ ;; causing the drag initiator to never send an XdndPosition
+ ;; event that will an XdndStatus message with the accept
+ ;; flag set to be set, even after the mouse enters the
+ ;; window text area. To prevent that, simply don't generate
+ ;; a mouse rectangle when an area is set.
+ (posn-area posn))
'(0 0 0 0)
(let ((window-rectangle (x-dnd-get-window-rectangle window))
object-rectangle)
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index 41a1190c64..109748baec 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -1198,7 +1198,7 @@ Press
\\<xwidget-webkit-isearch-mode-map>\\[xwidget-webkit-isearch-exit] to exit
(xwidget-webkit-goto-history xwidget-webkit-history--session id))
(xwidget-webkit-history-reload))
-(defun xwidget-webkit-history-reload (&rest ignored)
+(defun xwidget-webkit-history-reload (&rest _ignored)
"Reload the current history buffer."
(interactive)
(setq tabulated-list-entries nil)
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/Makefile.in b/src/Makefile.in
index 1f941874ea..059e6c717b 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -426,25 +426,26 @@ ALL_CXX_CFLAGS = $(EMACS_CFLAGS) \
## lastfile must follow all files whose initialized data areas should
## be dumped as pure by dump-emacs.
-base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
- charset.o coding.o category.o ccl.o character.o chartab.o bidi.o \
- $(CM_OBJ) term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \
- emacs.o keyboard.o macros.o keymap.o sysdep.o \
- bignum.o buffer.o filelock.o insdel.o marker.o \
- minibuf.o fileio.o dired.o \
- cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \
- alloc.o pdumper.o data.o doc.o editfns.o callint.o \
- eval.o floatfns.o fns.o sort.o font.o print.o lread.o $(MODULES_OBJ) \
- syntax.o $(UNEXEC_OBJ) bytecode.o comp.o $(DYNLIB_OBJ) \
- process.o gnutls.o callproc.o \
- region-cache.o sound.o timefns.o atimer.o \
+base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o
\
+ charset.o coding.o category.o ccl.o character.o chartab.o bidi.o \
+ $(CM_OBJ) term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \
+ emacs.o keyboard.o macros.o keymap.o sysdep.o \
+ bignum.o buffer.o filelock.o insdel.o marker.o \
+ minibuf.o fileio.o dired.o \
+ cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \
+ alloc.o pdumper.o data.o doc.o editfns.o callint.o \
+ eval.o floatfns.o fns.o sort.o font.o print.o lread.o $(MODULES_OBJ) \
+ syntax.o $(UNEXEC_OBJ) bytecode.o comp.o $(DYNLIB_OBJ) \
+ process.o gnutls.o callproc.o \
+ region-cache.o sound.o timefns.o atimer.o \
doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
- $(XWIDGETS_OBJ) \
- profiler.o decompress.o \
- thread.o systhread.o sqlite.o \
- $(if $(HYBRID_MALLOC),sheap.o) \
- $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
- $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \
+ $(XWIDGETS_OBJ) \
+ profiler.o decompress.o \
+ thread.o systhread.o sqlite.o \
+ itree.o \
+ $(if $(HYBRID_MALLOC),sheap.o) \
+ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
+ $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \
$(HAIKU_OBJ) $(PGTK_OBJ)
doc_obj = $(base_obj) $(NS_OBJC_OBJ)
obj = $(doc_obj) $(HAIKU_CXX_OBJ)
@@ -498,7 +499,7 @@ all: ../native-lisp
endif
.PHONY: all
-dmpstruct_headers=$(srcdir)/lisp.h $(srcdir)/buffer.h \
+dmpstruct_headers=$(srcdir)/lisp.h $(srcdir)/buffer.h $(srcdir)/itree.h \
$(srcdir)/intervals.h $(srcdir)/charset.h $(srcdir)/bignum.h
ifeq ($(CHECK_STRUCTS),true)
pdumper.o: dmpstruct.h
diff --git a/src/alloc.c b/src/alloc.c
index 419c5e558b..f69c65dedc 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1,7 +1,6 @@
/* Storage allocation and gc for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2022 Free Software
-Foundation, Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -46,6 +45,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "blockinput.h"
#include "pdumper.h"
#include "termhooks.h" /* For struct terminal. */
+#include "itree.h"
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
@@ -3129,6 +3129,11 @@ cleanup_vector (struct Lisp_Vector *vector)
if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BIGNUM))
mpz_clear (PSEUDOVEC_STRUCT (vector, Lisp_Bignum)->value);
+ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_OVERLAY))
+ {
+ struct Lisp_Overlay *ol = PSEUDOVEC_STRUCT (vector, Lisp_Overlay);
+ xfree (ol->interval);
+ }
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FINALIZER))
unchain_finalizer (PSEUDOVEC_STRUCT (vector, Lisp_Finalizer));
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT))
@@ -3697,18 +3702,20 @@ build_symbol_with_pos (Lisp_Object symbol, Lisp_Object
position)
return val;
}
-/* Return a new overlay with specified START, END and PLIST. */
+/* Return a new (deleted) overlay with PLIST. */
Lisp_Object
-build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist)
+build_overlay (bool front_advance, bool rear_advance,
+ Lisp_Object plist)
{
struct Lisp_Overlay *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Overlay, plist,
PVEC_OVERLAY);
Lisp_Object overlay = make_lisp_ptr (p, Lisp_Vectorlike);
- OVERLAY_START (overlay) = start;
- OVERLAY_END (overlay) = end;
+ struct itree_node *node = xmalloc (sizeof (*node));
+ itree_node_init (node, front_advance, rear_advance, overlay);
+ p->interval = node;
+ p->buffer = NULL;
set_overlay_plist (overlay, plist);
- p->next = NULL;
return overlay;
}
@@ -5938,8 +5945,7 @@ visit_buffer_root (struct gc_root_visitor visitor,
/* Buffers that are roots don't have intervals, an undo list, or
other constructs that real buffers have. */
eassert (buffer->base_buffer == NULL);
- eassert (buffer->overlays_before == NULL);
- eassert (buffer->overlays_after == NULL);
+ eassert (buffer->overlays == NULL);
/* Visit the buffer-locals. */
visit_vectorlike_root (visitor, (struct Lisp_Vector *) buffer, type);
@@ -6273,6 +6279,11 @@ garbage_collect (void)
image_prune_animation_caches (false);
#endif
+ /* ELisp code run by `gc-post-hook' could result in itree iteration,
+ which must not happen while the itree is already busy. See
+ bug#58639. */
+ eassert (!itree_iterator_busy_p ());
+
if (!NILP (Vpost_gc_hook))
{
specpdl_ref gc_count = inhibit_garbage_collection ();
@@ -6495,16 +6506,25 @@ mark_char_table (struct Lisp_Vector *ptr, enum
pvec_type pvectype)
/* Mark the chain of overlays starting at PTR. */
static void
-mark_overlay (struct Lisp_Overlay *ptr)
+mark_overlay (struct Lisp_Overlay *ov)
{
- for (; ptr && !vectorlike_marked_p (&ptr->header); ptr = ptr->next)
- {
- set_vectorlike_marked (&ptr->header);
- /* These two are always markers and can be marked fast. */
- set_vectorlike_marked (&XMARKER (ptr->start)->header);
- set_vectorlike_marked (&XMARKER (ptr->end)->header);
- mark_object (ptr->plist);
- }
+ /* We don't mark the `interval_node` object, because it is managed manually
+ rather than by the GC. */
+ eassert (BASE_EQ (ov->interval->data, make_lisp_ptr (ov, Lisp_Vectorlike)));
+ set_vectorlike_marked (&ov->header);
+ mark_object (ov->plist);
+}
+
+/* Mark the overlay subtree rooted at NODE. */
+
+static void
+mark_overlays (struct itree_node *node)
+{
+ if (node == NULL)
+ return;
+ mark_object (node->data);
+ mark_overlays (node->left);
+ mark_overlays (node->right);
}
/* Mark Lisp_Objects and special pointers in BUFFER. */
@@ -6528,8 +6548,8 @@ mark_buffer (struct buffer *buffer)
if (!BUFFER_LIVE_P (buffer))
mark_object (BVAR (buffer, undo_list));
- mark_overlay (buffer->overlays_before);
- mark_overlay (buffer->overlays_after);
+ if (buffer->overlays)
+ mark_overlays (buffer->overlays->root);
/* If this is an indirect buffer, mark its base buffer. */
if (buffer->base_buffer &&
diff --git a/src/buffer.c b/src/buffer.c
index d4a0c37bed..b67b989326 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1,7 +1,6 @@
/* Buffer manipulation primitives for GNU Emacs.
-Copyright (C) 1985-1989, 1993-1995, 1997-2022 Free Software Foundation,
-Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -44,6 +43,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "keymap.h"
#include "frame.h"
#include "xwidget.h"
+#include "itree.h"
#include "pdumper.h"
#ifdef WINDOWSNT
@@ -116,7 +116,7 @@ static Lisp_Object QSFundamental; /* A string
"Fundamental". */
static void alloc_buffer_text (struct buffer *, ptrdiff_t);
static void free_buffer_text (struct buffer *b);
-static struct Lisp_Overlay * copy_overlays (struct buffer *, struct
Lisp_Overlay *);
+static void copy_overlays (struct buffer *, struct buffer *);
static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
static Lisp_Object buffer_local_variables_1 (struct buffer *buf, int offset,
Lisp_Object sym);
@@ -638,52 +638,33 @@ even if it is dead. The return value is never nil. */)
return buffer;
}
-
-/* Return a list of overlays which is a copy of the overlay list
- LIST, but for buffer B. */
-
-static struct Lisp_Overlay *
-copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
+static void
+add_buffer_overlay (struct buffer *b, struct Lisp_Overlay *ov,
+ ptrdiff_t begin, ptrdiff_t end)
{
- struct Lisp_Overlay *result = NULL, *tail = NULL;
-
- for (; list; list = list->next)
- {
- Lisp_Object overlay, start, end;
- struct Lisp_Marker *m;
-
- eassert (MARKERP (list->start));
- m = XMARKER (list->start);
- start = build_marker (b, m->charpos, m->bytepos);
- XMARKER (start)->insertion_type = m->insertion_type;
-
- eassert (MARKERP (list->end));
- m = XMARKER (list->end);
- end = build_marker (b, m->charpos, m->bytepos);
- XMARKER (end)->insertion_type = m->insertion_type;
-
- overlay = build_overlay (start, end, Fcopy_sequence (list->plist));
- if (tail)
- tail = tail->next = XOVERLAY (overlay);
- else
- result = tail = XOVERLAY (overlay);
- }
-
- return result;
+ eassert (! ov->buffer);
+ if (! b->overlays)
+ b->overlays = itree_create ();
+ ov->buffer = b;
+ itree_insert (b->overlays, ov->interval, begin, end);
}
-/* Set an appropriate overlay of B. */
+/* Copy overlays of buffer FROM to buffer TO. */
static void
-set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
+copy_overlays (struct buffer *from, struct buffer *to)
{
- b->overlays_before = o;
-}
+ eassert (to && ! to->overlays);
+ struct itree_node *node;
-static void
-set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
-{
- b->overlays_after = o;
+ ITREE_FOREACH (node, from->overlays, PTRDIFF_MIN, PTRDIFF_MAX, ASCENDING)
+ {
+ Lisp_Object ov = node->data;
+ Lisp_Object copy = build_overlay (node->front_advance,
+ node->rear_advance,
+ Fcopy_sequence (OVERLAY_PLIST (ov)));
+ add_buffer_overlay (to, XOVERLAY (copy), node->begin, node->end);
+ }
}
bool
@@ -726,8 +707,7 @@ clone_per_buffer_values (struct buffer *from, struct buffer
*to)
memcpy (to->local_flags, from->local_flags, sizeof to->local_flags);
- set_buffer_overlays_before (to, copy_overlays (to, from->overlays_before));
- set_buffer_overlays_after (to, copy_overlays (to, from->overlays_after));
+ copy_overlays (from, to);
/* Get (a copy of) the alist of Lisp-level local variables of FROM
and install that in TO. */
@@ -926,17 +906,25 @@ does not run the hooks `kill-buffer-hook',
return buf;
}
-/* Mark OV as no longer associated with B. */
+static void
+remove_buffer_overlay (struct buffer *b, struct Lisp_Overlay *ov)
+{
+ eassert (b->overlays);
+ eassert (ov->buffer == b);
+ itree_remove (ov->buffer->overlays, ov->interval);
+ ov->buffer = NULL;
+}
+
+/* Mark OV as no longer associated with its buffer. */
static void
-drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
+drop_overlay (struct Lisp_Overlay *ov)
{
- eassert (b == XBUFFER (Fmarker_buffer (ov->start)));
- modify_overlay (b, marker_position (ov->start),
- marker_position (ov->end));
- unchain_marker (XMARKER (ov->start));
- unchain_marker (XMARKER (ov->end));
+ if (! ov->buffer)
+ return;
+ modify_overlay (ov->buffer, overlay_start (ov), overlay_end (ov));
+ remove_buffer_overlay (ov->buffer, ov);
}
/* Delete all overlays of B and reset its overlay lists. */
@@ -944,26 +932,94 @@ drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
void
delete_all_overlays (struct buffer *b)
{
- struct Lisp_Overlay *ov, *next;
+ struct itree_node *node;
+
+ if (! b->overlays)
+ return;
- /* FIXME: Since each drop_overlay will scan BUF_MARKERS to unlink its
- markers, we have an unneeded O(N^2) behavior here. */
- for (ov = b->overlays_before; ov; ov = next)
+ /* FIXME: This loop sets the overlays' `buffer` field to NULL but
+ doesn't set the itree_nodes' `parent`, `left` and `right`
+ fields accordingly. I believe it's harmless, but a bit untidy since
+ other parts of the code are careful to set those fields to NULL when
+ the overlay is deleted.
+ Of course, we can't set them to NULL from within the iteration
+ because the iterator may need them (tho we could if we added
+ an ITREE_POST_ORDER iteration order). */
+ ITREE_FOREACH (node, b->overlays, PTRDIFF_MIN, PTRDIFF_MAX, ASCENDING)
{
- drop_overlay (b, ov);
- next = ov->next;
- ov->next = NULL;
+ modify_overlay (b, node->begin, node->end);
+ /* Where are the nodes freed ? --ap */
+ XOVERLAY (node->data)->buffer = NULL;
}
+ itree_clear (b->overlays);
+}
- for (ov = b->overlays_after; ov; ov = next)
+static void
+free_buffer_overlays (struct buffer *b)
+{
+ /* Actually this does not free any overlay, but the tree only. --ap */
+ if (b->overlays)
{
- drop_overlay (b, ov);
- next = ov->next;
- ov->next = NULL;
+ itree_destroy (b->overlays);
+ b->overlays = NULL;
}
+}
- set_buffer_overlays_before (b, NULL);
- set_buffer_overlays_after (b, NULL);
+/* Adjust the position of overlays in the current buffer according to
+ MULTIBYTE.
+
+ Assume that positions currently correspond to byte positions, if
+ MULTIBYTE is true and to character positions if not.
+*/
+
+static void
+set_overlays_multibyte (bool multibyte)
+{
+ if (! current_buffer->overlays || Z == Z_BYTE)
+ return;
+
+ struct itree_node **nodes = NULL;
+ struct itree_tree *tree = current_buffer->overlays;
+ const intmax_t size = itree_size (tree);
+
+ /* We can't use `interval_node_set_region` at the same time
+ as we iterate over the itree, so we need an auxiliary storage
+ to keep the list of nodes. */
+ USE_SAFE_ALLOCA;
+ SAFE_NALLOCA (nodes, 1, size);
+ {
+ struct itree_node *node, **cursor = nodes;
+ ITREE_FOREACH (node, tree, PTRDIFF_MIN, PTRDIFF_MAX, ASCENDING)
+ *(cursor++) = node;
+ }
+
+ for (int i = 0; i < size; ++i, ++nodes)
+ {
+ struct itree_node * const node = *nodes;
+
+ if (multibyte)
+ {
+ ptrdiff_t begin = itree_node_begin (tree, node);
+ ptrdiff_t end = itree_node_end (tree, node);
+
+ /* This models the behavior of markers. (The behavior of
+ text-intervals differs slightly.) */
+ while (begin < Z_BYTE
+ && !CHAR_HEAD_P (FETCH_BYTE (begin)))
+ begin++;
+ while (end < Z_BYTE
+ && !CHAR_HEAD_P (FETCH_BYTE (end)))
+ end++;
+ itree_node_set_region (tree, node, BYTE_TO_CHAR (begin),
+ BYTE_TO_CHAR (end));
+ }
+ else
+ {
+ itree_node_set_region (tree, node, CHAR_TO_BYTE (node->begin),
+ CHAR_TO_BYTE (node->end));
+ }
+ }
+ SAFE_FREE ();
}
/* Reinitialize everything about a buffer except its name and contents
@@ -993,9 +1049,7 @@ reset_buffer (register struct buffer *b)
b->auto_save_failure_time = 0;
bset_auto_save_file_name (b, Qnil);
bset_read_only (b, Qnil);
- set_buffer_overlays_before (b, NULL);
- set_buffer_overlays_after (b, NULL);
- b->overlay_center = BEG;
+ b->overlays = NULL;
bset_mark_active (b, Qnil);
bset_point_before_scroll (b, Qnil);
bset_file_format (b, Qnil);
@@ -1978,10 +2032,8 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
/* Perhaps we should explicitly free the interval tree here... */
}
- /* Since we've unlinked the markers, the overlays can't be here any more
- either. */
- set_buffer_overlays_before (b, NULL);
- set_buffer_overlays_after (b, NULL);
+ delete_all_overlays (b);
+ free_buffer_overlays (b);
/* Reset the local variables, so that this buffer's local values
won't be protected from GC. They would be protected
@@ -2381,6 +2433,23 @@ advance_to_char_boundary (ptrdiff_t byte_pos)
return byte_pos;
}
+static void
+swap_buffer_overlays (struct buffer *buffer, struct buffer *other)
+{
+ struct itree_node *node;
+
+ ITREE_FOREACH (node, buffer->overlays, PTRDIFF_MIN, PTRDIFF_MAX, ASCENDING)
+ XOVERLAY (node->data)->buffer = other;
+
+ ITREE_FOREACH (node, other->overlays, PTRDIFF_MIN, PTRDIFF_MAX, ASCENDING)
+ XOVERLAY (node->data)->buffer = buffer;
+
+ /* Swap the interval trees. */
+ void *tmp = buffer->overlays;
+ buffer->overlays = other->overlays;
+ other->overlays = tmp;
+}
+
DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
1, 1, 0,
doc: /* Swap the text between current buffer and BUFFER.
@@ -2452,9 +2521,6 @@ results, see Info node `(elisp)Swapping Text'. */)
current_buffer->prevent_redisplay_optimizations_p = 1;
other_buffer->prevent_redisplay_optimizations_p = 1;
swapfield (long_line_optimizations_p, bool_bf);
- swapfield (overlays_before, struct Lisp_Overlay *);
- swapfield (overlays_after, struct Lisp_Overlay *);
- swapfield (overlay_center, ptrdiff_t);
swapfield_ (undo_list, Lisp_Object);
swapfield_ (mark, Lisp_Object);
swapfield_ (mark_active, Lisp_Object); /* Belongs with the `mark'. */
@@ -2481,6 +2547,7 @@ results, see Info node `(elisp)Swapping Text'. */)
current_buffer->text->end_unchanged = current_buffer->text->gpt;
other_buffer->text->beg_unchanged = other_buffer->text->gpt;
other_buffer->text->end_unchanged = other_buffer->text->gpt;
+ swap_buffer_overlays (current_buffer, other_buffer);
{
struct Lisp_Marker *m;
for (m = BUF_MARKERS (current_buffer); m; m = m->next)
@@ -2597,7 +2664,8 @@ current buffer is cleared. */)
/* Do this first, so it can use CHAR_TO_BYTE
to calculate the old correspondences. */
- set_intervals_multibyte (0);
+ set_intervals_multibyte (false);
+ set_overlays_multibyte (false);
bset_enable_multibyte_characters (current_buffer, Qnil);
@@ -2784,7 +2852,8 @@ current buffer is cleared. */)
/* FIXME: Is it worth the trouble, really? Couldn't we just throw
away all the text-properties instead of trying to guess how
to adjust them? AFAICT the result is not reliable anyway. */
- set_intervals_multibyte (1);
+ set_intervals_multibyte (true);
+ set_overlays_multibyte (true);
}
if (!EQ (old_undo, Qt))
@@ -2867,272 +2936,159 @@ the normal hook `change-major-mode-hook'. */)
}
-/* Find all the overlays in the current buffer that contain position POS.
+/* Find all the overlays in the current buffer that overlap the range
+ [BEG, END).
+
+ If EMPTY is true, include empty overlays in that range and also at
+ END, provided END denotes the position at the end of the accessible
+ part of the buffer.
+
+ If TRAILING is true, include overlays that begin at END, provided
+ END denotes the position at the end of the accessible part of the
+ buffer.
+
Return the number found, and store them in a vector in *VEC_PTR.
Store in *LEN_PTR the size allocated for the vector.
Store in *NEXT_PTR the next position after POS where an overlay starts,
- or ZV if there are no more overlays between POS and ZV.
- Store in *PREV_PTR the previous position before POS where an overlay ends,
- or where an overlay starts which ends at or after POS;
- or BEGV if there are no such overlays from BEGV to POS.
- NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
+ or ZV if there are no more overlays.
+ NEXT_PTR may be 0, meaning don't store that info.
*VEC_PTR and *LEN_PTR should contain a valid vector and size
when this function is called.
- If EXTEND, make the vector bigger if necessary.
- If not, never extend the vector,
- and store only as many overlays as will fit.
+ If EXTEND, make the vector bigger if necessary. If not, never
+ extend the vector, and store only as many overlays as will fit.
But still return the total number of overlays.
-
- If CHANGE_REQ, any position written into *PREV_PTR or
- *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
- default (BEGV or ZV). */
+*/
ptrdiff_t
-overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr,
- ptrdiff_t *len_ptr,
- ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, bool change_req)
+overlays_in (ptrdiff_t beg, ptrdiff_t end, bool extend,
+ Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
+ bool empty, bool trailing,
+ ptrdiff_t *next_ptr)
{
ptrdiff_t idx = 0;
ptrdiff_t len = *len_ptr;
- Lisp_Object *vec = *vec_ptr;
ptrdiff_t next = ZV;
- ptrdiff_t prev = BEGV;
- bool inhibit_storing = 0;
-
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- Lisp_Object start = OVERLAY_START (overlay);
- Lisp_Object end = OVERLAY_END (overlay);
- ptrdiff_t endpos = OVERLAY_POSITION (end);
- if (endpos < pos)
- {
- if (prev < endpos)
- prev = endpos;
- break;
- }
- ptrdiff_t startpos = OVERLAY_POSITION (start);
- /* This one ends at or after POS
- so its start counts for PREV_PTR if it's before POS. */
- if (prev < startpos && startpos < pos)
- prev = startpos;
- if (endpos == pos)
- continue;
- if (startpos <= pos)
- {
- if (idx == len)
- {
- /* The supplied vector is full.
- Either make it bigger, or don't store any more in it. */
- if (extend)
- {
- vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
- sizeof *vec);
- *vec_ptr = vec;
- len = *len_ptr;
- }
- else
- inhibit_storing = 1;
- }
+ Lisp_Object *vec = *vec_ptr;
+ struct itree_node *node;
- if (!inhibit_storing)
- vec[idx] = overlay;
- /* Keep counting overlays even if we can't return them all. */
- idx++;
- }
- else if (startpos < next)
- next = startpos;
- }
+ /* Extend the search range if overlays beginning at ZV are
+ wanted. */
+ ptrdiff_t search_end = ZV;
+ if (end >= ZV && (empty || trailing))
+ ++search_end;
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
+ ITREE_FOREACH (node, current_buffer->overlays, beg, search_end,
+ ASCENDING)
{
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- Lisp_Object start = OVERLAY_START (overlay);
- Lisp_Object end = OVERLAY_END (overlay);
- ptrdiff_t startpos = OVERLAY_POSITION (start);
- if (pos < startpos)
- {
- if (startpos < next)
- next = startpos;
- break;
- }
- ptrdiff_t endpos = OVERLAY_POSITION (end);
- if (pos < endpos)
- {
- if (idx == len)
- {
- if (extend)
- {
- vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
- sizeof *vec);
- *vec_ptr = vec;
- len = *len_ptr;
- }
- else
- inhibit_storing = 1;
- }
+ if (node->begin > end)
+ {
+ next = min (next, node->begin);
+ ITREE_FOREACH_ABORT ();
+ break;
+ }
+ else if (node->begin == end)
+ {
+ next = node->begin;
+ if ((! empty || end < ZV) && beg < end)
+ {
+ ITREE_FOREACH_ABORT ();
+ break;
+ }
+ if (empty && node->begin != node->end)
+ continue;
+ }
- if (!inhibit_storing)
- vec[idx] = overlay;
- idx++;
+ if (! empty && node->begin == node->end)
+ continue;
- if (startpos < pos && startpos > prev)
- prev = startpos;
- }
- else if (endpos < pos && endpos > prev)
- prev = endpos;
- else if (endpos == pos && startpos > prev
- && (!change_req || startpos < pos))
- prev = startpos;
+ if (extend && idx == len)
+ {
+ vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
+ sizeof *vec);
+ *vec_ptr = vec;
+ len = *len_ptr;
+ }
+ if (idx < len)
+ vec[idx] = node->data;
+ /* Keep counting overlays even if we can't return them all. */
+ idx++;
}
-
if (next_ptr)
- *next_ptr = next;
- if (prev_ptr)
- *prev_ptr = prev;
+ *next_ptr = next ? next : ZV;
+
return idx;
}
-
-/* Find all the overlays in the current buffer that overlap the range
- BEG-END, or are empty at BEG, or are empty at END provided END
- denotes the position at the end of the current buffer.
- Return the number found, and store them in a vector in *VEC_PTR.
- Store in *LEN_PTR the size allocated for the vector.
- Store in *NEXT_PTR the next position after POS where an overlay starts,
- or ZV if there are no more overlays.
- Store in *PREV_PTR the previous position before POS where an overlay ends,
- or BEGV if there are no previous overlays.
- NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
+/* Find all non-empty overlays in the current buffer that contain
+ position POS.
- *VEC_PTR and *LEN_PTR should contain a valid vector and size
- when this function is called.
+ See overlays_in for the meaning of the arguments.
+ */
- If EXTEND, make the vector bigger if necessary.
- If not, never extend the vector,
- and store only as many overlays as will fit.
- But still return the total number of overlays. */
+ptrdiff_t
+overlays_at (ptrdiff_t pos, bool extend,
+ Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
+ ptrdiff_t *next_ptr)
+{
+ return overlays_in (pos, pos + 1, extend, vec_ptr, len_ptr,
+ false, true, next_ptr);
+}
-static ptrdiff_t
-overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
- Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
- ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr)
+ptrdiff_t
+next_overlay_change (ptrdiff_t pos)
{
- ptrdiff_t idx = 0;
- ptrdiff_t len = *len_ptr;
- Lisp_Object *vec = *vec_ptr;
ptrdiff_t next = ZV;
- ptrdiff_t prev = BEGV;
- bool inhibit_storing = 0;
- bool end_is_Z = end == ZV;
+ struct itree_node *node;
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
+ ITREE_FOREACH (node, current_buffer->overlays, pos, next, ASCENDING)
{
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- Lisp_Object ostart = OVERLAY_START (overlay);
- Lisp_Object oend = OVERLAY_END (overlay);
- ptrdiff_t endpos = OVERLAY_POSITION (oend);
- if (endpos < beg)
- {
- if (prev < endpos)
- prev = endpos;
- break;
- }
- ptrdiff_t startpos = OVERLAY_POSITION (ostart);
- /* Count an interval if it overlaps the range, is empty at the
- start of the range, or is empty at END provided END denotes the
- end of the buffer. */
- if ((beg < endpos && startpos < end)
- || (startpos == endpos
- && (beg == endpos || (end_is_Z && endpos == end))))
- {
- if (idx == len)
- {
- /* The supplied vector is full.
- Either make it bigger, or don't store any more in it. */
- if (extend)
- {
- vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
- sizeof *vec);
- *vec_ptr = vec;
- len = *len_ptr;
- }
- else
- inhibit_storing = 1;
- }
-
- if (!inhibit_storing)
- vec[idx] = overlay;
- /* Keep counting overlays even if we can't return them all. */
- idx++;
- }
- else if (startpos < next)
- next = startpos;
+ if (node->begin > pos)
+ {
+ /* If we reach this branch, node->begin must be the least upper bound
+ of pos, because the search is limited to [pos,next) . */
+ eassert (node->begin < next);
+ next = node->begin;
+ ITREE_FOREACH_ABORT ();
+ break;
+ }
+ else if (node->begin < node->end && node->end < next)
+ {
+ next = node->end;
+ ITREE_FOREACH_NARROW (pos, next);
+ }
}
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- Lisp_Object ostart = OVERLAY_START (overlay);
- Lisp_Object oend = OVERLAY_END (overlay);
- ptrdiff_t startpos = OVERLAY_POSITION (ostart);
- if (end < startpos)
- {
- if (startpos < next)
- next = startpos;
- break;
- }
- ptrdiff_t endpos = OVERLAY_POSITION (oend);
- /* Count an interval if it overlaps the range, is empty at the
- start of the range, or is empty at END provided END denotes the
- end of the buffer. */
- if ((beg < endpos && startpos < end)
- || (startpos == endpos
- && (beg == endpos || (end_is_Z && endpos == end))))
- {
- if (idx == len)
- {
- if (extend)
- {
- vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
- sizeof *vec);
- *vec_ptr = vec;
- len = *len_ptr;
- }
- else
- inhibit_storing = 1;
- }
+ return next;
+}
- if (!inhibit_storing)
- vec[idx] = overlay;
- idx++;
- }
- else if (endpos < beg && endpos > prev)
- prev = endpos;
+ptrdiff_t
+previous_overlay_change (ptrdiff_t pos)
+{
+ struct itree_node *node;
+ ptrdiff_t prev = BEGV;
+
+ ITREE_FOREACH (node, current_buffer->overlays, prev, pos, DESCENDING)
+ {
+ if (node->end < pos)
+ prev = node->end;
+ else
+ prev = max (prev, node->begin);
+ ITREE_FOREACH_NARROW (prev, pos);
}
- if (next_ptr)
- *next_ptr = next;
- if (prev_ptr)
- *prev_ptr = prev;
- return idx;
+ return prev;
}
-
/* Return true if there exists an overlay with a non-nil
`mouse-face' property overlapping OVERLAY. */
bool
mouse_face_overlay_overlaps (Lisp_Object overlay)
{
- ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
+ ptrdiff_t start = OVERLAY_START (overlay);
+ ptrdiff_t end = OVERLAY_END (overlay);
ptrdiff_t n, i, size;
Lisp_Object *v, tem;
Lisp_Object vbuf[10];
@@ -3140,11 +3096,11 @@ mouse_face_overlay_overlaps (Lisp_Object overlay)
size = ARRAYELTS (vbuf);
v = vbuf;
- n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
+ n = overlays_in (start, end, 0, &v, &size, true, false, NULL);
if (n > size)
{
SAFE_NALLOCA (v, 1, n);
- overlays_in (start, end, 0, &v, &n, NULL, NULL);
+ overlays_in (start, end, 0, &v, &n, true, false, NULL);
}
for (i = 0; i < n; ++i)
@@ -3169,11 +3125,11 @@ disable_line_numbers_overlay_at_eob (void)
size = ARRAYELTS (vbuf);
v = vbuf;
- n = overlays_in (ZV, ZV, 0, &v, &size, NULL, NULL);
+ n = overlays_in (ZV, ZV, 0, &v, &size, false, false, NULL);
if (n > size)
{
SAFE_NALLOCA (v, 1, n);
- overlays_in (ZV, ZV, 0, &v, &n, NULL, NULL);
+ overlays_in (ZV, ZV, 0, &v, &n, false, false, NULL);
}
for (i = 0; i < n; ++i)
@@ -3186,47 +3142,28 @@ disable_line_numbers_overlay_at_eob (void)
}
-/* Fast function to just test if we're at an overlay boundary. */
+/* Fast function to just test if we're at an overlay boundary.
+
+ Returns true if some overlay starts or ends (or both) at POS,
+*/
bool
overlay_touches_p (ptrdiff_t pos)
{
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
+ struct itree_node *node;
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- if (endpos < pos)
- break;
- if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
- return 1;
- }
-
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
-
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
- if (pos < startpos)
- break;
- if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
- return 1;
- }
- return 0;
+ /* We need to find overlays ending in pos, as well as empty ones at
+ pos. */
+ ITREE_FOREACH (node, current_buffer->overlays, pos - 1, pos + 1, DESCENDING)
+ if (node->begin == pos || node->end == pos)
+ {
+ ITREE_FOREACH_ABORT ();
+ return true;
+ }
+ return false;
}
-
-struct sortvec
-{
- Lisp_Object overlay;
- ptrdiff_t beg, end;
- EMACS_INT priority;
- EMACS_INT spriority; /* Secondary priority. */
-};
-static int
+
+int
compare_overlays (const void *v1, const void *v2)
{
const struct sortvec *s1 = v1;
@@ -3255,6 +3192,33 @@ compare_overlays (const void *v1, const void *v2)
return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1;
}
+void
+make_sortvec_item (struct sortvec *item, Lisp_Object overlay)
+{
+ Lisp_Object tem;
+ /* This overlay is good and counts: put it into sortvec. */
+ item->overlay = overlay;
+ item->beg = OVERLAY_START (overlay);
+ item->end = OVERLAY_END (overlay);
+ tem = Foverlay_get (overlay, Qpriority);
+ if (NILP (tem))
+ {
+ item->priority = 0;
+ item->spriority = 0;
+ }
+ else if (FIXNUMP (tem))
+ {
+ item->priority = XFIXNUM (tem);
+ item->spriority = 0;
+ }
+ else if (CONSP (tem))
+ {
+ Lisp_Object car = XCAR (tem);
+ Lisp_Object cdr = XCDR (tem);
+ item->priority = FIXNUMP (car) ? XFIXNUM (car) : 0;
+ item->spriority = FIXNUMP (cdr) ? XFIXNUM (cdr) : 0;
+ }
+}
/* Sort an array of overlays by priority. The array is modified in place.
The return value is the new size; this may be smaller than the original
size if some of the overlays were invalid or were window-specific. */
@@ -3271,47 +3235,18 @@ sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t
noverlays, struct window *w)
for (i = 0, j = 0; i < noverlays; i++)
{
- Lisp_Object tem;
Lisp_Object overlay;
overlay = overlay_vec[i];
if (OVERLAYP (overlay)
- && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
- && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
+ && OVERLAY_START (overlay) > 0
+ && OVERLAY_END (overlay) > 0)
{
- /* If we're interested in a specific window, then ignore
- overlays that are limited to some other window. */
- if (w)
- {
- Lisp_Object window;
-
- window = Foverlay_get (overlay, Qwindow);
- if (WINDOWP (window) && XWINDOW (window) != w)
- continue;
- }
-
- /* This overlay is good and counts: put it into sortvec. */
- sortvec[j].overlay = overlay;
- sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
- sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
- tem = Foverlay_get (overlay, Qpriority);
- if (NILP (tem))
- {
- sortvec[j].priority = 0;
- sortvec[j].spriority = 0;
- }
- else if (FIXNUMP (tem))
- {
- sortvec[j].priority = XFIXNUM (tem);
- sortvec[j].spriority = 0;
- }
- else if (CONSP (tem))
- {
- Lisp_Object car = XCAR (tem);
- Lisp_Object cdr = XCDR (tem);
- sortvec[j].priority = FIXNUMP (car) ? XFIXNUM (car) : 0;
- sortvec[j].spriority = FIXNUMP (cdr) ? XFIXNUM (cdr) : 0;
- }
+ /* If we're interested in a specific window, then ignore
+ overlays that are limited to some other window. */
+ if (w && ! overlay_matches_window (w, overlay))
+ continue;
+ make_sortvec_item (sortvec + j, overlay);
j++;
}
}
@@ -3426,25 +3361,27 @@ ptrdiff_t
overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
{
bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ struct itree_node *node;
overlay_heads.used = overlay_heads.bytes = 0;
overlay_tails.used = overlay_tails.bytes = 0;
- for (struct Lisp_Overlay *ov = current_buffer->overlays_before;
- ov; ov = ov->next)
+
+ ITREE_FOREACH (node, current_buffer->overlays, pos - 1, pos + 1, DESCENDING)
{
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
+ Lisp_Object overlay = node->data;
eassert (OVERLAYP (overlay));
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- if (endpos < pos)
- break;
+ ptrdiff_t startpos = node->begin;
+ ptrdiff_t endpos = node->end;
+
if (endpos != pos && startpos != pos)
continue;
Lisp_Object window = Foverlay_get (overlay, Qwindow);
if (WINDOWP (window) && XWINDOW (window) != w)
continue;
Lisp_Object str;
+ /* FIXME: Are we really sure that `record_overlay_string` can
+ never cause a non-local exit? */
if (startpos == pos
&& (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
record_overlay_string (&overlay_heads, str,
@@ -3459,36 +3396,7 @@ overlay_strings (ptrdiff_t pos, struct window *w,
unsigned char **pstr)
Foverlay_get (overlay, Qpriority),
endpos - startpos);
}
- for (struct Lisp_Overlay *ov = current_buffer->overlays_after;
- ov; ov = ov->next)
- {
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- if (startpos > pos)
- break;
- if (endpos != pos && startpos != pos)
- continue;
- Lisp_Object window = Foverlay_get (overlay, Qwindow);
- if (WINDOWP (window) && XWINDOW (window) != w)
- continue;
- Lisp_Object str;
- if (startpos == pos
- && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
- record_overlay_string (&overlay_heads, str,
- (startpos == endpos
- ? Foverlay_get (overlay, Qafter_string)
- : Qnil),
- Foverlay_get (overlay, Qpriority),
- endpos - startpos);
- else if (endpos == pos
- && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
- record_overlay_string (&overlay_tails, str, Qnil,
- Foverlay_get (overlay, Qpriority),
- endpos - startpos);
- }
if (overlay_tails.used > 1)
qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
cmp_for_strings);
@@ -3543,384 +3451,26 @@ overlay_strings (ptrdiff_t pos, struct window *w,
unsigned char **pstr)
}
return 0;
}
-
-/* Shift overlays in BUF's overlay lists, to center the lists at POS. */
-
-void
-recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
-{
- struct Lisp_Overlay *prev, *next;
-
- /* See if anything in overlays_before should move to overlays_after. */
-
- /* We don't strictly need prev in this loop; it should always be nil.
- But we use it for symmetry and in case that should cease to be true
- with some future change. */
- prev = NULL;
- for (struct Lisp_Overlay *tail = buf->overlays_before;
- tail; prev = tail, tail = next)
- {
- next = tail->next;
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
-
- Lisp_Object beg = OVERLAY_START (overlay);
- Lisp_Object end = OVERLAY_END (overlay);
-
- if (OVERLAY_POSITION (end) > pos)
- {
- /* OVERLAY needs to be moved. */
- ptrdiff_t where = OVERLAY_POSITION (beg);
- struct Lisp_Overlay *other, *other_prev;
-
- /* Splice the cons cell TAIL out of overlays_before. */
- if (prev)
- prev->next = next;
- else
- set_buffer_overlays_before (buf, next);
-
- /* Search thru overlays_after for where to put it. */
- other_prev = NULL;
- for (other = buf->overlays_after; other;
- other_prev = other, other = other->next)
- {
- Lisp_Object otheroverlay = make_lisp_ptr (other, Lisp_Vectorlike);
- eassert (OVERLAYP (otheroverlay));
-
- Lisp_Object otherbeg = OVERLAY_START (otheroverlay);
- if (OVERLAY_POSITION (otherbeg) >= where)
- break;
- }
-
- /* Add TAIL to overlays_after before OTHER. */
- tail->next = other;
- if (other_prev)
- other_prev->next = tail;
- else
- set_buffer_overlays_after (buf, tail);
- tail = prev;
- }
- else
- /* We've reached the things that should stay in overlays_before.
- All the rest of overlays_before must end even earlier,
- so stop now. */
- break;
- }
-
- /* See if anything in overlays_after should be in overlays_before. */
- prev = NULL;
- for (struct Lisp_Overlay *tail = buf->overlays_after;
- tail; prev = tail, tail = next)
- {
- next = tail->next;
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
-
- Lisp_Object beg = OVERLAY_START (overlay);
- Lisp_Object end = OVERLAY_END (overlay);
-
- /* Stop looking, when we know that nothing further
- can possibly end before POS. */
- if (OVERLAY_POSITION (beg) > pos)
- break;
-
- if (OVERLAY_POSITION (end) <= pos)
- {
- /* OVERLAY needs to be moved. */
- ptrdiff_t where = OVERLAY_POSITION (end);
- struct Lisp_Overlay *other, *other_prev;
-
- /* Splice the cons cell TAIL out of overlays_after. */
- if (prev)
- prev->next = next;
- else
- set_buffer_overlays_after (buf, next);
-
- /* Search thru overlays_before for where to put it. */
- other_prev = NULL;
- for (other = buf->overlays_before; other;
- other_prev = other, other = other->next)
- {
- Lisp_Object otheroverlay = make_lisp_ptr (other, Lisp_Vectorlike);
- eassert (OVERLAYP (otheroverlay));
-
- Lisp_Object otherend = OVERLAY_END (otheroverlay);
- if (OVERLAY_POSITION (otherend) <= where)
- break;
- }
-
- /* Add TAIL to overlays_before before OTHER. */
- tail->next = other;
- if (other_prev)
- other_prev->next = tail;
- else
- set_buffer_overlays_before (buf, tail);
- tail = prev;
- }
- }
-
- buf->overlay_center = pos;
-}
+
void
adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length)
{
/* After an insertion, the lists are still sorted properly,
but we may need to update the value of the overlay center. */
- if (current_buffer->overlay_center >= pos)
- current_buffer->overlay_center += length;
+ if (! current_buffer->overlays)
+ return;
+ itree_insert_gap (current_buffer->overlays, pos, length);
}
void
adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
{
- if (current_buffer->overlay_center < pos)
- /* The deletion was to our right. No change needed; the before- and
- after-lists are still consistent. */
- ;
- else if (current_buffer->overlay_center - pos > length)
- /* The deletion was to our left. We need to adjust the center value
- to account for the change in position, but the lists are consistent
- given the new value. */
- current_buffer->overlay_center -= length;
- else
- /* We're right in the middle. There might be things on the after-list
- that now belong on the before-list. Recentering will move them,
- and also update the center point. */
- recenter_overlay_lists (current_buffer, pos);
-}
-
-/* Fix up overlays that were garbled as a result of permuting markers
- in the range START through END. Any overlay with at least one
- endpoint in this range will need to be unlinked from the overlay
- list and reinserted in its proper place.
- Such an overlay might even have negative size at this point.
- If so, we'll make the overlay empty. */
-void
-fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
-{
- struct Lisp_Overlay *before_list UNINIT;
- struct Lisp_Overlay *after_list UNINIT;
- /* These are either nil, indicating that before_list or after_list
- should be assigned, or the cons cell the cdr of which should be
- assigned. */
- struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
- /* 'Parent', likewise, indicates a cons cell or
- current_buffer->overlays_before or overlays_after, depending
- which loop we're in. */
- struct Lisp_Overlay *parent;
-
- /* This algorithm shifts links around instead of consing and GCing.
- The loop invariant is that before_list (resp. after_list) is a
- well-formed list except that its last element, the CDR of beforep
- (resp. afterp) if beforep (afterp) isn't nil or before_list
- (after_list) if it is, is still uninitialized. So it's not a bug
- that before_list isn't initialized, although it may look
- strange. */
- parent = NULL;
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
-
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
-
- /* If the overlay is backwards, make it empty. */
- if (endpos < startpos)
- {
- startpos = endpos;
- Fset_marker (OVERLAY_START (overlay), make_fixnum (startpos),
- Qnil);
- }
-
- if (endpos < start)
- break;
-
- if (endpos < end
- || (startpos >= start && startpos < end))
- {
- /* Add it to the end of the wrong list. Later on,
- recenter_overlay_lists will move it to the right place. */
- if (endpos < current_buffer->overlay_center)
- {
- if (!afterp)
- after_list = tail;
- else
- afterp->next = tail;
- afterp = tail;
- }
- else
- {
- if (!beforep)
- before_list = tail;
- else
- beforep->next = tail;
- beforep = tail;
- }
- if (!parent)
- set_buffer_overlays_before (current_buffer, tail->next);
- else
- parent->next = tail->next;
- }
- else
- parent = tail;
- }
- parent = NULL;
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
-
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- /* If the overlay is backwards, make it empty. */
- if (endpos < startpos)
- {
- startpos = endpos;
- Fset_marker (OVERLAY_START (overlay), make_fixnum (startpos),
- Qnil);
- }
-
- if (startpos >= end)
- break;
-
- if (startpos >= start
- || (endpos >= start && endpos < end))
- {
- if (endpos < current_buffer->overlay_center)
- {
- if (!afterp)
- after_list = tail;
- else
- afterp->next = tail;
- afterp = tail;
- }
- else
- {
- if (!beforep)
- before_list = tail;
- else
- beforep->next = tail;
- beforep = tail;
- }
- if (!parent)
- set_buffer_overlays_after (current_buffer, tail->next);
- else
- parent->next = tail->next;
- }
- else
- parent = tail;
- }
-
- /* Splice the constructed (wrong) lists into the buffer's lists,
- and let the recenter function make it sane again. */
- if (beforep)
- {
- beforep->next = current_buffer->overlays_before;
- set_buffer_overlays_before (current_buffer, before_list);
- }
-
- if (afterp)
- {
- afterp->next = current_buffer->overlays_after;
- set_buffer_overlays_after (current_buffer, after_list);
- }
- recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
-}
-
-/* We have two types of overlay: the one whose ending marker is
- after-insertion-marker (this is the usual case) and the one whose
- ending marker is before-insertion-marker. When `overlays_before'
- contains overlays of the latter type and the former type in this
- order and both overlays end at inserting position, inserting a text
- increases only the ending marker of the latter type, which results
- in incorrect ordering of `overlays_before'.
-
- This function fixes ordering of overlays in the slot
- `overlays_before' of the buffer *BP. Before the insertion, `point'
- was at PREV, and now is at POS. */
-
-void
-fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
-{
- /* If parent is nil, replace overlays_before; otherwise, parent->next. */
- struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
- Lisp_Object tem;
- ptrdiff_t end UNINIT;
-
- /* After the insertion, the several overlays may be in incorrect
- order. The possibility is that, in the list `overlays_before',
- an overlay which ends at POS appears after an overlay which ends
- at PREV. Since POS is greater than PREV, we must fix the
- ordering of these overlays, by moving overlays ends at POS before
- the overlays ends at PREV. */
-
- /* At first, find a place where disordered overlays should be linked
- in. It is where an overlay which end before POS exists. (i.e. an
- overlay whose ending marker is after-insertion-marker if disorder
- exists). */
- while (tail
- && (tem = make_lisp_ptr (tail, Lisp_Vectorlike),
- (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
- {
- parent = tail;
- tail = tail->next;
- }
-
- /* If we don't find such an overlay,
- or the found one ends before PREV,
- or the found one is the last one in the list,
- we don't have to fix anything. */
- if (!tail)
- return;
- if (end < prev || !tail->next)
+ if (! current_buffer->overlays)
return;
-
- right_pair = parent;
- parent = tail;
- tail = tail->next;
-
- /* Now, end position of overlays in the list TAIL should be before
- or equal to PREV. In the loop, an overlay which ends at POS is
- moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
- we found an overlay which ends before PREV, the remaining
- overlays are in correct order. */
- while (tail)
- {
- tem = make_lisp_ptr (tail, Lisp_Vectorlike);
- end = OVERLAY_POSITION (OVERLAY_END (tem));
-
- if (end == pos)
- { /* This overlay is disordered. */
- struct Lisp_Overlay *found = tail;
-
- /* Unlink the found overlay. */
- tail = found->next;
- parent->next = tail;
- /* Move an overlay at RIGHT_PLACE to the next of the found one,
- and link it into the right place. */
- if (!right_pair)
- {
- found->next = bp->overlays_before;
- set_buffer_overlays_before (bp, found);
- }
- else
- {
- found->next = right_pair->next;
- right_pair->next = found;
- }
- }
- else if (end == prev)
- {
- parent = tail;
- tail = tail->next;
- }
- else /* No more disordered overlay. */
- break;
- }
+ itree_delete_gap (current_buffer->overlays, pos, length);
}
+
DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
doc: /* Return t if OBJECT is an overlay. */)
@@ -3942,7 +3492,7 @@ for the rear of the overlay advance when text is inserted
there
(Lisp_Object beg, Lisp_Object end, Lisp_Object buffer,
Lisp_Object front_advance, Lisp_Object rear_advance)
{
- Lisp_Object overlay;
+ Lisp_Object ov;
struct buffer *b;
if (NILP (buffer))
@@ -3950,6 +3500,10 @@ for the rear of the overlay advance when text is
inserted there
else
CHECK_BUFFER (buffer);
+ b = XBUFFER (buffer);
+ if (! BUFFER_LIVE_P (b))
+ error ("Attempt to create overlay in a dead buffer");
+
if (MARKERP (beg) && !BASE_EQ (Fmarker_buffer (beg), buffer))
signal_error ("Marker points into wrong buffer", beg);
if (MARKERP (end) && !BASE_EQ (Fmarker_buffer (end), buffer))
@@ -3964,39 +3518,16 @@ for the rear of the overlay advance when text is
inserted there
temp = beg; beg = end; end = temp;
}
- b = XBUFFER (buffer);
-
- beg = Fset_marker (Fmake_marker (), beg, buffer);
- end = Fset_marker (Fmake_marker (), end, buffer);
-
- if (!NILP (front_advance))
- XMARKER (beg)->insertion_type = 1;
- if (!NILP (rear_advance))
- XMARKER (end)->insertion_type = 1;
-
- overlay = build_overlay (beg, end, Qnil);
-
- /* Put the new overlay on the wrong list. */
- end = OVERLAY_END (overlay);
- if (OVERLAY_POSITION (end) < b->overlay_center)
- {
- eassert (b->overlays_after || (XOVERLAY (overlay)->next == NULL));
- XOVERLAY (overlay)->next = b->overlays_after;
- set_buffer_overlays_after (b, XOVERLAY (overlay));
- }
- else
- {
- eassert (b->overlays_before || (XOVERLAY (overlay)->next == NULL));
- XOVERLAY (overlay)->next = b->overlays_before;
- set_buffer_overlays_before (b, XOVERLAY (overlay));
- }
- /* This puts it in the right list, and in the right order. */
- recenter_overlay_lists (b, b->overlay_center);
+ ptrdiff_t obeg = clip_to_bounds (BUF_BEG (b), XFIXNUM (beg), BUF_Z (b));
+ ptrdiff_t oend = clip_to_bounds (obeg, XFIXNUM (end), BUF_Z (b));
+ ov = build_overlay (! NILP (front_advance),
+ ! NILP (rear_advance), Qnil);
+ add_buffer_overlay (b, XOVERLAY (ov), obeg, oend);
/* We don't need to redisplay the region covered by the overlay, because
the overlay has no properties at the moment. */
- return overlay;
+ return ov;
}
/* Mark a section of BUF as needing redisplay because of overlays changes. */
@@ -4018,35 +3549,6 @@ modify_overlay (struct buffer *buf, ptrdiff_t start,
ptrdiff_t end)
modiff_incr (&BUF_OVERLAY_MODIFF (buf), 1);
}
-/* Remove OVERLAY from LIST. */
-
-static struct Lisp_Overlay *
-unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay)
-{
- register struct Lisp_Overlay *tail, **prev = &list;
-
- for (tail = list; tail; prev = &tail->next, tail = *prev)
- if (tail == overlay)
- {
- *prev = overlay->next;
- overlay->next = NULL;
- break;
- }
- return list;
-}
-
-/* Remove OVERLAY from both overlay lists of B. */
-
-static void
-unchain_both (struct buffer *b, Lisp_Object overlay)
-{
- struct Lisp_Overlay *ov = XOVERLAY (overlay);
-
- set_buffer_overlays_before (b, unchain_overlay (b->overlays_before, ov));
- set_buffer_overlays_after (b, unchain_overlay (b->overlays_after, ov));
- eassert (XOVERLAY (overlay)->next == NULL);
-}
-
DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
@@ -4057,12 +3559,11 @@ buffer. */)
struct buffer *b, *ob = 0;
Lisp_Object obuffer;
specpdl_ref count = SPECPDL_INDEX ();
- ptrdiff_t n_beg, n_end;
ptrdiff_t o_beg UNINIT, o_end UNINIT;
CHECK_OVERLAY (overlay);
if (NILP (buffer))
- buffer = Fmarker_buffer (OVERLAY_START (overlay));
+ buffer = Foverlay_buffer (overlay);
if (NILP (buffer))
XSETBUFFER (buffer, current_buffer);
CHECK_BUFFER (buffer);
@@ -4084,37 +3585,31 @@ buffer. */)
temp = beg; beg = end; end = temp;
}
- specbind (Qinhibit_quit, Qt);
+ specbind (Qinhibit_quit, Qt); /* FIXME: Why? */
- obuffer = Fmarker_buffer (OVERLAY_START (overlay));
+ obuffer = Foverlay_buffer (overlay);
b = XBUFFER (buffer);
+ ptrdiff_t n_beg = clip_to_bounds (BUF_BEG (b), XFIXNUM (beg), BUF_Z (b));
+ ptrdiff_t n_end = clip_to_bounds (n_beg, XFIXNUM (end), BUF_Z (b));
+
if (!NILP (obuffer))
{
ob = XBUFFER (obuffer);
- o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
- o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
+ o_beg = OVERLAY_START (overlay);
+ o_end = OVERLAY_END (overlay);
+ }
- unchain_both (ob, overlay);
+ if (! EQ (buffer, obuffer))
+ {
+ if (! NILP (obuffer))
+ remove_buffer_overlay (XBUFFER (obuffer), XOVERLAY (overlay));
+ add_buffer_overlay (XBUFFER (buffer), XOVERLAY (overlay), n_beg, n_end);
}
else
- /* An overlay not associated with any buffer will normally have its
- `next' field set to NULL, but not always: when killing a buffer,
- we just set its overlays_after and overlays_before to NULL without
- manually setting each overlay's `next' field to NULL.
- Let's correct it here, to simplify subsequent assertions.
- FIXME: Maybe the better fix is to change `kill-buffer'!? */
- XOVERLAY (overlay)->next = NULL;
-
- eassert (XOVERLAY (overlay)->next == NULL);
-
- /* Set the overlay boundaries, which may clip them. */
- Fset_marker (OVERLAY_START (overlay), beg, buffer);
- Fset_marker (OVERLAY_END (overlay), end, buffer);
-
- n_beg = marker_position (OVERLAY_START (overlay));
- n_end = marker_position (OVERLAY_END (overlay));
+ itree_node_set_region (b->overlays, XOVERLAY (overlay)->interval,
+ n_beg, n_end);
/* If the overlay has changed buffers, do a thorough redisplay. */
if (!BASE_EQ (buffer, obuffer))
@@ -4137,8 +3632,6 @@ buffer. */)
modify_overlay (b, min (o_beg, n_beg), max (o_end, n_end));
}
- eassert (XOVERLAY (overlay)->next == NULL);
-
/* Delete the overlay if it is empty after clipping and has the
evaporate property. */
if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate)))
@@ -4148,26 +3641,10 @@ buffer. */)
contrary to `Fdelete_overlay's assumptions.
- Most of the work done by Fdelete_overlay has already been done
here for other reasons. */
- drop_overlay (XBUFFER (buffer), XOVERLAY (overlay));
+ drop_overlay (XOVERLAY (overlay));
return unbind_to (count, overlay);
}
- /* Put the overlay into the new buffer's overlay lists, first on the
- wrong list. */
- if (n_end < b->overlay_center)
- {
- XOVERLAY (overlay)->next = b->overlays_after;
- set_buffer_overlays_after (b, XOVERLAY (overlay));
- }
- else
- {
- XOVERLAY (overlay)->next = b->overlays_before;
- set_buffer_overlays_before (b, XOVERLAY (overlay));
- }
-
- /* This puts it in the right list, and in the right order. */
- recenter_overlay_lists (b, b->overlay_center);
-
return unbind_to (count, overlay);
}
@@ -4175,21 +3652,18 @@ DEFUN ("delete-overlay", Fdelete_overlay,
Sdelete_overlay, 1, 1, 0,
doc: /* Delete the overlay OVERLAY from its buffer. */)
(Lisp_Object overlay)
{
- Lisp_Object buffer;
struct buffer *b;
specpdl_ref count = SPECPDL_INDEX ();
CHECK_OVERLAY (overlay);
- buffer = Fmarker_buffer (OVERLAY_START (overlay));
- if (NILP (buffer))
+ b = OVERLAY_BUFFER (overlay);
+ if (! b)
return Qnil;
- b = XBUFFER (buffer);
specbind (Qinhibit_quit, Qt);
- unchain_both (b, overlay);
- drop_overlay (b, XOVERLAY (overlay));
+ drop_overlay (XOVERLAY (overlay));
/* When deleting an overlay with before or after strings, turn off
display optimizations for the affected buffer, on the basis that
@@ -4220,8 +3694,10 @@ DEFUN ("overlay-start", Foverlay_start, Soverlay_start,
1, 1, 0,
(Lisp_Object overlay)
{
CHECK_OVERLAY (overlay);
+ if (! OVERLAY_BUFFER (overlay))
+ return Qnil;
- return (Fmarker_position (OVERLAY_START (overlay)));
+ return make_fixnum (OVERLAY_START (overlay));
}
DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
@@ -4229,8 +3705,10 @@ DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1,
0,
(Lisp_Object overlay)
{
CHECK_OVERLAY (overlay);
+ if (! OVERLAY_BUFFER (overlay))
+ return Qnil;
- return (Fmarker_position (OVERLAY_END (overlay)));
+ return make_fixnum (OVERLAY_END (overlay));
}
DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
@@ -4238,9 +3716,16 @@ DEFUN ("overlay-buffer", Foverlay_buffer,
Soverlay_buffer, 1, 1, 0,
Return nil if OVERLAY has been deleted. */)
(Lisp_Object overlay)
{
+ Lisp_Object buffer;
+
CHECK_OVERLAY (overlay);
- return Fmarker_buffer (OVERLAY_START (overlay));
+ if (! OVERLAY_BUFFER (overlay))
+ return Qnil;
+
+ XSETBUFFER (buffer, OVERLAY_BUFFER (overlay));
+
+ return buffer;
}
DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
@@ -4251,7 +3736,7 @@ OVERLAY. */)
{
CHECK_OVERLAY (overlay);
- return Fcopy_sequence (XOVERLAY (overlay)->plist);
+ return Fcopy_sequence (OVERLAY_PLIST (overlay));
}
@@ -4279,8 +3764,7 @@ interest. */)
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len. */
- noverlays = overlays_at (XFIXNUM (pos), 1, &overlay_vec, &len,
- NULL, NULL, 0);
+ noverlays = overlays_at (XFIXNUM (pos), true, &overlay_vec, &len, NULL);
if (!NILP (sorted))
noverlays = sort_overlays (overlay_vec, noverlays,
@@ -4325,7 +3809,7 @@ end of the accessible part of the buffer. */)
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len. */
noverlays = overlays_in (XFIXNUM (beg), XFIXNUM (end), 1, &overlay_vec, &len,
- NULL, NULL);
+ true, false, NULL);
/* Make a list of them all. */
result = Flist (noverlays, overlay_vec);
@@ -4341,39 +3825,12 @@ If there are no overlay boundaries from POS to
(point-max),
the value is (point-max). */)
(Lisp_Object pos)
{
- ptrdiff_t i, len, noverlays;
- ptrdiff_t endpos;
- Lisp_Object *overlay_vec;
-
CHECK_FIXNUM_COERCE_MARKER (pos);
if (!buffer_has_overlays ())
return make_fixnum (ZV);
- len = 10;
- overlay_vec = xmalloc (len * sizeof *overlay_vec);
-
- /* Put all the overlays we want in a vector in overlay_vec.
- Store the length in len.
- endpos gets the position where the next overlay starts. */
- noverlays = overlays_at (XFIXNUM (pos), 1, &overlay_vec, &len,
- &endpos, 0, 1);
-
- /* If any of these overlays ends before endpos,
- use its ending point instead. */
- for (i = 0; i < noverlays; i++)
- {
- Lisp_Object oend;
- ptrdiff_t oendpos;
-
- oend = OVERLAY_END (overlay_vec[i]);
- oendpos = OVERLAY_POSITION (oend);
- if (oendpos < endpos)
- endpos = oendpos;
- }
-
- xfree (overlay_vec);
- return make_fixnum (endpos);
+ return make_fixnum (next_overlay_change (XFIXNUM (pos)));
}
DEFUN ("previous-overlay-change", Fprevious_overlay_change,
@@ -4383,32 +3840,15 @@ If there are no overlay boundaries from (point-min) to
POS,
the value is (point-min). */)
(Lisp_Object pos)
{
- ptrdiff_t prevpos;
- Lisp_Object *overlay_vec;
- ptrdiff_t len;
CHECK_FIXNUM_COERCE_MARKER (pos);
if (!buffer_has_overlays ())
return make_fixnum (BEGV);
- /* At beginning of buffer, we know the answer;
- avoid bug subtracting 1 below. */
- if (XFIXNUM (pos) == BEGV)
- return pos;
-
- len = 10;
- overlay_vec = xmalloc (len * sizeof *overlay_vec);
-
- /* Put all the overlays we want in a vector in overlay_vec.
- Store the length in len.
- prevpos gets the position of the previous change. */
- overlays_at (XFIXNUM (pos), 1, &overlay_vec, &len,
- 0, &prevpos, 1);
-
- xfree (overlay_vec);
- return make_fixnum (prevpos);
+ return make_fixnum (previous_overlay_change (XFIXNUM (pos)));
}
+
/* These functions are for debugging overlays. */
@@ -4418,19 +3858,16 @@ The car has all the overlays before the overlay center;
the cdr has all the overlays after the overlay center.
Recentering overlays moves overlays between these lists.
The lists you get are copies, so that changing them has no effect.
-However, the overlays you get are the real objects that the buffer uses. */)
+However, the overlays you get are the real objects that the buffer uses. */)
(void)
{
- Lisp_Object before = Qnil, after = Qnil;
+ Lisp_Object overlays = Qnil;
+ struct itree_node *node;
- for (struct Lisp_Overlay *ol = current_buffer->overlays_before;
- ol; ol = ol->next)
- before = Fcons (make_lisp_ptr (ol, Lisp_Vectorlike), before);
- for (struct Lisp_Overlay *ol = current_buffer->overlays_after;
- ol; ol = ol->next)
- after = Fcons (make_lisp_ptr (ol, Lisp_Vectorlike), after);
+ ITREE_FOREACH (node, current_buffer->overlays, BEG, Z, DESCENDING)
+ overlays = Fcons (node->data, overlays);
- return Fcons (Fnreverse (before), Fnreverse (after));
+ return Fcons (overlays, Qnil);
}
DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
@@ -4439,11 +3876,8 @@ That makes overlay lookup faster for positions near POS
(but perhaps slower
for positions far away from POS). */)
(Lisp_Object pos)
{
- ptrdiff_t p;
CHECK_FIXNUM_COERCE_MARKER (pos);
-
- p = clip_to_bounds (PTRDIFF_MIN, XFIXNUM (pos), PTRDIFF_MAX);
- recenter_overlay_lists (current_buffer, p);
+ /* Noop */
return Qnil;
}
@@ -4460,12 +3894,13 @@ DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3,
0,
VALUE will be returned.*/)
(Lisp_Object overlay, Lisp_Object prop, Lisp_Object value)
{
- Lisp_Object tail, buffer;
+ Lisp_Object tail;
+ struct buffer *b;
bool changed;
CHECK_OVERLAY (overlay);
- buffer = Fmarker_buffer (OVERLAY_START (overlay));
+ b = OVERLAY_BUFFER (overlay);
for (tail = XOVERLAY (overlay)->plist;
CONSP (tail) && CONSP (XCDR (tail));
@@ -4481,15 +3916,14 @@ VALUE will be returned.*/)
set_overlay_plist
(overlay, Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist)));
found:
- if (! NILP (buffer))
+ if (b)
{
if (changed)
- modify_overlay (XBUFFER (buffer),
- marker_position (OVERLAY_START (overlay)),
- marker_position (OVERLAY_END (overlay)));
+ modify_overlay (b, OVERLAY_START (overlay),
+ OVERLAY_END (overlay));
if (EQ (prop, Qevaporate) && ! NILP (value)
- && (OVERLAY_POSITION (OVERLAY_START (overlay))
- == OVERLAY_POSITION (OVERLAY_END (overlay))))
+ && (OVERLAY_START (overlay)
+ == OVERLAY_END (overlay)))
Fdelete_overlay (overlay);
}
@@ -4560,70 +3994,33 @@ report_overlay_modification (Lisp_Object start,
Lisp_Object end, bool after,
if (!after)
{
+ struct itree_node *node;
+ EMACS_INT begin_arg = XFIXNUM (start);
+ EMACS_INT end_arg = XFIXNUM (end);
/* We are being called before a change.
Scan the overlays to find the functions to call. */
last_overlay_modification_hooks_used = 0;
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- ptrdiff_t startpos, endpos;
- Lisp_Object ostart, oend;
-
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
-
- ostart = OVERLAY_START (overlay);
- oend = OVERLAY_END (overlay);
- endpos = OVERLAY_POSITION (oend);
- if (XFIXNAT (start) > endpos)
- break;
- startpos = OVERLAY_POSITION (ostart);
- if (insertion && (XFIXNAT (start) == startpos
- || XFIXNAT (end) == startpos))
- {
- Lisp_Object prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
- if (!NILP (prop))
- add_overlay_mod_hooklist (prop, overlay);
- }
- if (insertion && (XFIXNAT (start) == endpos
- || XFIXNAT (end) == endpos))
- {
- Lisp_Object prop = Foverlay_get (overlay, Qinsert_behind_hooks);
- if (!NILP (prop))
- add_overlay_mod_hooklist (prop, overlay);
- }
- /* Test for intersecting intervals. This does the right thing
- for both insertion and deletion. */
- if (XFIXNAT (end) > startpos && XFIXNAT (start) < endpos)
- {
- Lisp_Object prop = Foverlay_get (overlay, Qmodification_hooks);
- if (!NILP (prop))
- add_overlay_mod_hooklist (prop, overlay);
- }
- }
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
+ if (! current_buffer->overlays)
+ return;
+ ITREE_FOREACH (node, current_buffer->overlays,
+ begin_arg - (insertion ? 1 : 0),
+ end_arg + (insertion ? 1 : 0),
+ ASCENDING)
{
- ptrdiff_t startpos, endpos;
- Lisp_Object ostart, oend;
-
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
-
- ostart = OVERLAY_START (overlay);
- oend = OVERLAY_END (overlay);
- startpos = OVERLAY_POSITION (ostart);
- endpos = OVERLAY_POSITION (oend);
- if (XFIXNAT (end) < startpos)
- break;
- if (insertion && (XFIXNAT (start) == startpos
- || XFIXNAT (end) == startpos))
+ Lisp_Object overlay = node->data;
+ ptrdiff_t obegin = OVERLAY_START (overlay);
+ ptrdiff_t oend = OVERLAY_END (overlay);
+
+ if (insertion && (begin_arg == obegin
+ || end_arg == obegin))
{
Lisp_Object prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
if (!NILP (prop))
add_overlay_mod_hooklist (prop, overlay);
}
- if (insertion && (XFIXNAT (start) == endpos
- || XFIXNAT (end) == endpos))
+ if (insertion && (begin_arg == oend
+ || end_arg == oend))
{
Lisp_Object prop = Foverlay_get (overlay, Qinsert_behind_hooks);
if (!NILP (prop))
@@ -4631,7 +4028,7 @@ report_overlay_modification (Lisp_Object start,
Lisp_Object end, bool after,
}
/* Test for intersecting intervals. This does the right thing
for both insertion and deletion. */
- if (XFIXNAT (end) > startpos && XFIXNAT (start) < endpos)
+ if (! insertion || (end_arg > obegin && begin_arg < oend))
{
Lisp_Object prop = Foverlay_get (overlay, Qmodification_hooks);
if (!NILP (prop))
@@ -4639,7 +4036,6 @@ report_overlay_modification (Lisp_Object start,
Lisp_Object end, bool after,
}
}
}
-
{
/* Call the functions recorded in last_overlay_modification_hooks.
First copy the vector contents, in case some of these hooks
@@ -4662,7 +4058,7 @@ report_overlay_modification (Lisp_Object start,
Lisp_Object end, bool after,
(which makes its markers' buffers be nil), or that (due to
some bug) it belongs to a different buffer. Only run this
hook if the overlay belongs to the current buffer. */
- if (XMARKER (OVERLAY_START (overlay_i))->buffer == current_buffer)
+ if (OVERLAY_BUFFER (overlay_i) == current_buffer)
call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3);
}
@@ -4690,30 +4086,15 @@ void
evaporate_overlays (ptrdiff_t pos)
{
Lisp_Object hit_list = Qnil;
- if (pos <= current_buffer->overlay_center)
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- if (endpos < pos)
- break;
- if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
- && ! NILP (Foverlay_get (overlay, Qevaporate)))
- hit_list = Fcons (overlay, hit_list);
- }
- else
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
- if (startpos > pos)
- break;
- if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
- && ! NILP (Foverlay_get (overlay, Qevaporate)))
- hit_list = Fcons (overlay, hit_list);
- }
+ struct itree_node *node;
+
+ ITREE_FOREACH (node, current_buffer->overlays, pos, pos, ASCENDING)
+ {
+ if (node->end == pos
+ && ! NILP (Foverlay_get (node->data, Qevaporate)))
+ hit_list = Fcons (node->data, hit_list);
+ }
+
for (; CONSP (hit_list); hit_list = XCDR (hit_list))
Fdelete_overlay (XCAR (hit_list));
}
@@ -5339,9 +4720,7 @@ init_buffer_once (void)
bset_mark_active (&buffer_defaults, Qnil);
bset_file_format (&buffer_defaults, Qnil);
bset_auto_save_file_format (&buffer_defaults, Qt);
- set_buffer_overlays_before (&buffer_defaults, NULL);
- set_buffer_overlays_after (&buffer_defaults, NULL);
- buffer_defaults.overlay_center = BEG;
+ buffer_defaults.overlays = NULL;
XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8);
bset_truncate_lines (&buffer_defaults, Qnil);
@@ -5546,6 +4925,48 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd,
const char *namestring,
emacs_abort ();
}
+#ifdef ITREE_DEBUG
+static Lisp_Object
+make_lispy_itree_node (const struct itree_node *node)
+{
+ return listn (12,
+ intern (":begin"),
+ make_fixnum (node->begin),
+ intern (":end"),
+ make_fixnum (node->end),
+ intern (":limit"),
+ make_fixnum (node->limit),
+ intern (":offset"),
+ make_fixnum (node->offset),
+ intern (":rear-advance"),
+ node->rear_advance ? Qt : Qnil,
+ intern (":front-advance"),
+ node->front_advance ? Qt : Qnil);
+}
+
+static Lisp_Object
+overlay_tree (const struct itree_tree *tree,
+ const struct itree_node *node)
+{
+ if (node == ITREE_NULL)
+ return Qnil;
+ return list3 (make_lispy_itree_node (node),
+ overlay_tree (tree, node->left),
+ overlay_tree (tree, node->right));
+}
+
+DEFUN ("overlay-tree", Foverlay_tree, Soverlay_tree, 0, 1, 0,
+ doc: /* Get the overlay tree for BUFFER. */)
+ (Lisp_Object buffer)
+{
+ struct buffer *b = decode_buffer (buffer);
+ if (! b->overlays)
+ return Qnil;
+ return overlay_tree (b->overlays, b->overlays->root);
+}
+#endif
+
+
/* Initialize the buffer routines. */
void
@@ -6517,6 +5938,10 @@ There is no reason to change that value except for
debugging purposes. */);
DEFSYM (Qautosaved, "autosaved");
+#ifdef ITREE_DEBUG
+ defsubr (&Soverlay_tree);
+#endif
+
DEFSYM (Qkill_buffer__possibly_save, "kill-buffer--possibly-save");
DEFSYM (Qbuffer_stale_function, "buffer-stale-function");
diff --git a/src/buffer.h b/src/buffer.h
index cbdbae798b..3ea4125645 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -1,7 +1,6 @@
/* Header file for the buffer manipulation primitives.
-Copyright (C) 1985-1986, 1993-1995, 1997-2022 Free Software Foundation,
-Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -26,6 +25,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "character.h"
#include "lisp.h"
+#include "itree.h"
INLINE_HEADER_BEGIN
@@ -697,16 +697,8 @@ struct buffer
display optimizations must be used. */
bool_bf long_line_optimizations_p : 1;
- /* List of overlays that end at or before the current center,
- in order of end-position. */
- struct Lisp_Overlay *overlays_before;
-
- /* List of overlays that end after the current center,
- in order of start-position. */
- struct Lisp_Overlay *overlays_after;
-
- /* Position where the overlay lists are centered. */
- ptrdiff_t overlay_center;
+ /* The inveral tree containing this buffer's overlays. */
+ struct itree_tree *overlays;
/* Changes in the buffer are recorded here for undo, and t means
don't record anything. This information belongs to the base
@@ -716,6 +708,14 @@ struct buffer
Lisp_Object undo_list_;
};
+struct sortvec
+{
+ Lisp_Object overlay;
+ ptrdiff_t beg, end;
+ EMACS_INT priority;
+ EMACS_INT spriority; /* Secondary priority. */
+};
+
INLINE bool
BUFFERP (Lisp_Object a)
{
@@ -1171,8 +1171,11 @@ extern void delete_all_overlays (struct buffer *);
extern void reset_buffer (struct buffer *);
extern void compact_buffer (struct buffer *);
extern void evaporate_overlays (ptrdiff_t);
-extern ptrdiff_t overlays_at (EMACS_INT, bool, Lisp_Object **,
- ptrdiff_t *, ptrdiff_t *, ptrdiff_t *, bool);
+extern ptrdiff_t overlays_at (ptrdiff_t, bool, Lisp_Object **, ptrdiff_t *,
ptrdiff_t *);
+extern ptrdiff_t overlays_in (ptrdiff_t, ptrdiff_t, bool, Lisp_Object **,
+ ptrdiff_t *, bool, bool, ptrdiff_t *);
+extern ptrdiff_t previous_overlay_change (ptrdiff_t);
+extern ptrdiff_t next_overlay_change (ptrdiff_t);
extern ptrdiff_t sort_overlays (Lisp_Object *, ptrdiff_t, struct window *);
extern void recenter_overlay_lists (struct buffer *, ptrdiff_t);
extern ptrdiff_t overlay_strings (ptrdiff_t, struct window *, unsigned char
**);
@@ -1186,6 +1189,7 @@ extern void fix_overlays_before (struct buffer *,
ptrdiff_t, ptrdiff_t);
extern void mmap_set_vars (bool);
extern void restore_buffer (Lisp_Object);
extern void set_buffer_if_live (Lisp_Object);
+extern Lisp_Object build_overlay (bool, bool, Lisp_Object);
/* Return B as a struct buffer pointer, defaulting to the current buffer. */
@@ -1226,18 +1230,16 @@ record_unwind_current_buffer (void)
This macro might evaluate its args multiple times,
and it treat some args as lvalues. */
-#define GET_OVERLAYS_AT(posn, overlays, noverlays, nextp, chrq)
\
+#define GET_OVERLAYS_AT(posn, overlays, noverlays, next) \
do { \
ptrdiff_t maxlen = 40; \
SAFE_NALLOCA (overlays, 1, maxlen);
\
- (noverlays) = overlays_at (posn, false, &(overlays), &maxlen, \
- nextp, NULL, chrq); \
+ (noverlays) = overlays_at (posn, false, &(overlays), &maxlen, next); \
if ((noverlays) > maxlen) \
{
\
maxlen = noverlays; \
SAFE_NALLOCA (overlays, 1, maxlen); \
- (noverlays) = overlays_at (posn, false, &(overlays), &maxlen, \
- nextp, NULL, chrq); \
+ (noverlays) = overlays_at (posn, false, &(overlays), &maxlen, next); \
}
\
} while (false)
@@ -1272,7 +1274,8 @@ set_buffer_intervals (struct buffer *b, INTERVAL i)
INLINE bool
buffer_has_overlays (void)
{
- return current_buffer->overlays_before || current_buffer->overlays_after;
+ return current_buffer->overlays
+ && (current_buffer->overlays->root != NULL);
}
/* Functions for accessing a character or byte,
@@ -1390,25 +1393,69 @@ buffer_window_count (struct buffer *b)
/* Overlays */
-/* Return the marker that stands for where OV starts in the buffer. */
+INLINE ptrdiff_t
+overlay_start (struct Lisp_Overlay *ov)
+{
+ if (! ov->buffer)
+ return -1;
+ return itree_node_begin (ov->buffer->overlays, ov->interval);
+}
+
+INLINE ptrdiff_t
+overlay_end (struct Lisp_Overlay *ov)
+{
+ if (! ov->buffer)
+ return -1;
+ return itree_node_end (ov->buffer->overlays, ov->interval);
+}
-#define OVERLAY_START(OV) XOVERLAY (OV)->start
+/* Return the start of OV in its buffer, or -1 if OV is not associated
+ with any buffer. */
-/* Return the marker that stands for where OV ends in the buffer. */
+INLINE ptrdiff_t
+OVERLAY_START (Lisp_Object ov)
+{
+ return overlay_start (XOVERLAY (ov));
+}
-#define OVERLAY_END(OV) XOVERLAY (OV)->end
+/* Return the end of OV in its buffer, or -1. */
+
+INLINE ptrdiff_t
+OVERLAY_END (Lisp_Object ov)
+{
+ return overlay_end (XOVERLAY (ov));
+}
/* Return the plist of overlay OV. */
-#define OVERLAY_PLIST(OV) XOVERLAY (OV)->plist
+INLINE Lisp_Object
+OVERLAY_PLIST (Lisp_Object ov)
+{
+ return XOVERLAY (ov)->plist;
+}
-/* Return the actual buffer position for the marker P.
- We assume you know which buffer it's pointing into. */
+/* Return the buffer of overlay OV. */
-INLINE ptrdiff_t
-OVERLAY_POSITION (Lisp_Object p)
+INLINE struct buffer *
+OVERLAY_BUFFER (Lisp_Object ov)
{
- return marker_position (p);
+ return XOVERLAY (ov)->buffer;
+}
+
+/* Return true, if OV's rear-advance is set. */
+
+INLINE bool
+OVERLAY_REAR_ADVANCE_P (Lisp_Object ov)
+{
+ return XOVERLAY (ov)->interval->rear_advance;
+}
+
+/* Return true, if OV's front-advance is set. */
+
+INLINE bool
+OVERLAY_FRONT_ADVANCE_P (Lisp_Object ov)
+{
+ return XOVERLAY (ov)->interval->front_advance;
}
@@ -1692,4 +1739,7 @@ dec_both (ptrdiff_t *charpos, ptrdiff_t *bytepos)
INLINE_HEADER_END
+int compare_overlays (const void *v1, const void *v2);
+void make_sortvec_item (struct sortvec *item, Lisp_Object overlay);
+
#endif /* EMACS_BUFFER_H */
diff --git a/src/callproc.c b/src/callproc.c
index 2d457b3c84..4d4b86629c 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -39,7 +39,10 @@ extern char **environ;
&& (defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR \
|| defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR_NP) \
&& defined HAVE_DECL_POSIX_SPAWN_SETSID \
- && HAVE_DECL_POSIX_SPAWN_SETSID == 1
+ && HAVE_DECL_POSIX_SPAWN_SETSID == 1 \
+ /* posix_spawnattr_setflags rejects POSIX_SPAWN_SETSID on \
+ Haiku */ \
+ && !defined HAIKU
# include <spawn.h>
# define USABLE_POSIX_SPAWN 1
#else
@@ -1306,29 +1309,29 @@ emacs_posix_spawn_init_actions
(posix_spawn_file_actions_t *actions,
return error;
error = posix_spawn_file_actions_adddup2 (actions, std_in,
- STDIN_FILENO);
+ STDIN_FILENO);
if (error != 0)
goto out;
error = posix_spawn_file_actions_adddup2 (actions, std_out,
- STDOUT_FILENO);
+ STDOUT_FILENO);
if (error != 0)
goto out;
error = posix_spawn_file_actions_adddup2 (actions,
- std_err < 0 ? std_out
- : std_err,
- STDERR_FILENO);
+ std_err < 0 ? std_out
+ : std_err,
+ STDERR_FILENO);
if (error != 0)
goto out;
- error =
-#ifdef HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR
- posix_spawn_file_actions_addchdir
+ /* Haiku appears to have linkable posix_spawn_file_actions_chdir,
+ but it always fails. So use the _np function instead. */
+#if defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR && !defined HAIKU
+ error = posix_spawn_file_actions_addchdir (actions, cwd);
#else
- posix_spawn_file_actions_addchdir_np
+ error = posix_spawn_file_actions_addchdir_np (actions, cwd);
#endif
- (actions, cwd);
if (error != 0)
goto out;
@@ -1347,9 +1350,9 @@ emacs_posix_spawn_init_attributes (posix_spawnattr_t
*attributes,
return error;
error = posix_spawnattr_setflags (attributes,
- POSIX_SPAWN_SETSID
- | POSIX_SPAWN_SETSIGDEF
- | POSIX_SPAWN_SETSIGMASK);
+ POSIX_SPAWN_SETSID
+ | POSIX_SPAWN_SETSIGDEF
+ | POSIX_SPAWN_SETSIGMASK);
if (error != 0)
goto out;
diff --git a/src/editfns.c b/src/editfns.c
index 3f9618edb0..17dca4708e 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -1,6 +1,6 @@
/* Lisp functions pertaining to editing. -*- coding: utf-8 -*-
-Copyright (C) 1985-1987, 1989, 1993-2022 Free Software Foundation, Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -265,51 +265,20 @@ If you set the marker not to point anywhere, the buffer
will have no mark. */)
/* Find all the overlays in the current buffer that touch position POS.
Return the number found, and store them in a vector in VEC
- of length LEN. */
+ of length LEN.
+
+ Note: this can return overlays that do not touch POS. The caller
+ should filter these out. */
static ptrdiff_t
-overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len)
+overlays_around (ptrdiff_t pos, Lisp_Object *vec, ptrdiff_t len)
{
- ptrdiff_t idx = 0;
-
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- Lisp_Object end = OVERLAY_END (overlay);
- ptrdiff_t endpos = OVERLAY_POSITION (end);
- if (endpos < pos)
- break;
- Lisp_Object start = OVERLAY_START (overlay);
- ptrdiff_t startpos = OVERLAY_POSITION (start);
- if (startpos <= pos)
- {
- if (idx < len)
- vec[idx] = overlay;
- /* Keep counting overlays even if we can't return them all. */
- idx++;
- }
- }
-
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- Lisp_Object start = OVERLAY_START (overlay);
- ptrdiff_t startpos = OVERLAY_POSITION (start);
- if (pos < startpos)
- break;
- Lisp_Object end = OVERLAY_END (overlay);
- ptrdiff_t endpos = OVERLAY_POSITION (end);
- if (pos <= endpos)
- {
- if (idx < len)
- vec[idx] = overlay;
- idx++;
- }
- }
-
- return idx;
+ /* Find all potentially rear-advance overlays at (POS - 1). Find
+ all overlays at POS, so end at (POS + 1). Find even empty
+ overlays, which due to the way 'overlays-in' works implies that
+ we might also fetch empty overlays starting at (POS + 1). */
+ return overlays_in (pos - 1, pos + 1, false, &vec, &len,
+ true, false, NULL);
}
DEFUN ("get-pos-property", Fget_pos_property, Sget_pos_property, 2, 3, 0,
@@ -369,11 +338,12 @@ at POSITION. */)
if (!NILP (tem))
{
/* Check the overlay is indeed active at point. */
- Lisp_Object start = OVERLAY_START (ol), finish = OVERLAY_END (ol);
- if ((OVERLAY_POSITION (start) == posn
- && XMARKER (start)->insertion_type == 1)
- || (OVERLAY_POSITION (finish) == posn
- && XMARKER (finish)->insertion_type == 0))
+ if ((OVERLAY_START (ol) == posn
+ && OVERLAY_FRONT_ADVANCE_P (ol))
+ || (OVERLAY_END (ol) == posn
+ && ! OVERLAY_REAR_ADVANCE_P (ol))
+ || OVERLAY_START (ol) > posn
+ || OVERLAY_END (ol) < posn)
; /* The overlay will not cover a char inserted at point. */
else
{
@@ -4526,7 +4496,6 @@ ring. */)
transpose_markers (start1, end1, start2, end2,
start1_byte, start1_byte + len1_byte,
start2_byte, start2_byte + len2_byte);
- fix_start_end_in_overlays (start1, end2);
}
else
{
diff --git a/src/emacs.c b/src/emacs.c
index 43e81b912c..8ad70fecd4 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2564,6 +2564,7 @@ static const struct standard_args standard_args[] =
{ "-init-directory", "--init-directory", 30, 1 },
{ "-no-x-resources", "--no-x-resources", 40, 0 },
{ "-no-site-file", "--no-site-file", 40, 0 },
+ { "-no-comp-spawn", "--no-comp-spawn", 60, 0 },
{ "-u", "--user", 30, 1 },
{ "-user", 0, 30, 1 },
{ "-debug-init", "--debug-init", 20, 0 },
diff --git a/src/eval.c b/src/eval.c
index 8810136c04..ea23829948 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -484,8 +484,7 @@ usage: (setq [SYM VAL]...) */)
/* Like for eval_sub, we do not check declared_special here since
it's been done when let-binding. */
Lisp_Object lex_binding
- = ((!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
- && SYMBOLP (sym))
+ = (SYMBOLP (sym)
? Fassq (sym, Vinternal_interpreter_environment)
: Qnil);
if (!NILP (lex_binding))
@@ -551,8 +550,12 @@ usage: (function ARG) */)
CHECK_STRING (docstring);
cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr))));
}
- return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment,
- cdr));
+ if (NILP (Vinternal_make_interpreted_closure_function))
+ return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment,
cdr));
+ else
+ return call2 (Vinternal_make_interpreted_closure_function,
+ Fcons (Qlambda, cdr),
+ Vinternal_interpreter_environment);
}
else
/* Simply quote the argument. */
@@ -1713,6 +1716,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object
data, bool keyboard_quit)
Lisp_Object clause = Qnil;
struct handler *h;
+ eassert (!itree_iterator_busy_p ());
if (gc_in_progress || waiting_for_input)
emacs_abort ();
@@ -2374,9 +2378,7 @@ eval_sub (Lisp_Object form)
We do not pay attention to the declared_special flag here, since we
already did that when let-binding the variable. */
Lisp_Object lex_binding
- = (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
- ? Fassq (form, Vinternal_interpreter_environment)
- : Qnil);
+ = Fassq (form, Vinternal_interpreter_environment);
return !NILP (lex_binding) ? XCDR (lex_binding) : Fsymbol_value (form);
}
@@ -2392,7 +2394,7 @@ eval_sub (Lisp_Object form)
if (max_lisp_eval_depth < 100)
max_lisp_eval_depth = 100;
if (lisp_eval_depth > max_lisp_eval_depth)
- xsignal0 (Qexcessive_lisp_nesting);
+ xsignal1 (Qexcessive_lisp_nesting, make_fixnum (lisp_eval_depth));
}
Lisp_Object original_fun = XCAR (form);
@@ -2433,7 +2435,9 @@ eval_sub (Lisp_Object form)
else if (XSUBR (fun)->max_args == UNEVALLED)
val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
- else if (XSUBR (fun)->max_args == MANY)
+ else if (XSUBR (fun)->max_args == MANY
+ || XSUBR (fun)->max_args > 8)
+
{
/* Pass a vector of evaluated arguments. */
Lisp_Object *vals;
@@ -2966,7 +2970,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
if (max_lisp_eval_depth < 100)
max_lisp_eval_depth = 100;
if (lisp_eval_depth > max_lisp_eval_depth)
- xsignal0 (Qexcessive_lisp_nesting);
+ xsignal1 (Qexcessive_lisp_nesting, make_fixnum (lisp_eval_depth));
}
count = record_in_backtrace (args[0], &args[1], nargs - 1);
@@ -2996,7 +3000,8 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs,
Lisp_Object *args)
if (numargs >= subr->min_args)
{
/* Conforming call to finite-arity subr. */
- if (numargs <= subr->max_args)
+ if (numargs <= subr->max_args
+ && subr->max_args <= 8)
{
Lisp_Object argbuf[8];
Lisp_Object *a;
@@ -3032,15 +3037,13 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t
numargs, Lisp_Object *args)
return subr->function.a8 (a[0], a[1], a[2], a[3], a[4], a[5],
a[6], a[7]);
default:
- /* If a subr takes more than 8 arguments without using MANY
- or UNEVALLED, we need to extend this function to support it.
- Until this is done, there is no way to call the function. */
- emacs_abort ();
+ emacs_abort (); /* Can't happen. */
}
}
/* Call to n-adic subr. */
- if (subr->max_args == MANY)
+ if (subr->max_args == MANY
+ || subr->max_args > 8)
return subr->function.aMANY (numargs, args);
}
@@ -4357,6 +4360,11 @@ alist of active lexical bindings. */);
(Just imagine if someone makes it buffer-local). */
Funintern (Qinternal_interpreter_environment, Qnil);
+ DEFVAR_LISP ("internal-make-interpreted-closure-function",
+ Vinternal_make_interpreted_closure_function,
+ doc: /* Function to filter the env when constructing a closure.
*/);
+ Vinternal_make_interpreted_closure_function = Qnil;
+
Vrun_hooks = intern_c_string ("run-hooks");
staticpro (&Vrun_hooks);
diff --git a/src/fileio.c b/src/fileio.c
index 8f96e973b2..92335b639c 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -4167,8 +4167,7 @@ by calling `format-decode', which see. */)
bset_read_only (buf, Qnil);
bset_filename (buf, Qnil);
bset_undo_list (buf, Qt);
- eassert (buf->overlays_before == NULL);
- eassert (buf->overlays_after == NULL);
+ eassert (buf->overlays == NULL);
set_buffer_internal (buf);
Ferase_buffer ();
diff --git a/src/fns.c b/src/fns.c
index 4055792382..035fa12935 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1,7 +1,6 @@
/* Random utility Lisp functions.
-Copyright (C) 1985-1987, 1993-1995, 1997-2022 Free Software Foundation,
-Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -2473,15 +2472,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);
}
@@ -2489,7 +2488,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)
{
@@ -2498,7 +2497,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);
}
@@ -2532,15 +2531,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;
@@ -2558,6 +2557,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)
{
@@ -2567,7 +2567,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;
@@ -2595,6 +2595,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.
@@ -2751,10 +2796,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum
equal_kind equal_kind,
return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0;
if (OVERLAYP (o1))
{
- if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
- equal_kind, depth + 1, ht)
- || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2),
- equal_kind, depth + 1, ht))
+ if (OVERLAY_BUFFER (o1) != OVERLAY_BUFFER (o2)
+ || OVERLAY_START (o1) != OVERLAY_START (o2)
+ || OVERLAY_END (o1) != OVERLAY_END (o2))
return false;
o1 = XOVERLAY (o1)->plist;
o2 = XOVERLAY (o2)->plist;
@@ -3388,43 +3432,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'. */)
@@ -3652,7 +3659,7 @@ static signed char const
base64_char_to_value[2][UCHAR_MAX] =
static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool,
bool, bool);
static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool,
- bool, ptrdiff_t *);
+ bool, bool, ptrdiff_t *);
static Lisp_Object base64_encode_region_1 (Lisp_Object, Lisp_Object, bool,
bool, bool);
@@ -3915,7 +3922,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t
length,
DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region,
- 2, 3, "r",
+ 2, 4, "r",
doc: /* Base64-decode the region between BEG and END.
Return the length of the decoded data.
@@ -3926,8 +3933,11 @@ system.
If the region can't be decoded, signal an error and don't modify the buffer.
Optional third argument BASE64URL determines whether to use the URL variant
-of the base 64 encoding, as defined in RFC 4648. */)
- (Lisp_Object beg, Lisp_Object end, Lisp_Object base64url)
+of the base 64 encoding, as defined in RFC 4648.
+If optional fourth argument INGORE-INVALID is non-nil invalid characters
+are ignored instead of signaling an error. */)
+ (Lisp_Object beg, Lisp_Object end, Lisp_Object base64url,
+ Lisp_Object ignore_invalid)
{
ptrdiff_t ibeg, iend, length, allength;
char *decoded;
@@ -3953,7 +3963,8 @@ of the base 64 encoding, as defined in RFC 4648. */)
move_gap_both (XFIXNAT (beg), ibeg);
decoded_length = base64_decode_1 ((char *) BYTE_POS_ADDR (ibeg),
decoded, length, !NILP (base64url),
- multibyte, &inserted_chars);
+ multibyte, !NILP (ignore_invalid),
+ &inserted_chars);
if (decoded_length > allength)
emacs_abort ();
@@ -3986,11 +3997,13 @@ of the base 64 encoding, as defined in RFC 4648. */)
}
DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
- 1, 2, 0,
+ 1, 3, 0,
doc: /* Base64-decode STRING and return the result as a string.
Optional argument BASE64URL determines whether to use the URL variant of
-the base 64 encoding, as defined in RFC 4648. */)
- (Lisp_Object string, Lisp_Object base64url)
+the base 64 encoding, as defined in RFC 4648.
+If optional third argument IGNORE-INVALID is non-nil invalid characters are
+ignored instead of signaling an error. */)
+ (Lisp_Object string, Lisp_Object base64url, Lisp_Object ignore_invalid)
{
char *decoded;
ptrdiff_t length, decoded_length;
@@ -4006,7 +4019,8 @@ the base 64 encoding, as defined in RFC 4648. */)
/* The decoded result should be unibyte. */
ptrdiff_t decoded_chars;
decoded_length = base64_decode_1 (SSDATA (string), decoded, length,
- !NILP (base64url), 0, &decoded_chars);
+ !NILP (base64url), false,
+ !NILP (ignore_invalid), &decoded_chars);
if (decoded_length > length)
emacs_abort ();
else if (decoded_length >= 0)
@@ -4023,12 +4037,13 @@ the base 64 encoding, as defined in RFC 4648. */)
/* Base64-decode the data at FROM of LENGTH bytes into TO. If
MULTIBYTE, the decoded result should be in multibyte
- form. Store the number of produced characters in *NCHARS_RETURN. */
+ form. If IGNORE_INVALID, ignore invalid base64 characters.
+ Store the number of produced characters in *NCHARS_RETURN. */
static ptrdiff_t
base64_decode_1 (const char *from, char *to, ptrdiff_t length,
- bool base64url,
- bool multibyte, ptrdiff_t *nchars_return)
+ bool base64url, bool multibyte, bool ignore_invalid,
+ ptrdiff_t *nchars_return)
{
char const *f = from;
char const *flim = from + length;
@@ -4054,7 +4069,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
c = *f++;
v1 = b64_char_to_value[c];
}
- while (v1 < 0);
+ while (v1 < 0 || (v1 == 0 && ignore_invalid));
if (v1 == 0)
return -1;
@@ -4069,7 +4084,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
c = *f++;
v1 = b64_char_to_value[c];
}
- while (v1 < 0);
+ while (v1 < 0 || (v1 == 0 && ignore_invalid));
if (v1 == 0)
return -1;
@@ -4088,7 +4103,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
{
if (f == flim)
{
- if (!base64url)
+ if (!base64url && !ignore_invalid)
return -1;
*nchars_return = nchars;
return e - to;
@@ -4096,7 +4111,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
c = *f++;
v1 = b64_char_to_value[c];
}
- while (v1 < 0);
+ while (v1 < 0 || (v1 == 0 && ignore_invalid));
if (c == '=')
{
@@ -4130,7 +4145,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
{
if (f == flim)
{
- if (!base64url)
+ if (!base64url && !ignore_invalid)
return -1;
*nchars_return = nchars;
return e - to;
@@ -4138,7 +4153,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
c = *f++;
v1 = b64_char_to_value[c];
}
- while (v1 < 0);
+ while (v1 < 0 || (v1 == 0 && ignore_invalid));
if (c == '=')
continue;
@@ -5077,6 +5092,7 @@ sxhash_obj (Lisp_Object obj, int depth)
? 42
: sxhash_vector (obj, depth));
}
+ /* FIXME: Use `switch`. */
else if (pvec_type == PVEC_BIGNUM)
return sxhash_bignum (obj);
else if (pvec_type == PVEC_MARKER)
@@ -5091,8 +5107,8 @@ sxhash_obj (Lisp_Object obj, int depth)
return sxhash_bool_vector (obj);
else if (pvec_type == PVEC_OVERLAY)
{
- EMACS_UINT hash = sxhash_obj (OVERLAY_START (obj), depth);
- hash = sxhash_combine (hash, sxhash_obj (OVERLAY_END (obj), depth));
+ EMACS_UINT hash = OVERLAY_START (obj);
+ hash = sxhash_combine (hash, OVERLAY_END (obj));
hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist,
depth));
return SXHASH_REDUCE (hash);
}
diff --git a/src/indent.c b/src/indent.c
index aa905f387b..4671ccccf9 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -224,9 +224,6 @@ skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p,
ptrdiff_t to, Lisp_Ob
XSETFASTINT (position, pos);
XSETBUFFER (buffer, current_buffer);
- /* Give faster response for overlay lookup near POS. */
- recenter_overlay_lists (current_buffer, pos);
-
/* We must not advance farther than the next overlay change.
The overlay change might change the invisible property;
or there might be overlay strings to be displayed there. */
@@ -518,7 +515,7 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col,
ptrdiff_t *endpos)
{
ptrdiff_t start;
if (OVERLAYP (overlay))
- *endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
+ *endpos = OVERLAY_END (overlay);
else
get_property_and_range (pos, Qdisplay, &val, &start, endpos, Qnil);
@@ -637,6 +634,11 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol,
scan_byte = CHAR_TO_BYTE (scan);
if (scan >= end)
goto endloop;
+ /* We may have over-stepped cmp_it.stop_pos while skipping
+ the invisible text. If so, update cmp_it.stop_pos. */
+ if (scan > cmp_it.stop_pos && cmp_it.id < 0)
+ composition_reseat_it (&cmp_it, scan, scan_byte, end,
+ w, -1, NULL, Qnil);
}
/* Test reaching the goal column. We do this after skipping
@@ -1358,6 +1360,9 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
pos = newpos;
pos_byte = CHAR_TO_BYTE (pos);
}
+ if (newpos > cmp_it.stop_pos && cmp_it.id < 0)
+ composition_reseat_it (&cmp_it, pos, pos_byte, to,
+ win, -1, NULL, Qnil);
rarely_quit (++quit_count);
}
diff --git a/src/insdel.c b/src/insdel.c
index 38d5fbda00..6d56a76c77 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -284,7 +284,6 @@ adjust_markers_for_insert (ptrdiff_t from, ptrdiff_t
from_byte,
ptrdiff_t to, ptrdiff_t to_byte, bool before_markers)
{
struct Lisp_Marker *m;
- bool adjusted = 0;
ptrdiff_t nchars = to - from;
ptrdiff_t nbytes = to_byte - from_byte;
@@ -300,8 +299,6 @@ adjust_markers_for_insert (ptrdiff_t from, ptrdiff_t
from_byte,
{
m->bytepos = to_byte;
m->charpos = to;
- if (m->insertion_type)
- adjusted = 1;
}
}
else if (m->bytepos > from_byte)
@@ -310,15 +307,6 @@ adjust_markers_for_insert (ptrdiff_t from, ptrdiff_t
from_byte,
m->charpos += nchars;
}
}
-
- /* Adjusting only markers whose insertion-type is t may result in
- - disordered start and end in overlays, and
- - disordered overlays in the slot `overlays_before' of current_buffer. */
- if (adjusted)
- {
- fix_start_end_in_overlays (from, to);
- fix_overlays_before (current_buffer, from, to);
- }
}
/* Adjust point for an insertion of NBYTES bytes, which are NCHARS characters.
diff --git a/src/intervals.c b/src/intervals.c
index 7f11981557..78f4f6b617 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -1836,8 +1836,8 @@ adjust_for_invis_intang (ptrdiff_t pos, ptrdiff_t
test_offs, ptrdiff_t adj,
== (test_offs == 0 ? 1 : -1))
/* Invisible property is from an overlay. */
: (test_offs == 0
- ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
- : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
+ ? ! OVERLAY_FRONT_ADVANCE_P (invis_overlay)
+ : OVERLAY_REAR_ADVANCE_P (invis_overlay))))
pos += adj;
return pos;
diff --git a/src/itree.c b/src/itree.c
new file mode 100644
index 0000000000..3b10802ff0
--- /dev/null
+++ b/src/itree.c
@@ -0,0 +1,1432 @@
+/* This file implements an efficient interval data-structure.
+
+Copyright (C) 2017-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 <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+#include <math.h>
+
+#include "itree.h"
+
+/*
+ Intervals of the form [BEGIN, END), are stored as nodes inside a RB
+ tree, ordered by BEGIN. The core operation of this tree (besides
+ insert, remove, etc.) is finding all intervals intersecting with
+ some given interval. In order to perform this operation
+ efficiently, every node stores a third value called LIMIT. (See
+ https://en.wikipedia.org/wiki/Interval_tree#Augmented_tree and its
+ source Introduction to Algorithms, Cormen et al. .)
+
+ ==== Finding intervals ====
+
+ If we search for all intervals intersecting with (X, Y], we look at
+ some node and test whether
+
+ NODE.BEGIN > Y
+
+ Due to the invariant of the search tree, we know, that we may
+ safely prune NODE's right subtree if this test succeeds, since all
+ intervals begin strictly after Y.
+
+ But we can not make such an assumptions about the left tree, since
+ all we know is that the intervals in this subtree must start before
+ or at NODE.BEGIN. So we can't tell, whether they end before X or
+ not. To solve this problem we add another attribute to each node,
+ called LIMIT.
+
+ The LIMIT of a node is the largest END value occurring in the nodes
+ subtree (including the node itself). Thus, we may look at the left
+ child of some NODE and test whether
+
+ NODE.left.LIMIT < X
+
+ and this tells us, if all intervals in the left subtree of NODE end
+ before X and if they can be pruned.
+
+ Conversely, if this inequality is false, the left subtree must
+ contain at least one intersecting interval, giving a resulting time
+ complexity of O(K*log(N)) for this operation, where K is the size
+ of the result set and N the size of the tree.
+
+ ==== FIXME: bug#58342 some important operations remain slow ===
+
+ The amortized costs of Emacs' previous-overlay-change and
+ next-overlay-change functions are O(N) with this data structure.
+ The root problem is that we only have an order for the BEG field,
+ but not the END. The previous/next overlay change operations need
+ to find the nearest point where there is *either* an interval BEG
+ or END point, but there is no efficient way to narrow the search
+ space over END postions.
+
+ Consider the case where next-overlay-change is called at POS, all
+ interval BEG positions are less than pos POS and all interval END
+ posistions are after. These END positions have no order, and so
+ *every* interval must be examined. This is at least O(N). The
+ previous-overlay-change case is similar. The root issue is that
+ the iterative "narrowing" approach is not guaranteed to reduce the
+ search space in logarithmic time, since END is not ordered in the
+ tree.
+
+ One might argue that the LIMIT value will do this narrowing, but
+ this narrowing is O(K*log(N)) where K is the size of the result
+ set. If we are interested in finding the node in a range with the
+ smallest END, we might have to examine all K nodes in that range.
+ In the case of the *-overlay-channge functions, K may well be equal
+ to N.
+
+ Ideally, a tree based data structure for overlays would have
+ O(log(N)) performance for previous-overlay-change and
+ next-overlay-change, as these are called in performance sensitive
+ situations such as redisplay. The only way I can think of
+ achieving this is by keeping one ordering by BEG and a separate
+ ordering by END, and then performing logic quite similar to the
+ current Emacs overlays-before and overlays-after lists.
+
+ ==== Adjusting intervals ====
+
+ Since this data-structure will be used for overlays in an Emacs
+ buffer, a second core operation is the ability to insert and delete
+ gaps in the tree. This models the insertion and deletion of text
+ in a buffer and the effects it may have on the positions of
+ overlays.
+
+ Consider this: Something gets inserted at position P into a buffer
+ and assume that all overlays occur strictly after P. Ordinarily,
+ we would have to iterate all overlays and increment their BEGIN and
+ END values accordingly (the insertion of text pushes them back).
+ In order to avoid this, we introduce yet another node attribute,
+ called OFFSET.
+
+ The OFFSET of some some subtree, represented by its root, is the
+ amount of shift that needs to be applied to its BEGIN, END and
+ LIMIT values, in order to get to the actual buffer positions.
+ Coming back to the example, all we would need to do in this case,
+ is to increment the OFFSET of the tree's root, without any
+ traversal of the tree itself.
+
+ As a consequence, the real values of BEGIN, END and LIMIT of some
+ NODE need to be computed by incrementing them by the sum of NODE's
+ OFFSET and all of its ancestors offsets. Therefore, we store a
+ counter (otick) inside every node and also the tree, by which we
+ remember the fact, that a node's path to the root has no offsets
+ applied (i.e. its values are up to date). This is the case if some
+ node's value differs from the tree's one, the later of which is
+ incremented whenever some node's offset has changed. */
+
+/* +=======================================================================+
+ * | Stack
+ * +=======================================================================+ */
+
+typedef uintptr_t nodeptr_and_flag;
+
+static inline nodeptr_and_flag
+make_nav (struct itree_node *ptr, bool flag)
+{
+ uintptr_t v = (uintptr_t) ptr;
+ /* We assume alignment imposes the LSB is clear for us to use it. */
+ eassert (!(v & 1));
+ return v | !!flag;
+}
+
+static inline struct itree_node *
+nav_nodeptr (nodeptr_and_flag nav)
+{
+ return (struct itree_node *) (nav & (~(uintptr_t)1));
+}
+
+static inline bool
+nav_flag (nodeptr_and_flag nav)
+{
+ return (bool) (nav & 1);
+}
+
+/* Simple dynamic array. */
+struct interval_stack
+{
+ nodeptr_and_flag *nodes;
+ size_t size;
+ size_t length;
+};
+
+/* This is just a simple dynamic array with stack semantics. */
+
+static struct interval_stack*
+interval_stack_create (intmax_t initial_size)
+{
+ struct interval_stack *stack = xmalloc (sizeof (struct interval_stack));
+ stack->size = max (0, initial_size);
+ stack->nodes = xmalloc (stack->size * sizeof (struct itree_node*));
+ stack->length = 0;
+ return stack;
+}
+
+static void
+interval_stack_destroy (struct interval_stack *stack)
+{
+ if (! stack)
+ return;
+ if (stack->nodes)
+ xfree (stack->nodes);
+ xfree (stack);
+}
+
+static void
+interval_stack_clear (struct interval_stack *stack)
+{
+ stack->length = 0;
+}
+
+static inline void
+interval_stack_ensure_space (struct interval_stack *stack, intmax_t nelements)
+{
+ if (nelements > stack->size)
+ {
+ stack->size = (nelements + 1) * 2;
+ stack->nodes = xrealloc (stack->nodes,
+ stack->size * sizeof (*stack->nodes));
+ }
+}
+
+/* Push NODE on the STACK, while settings its visited flag to FLAG. */
+
+static inline void
+interval_stack_push_flagged (struct interval_stack *stack,
+ struct itree_node *node, bool flag)
+{
+ eassert (node && node != NULL);
+
+ /* FIXME: While the stack used in the iterator is bounded by the tree
+ depth and could be easily pre-allocated to a large enough size to avoid
+ this "ensure" check, `interval_stack_push` is also used elsewhere to
+ simply collect some subset of the overlays, where it's only bounded by
+ the total number of overlays in the buffer (which can be large and thus
+ preferably not pre-allocated needlessly). */
+ interval_stack_ensure_space (stack, stack->length + 1);
+
+ stack->nodes[stack->length] = make_nav (node, flag);
+ stack->length++;
+}
+
+static inline void
+interval_stack_push (struct interval_stack *stack, struct itree_node *node)
+{
+ interval_stack_push_flagged (stack, node, false);
+}
+
+static inline nodeptr_and_flag
+interval_stack_pop (struct interval_stack *stack)
+{
+ if (stack->length == 0)
+ return make_nav (NULL, false);
+ return stack->nodes[--stack->length];
+}
+
+
+/* +-----------------------------------------------------------------------+ */
+
+/* State used when iterating interval. */
+struct itree_iterator
+{
+ struct interval_stack *stack;
+ ptrdiff_t begin;
+ ptrdiff_t end;
+
+ /* A copy of the tree's `otick`. */
+ uintmax_t otick;
+ enum itree_order order;
+ bool running;
+ const char *file;
+ int line;
+};
+
+/* Ideally, every iteration would use its own `iter` object, so we could
+ have several iterations active at the same time. In practice, iterations
+ are limited by the fact we don't allow modifying the tree at the same
+ time, making the use of nested iterations quite rare anyway.
+ So we just use a single global iterator instead for now. */
+static struct itree_iterator *iter;
+
+static int
+interval_tree_max_height (const struct itree_tree *tree)
+{
+ return 2 * log (tree->size + 1) / log (2) + 0.5;
+}
+
+/* Allocate a new iterator for TREE. */
+
+static struct itree_iterator *
+itree_iterator_create (struct itree_tree *tree)
+{
+ struct itree_iterator *g = xmalloc (sizeof *g);
+ /* 19 here just avoids starting with a silly-small stack.
+ FIXME: Since this stack only needs to be about 2*max_depth
+ in the worst case, we could completely pre-allocate it to something
+ like word-bit-size * 2 and then never worry about growing it. */
+ const int size = (tree ? interval_tree_max_height (tree) : 19) + 1;
+
+ g->stack = interval_stack_create (size);
+ g->running = false;
+ g->begin = 0;
+ g->end = 0;
+ g->file = NULL;
+ g->line = 0;
+ return g;
+}
+
+static void
+itree_init (void)
+{
+ iter = itree_iterator_create (NULL);
+}
+
+struct check_subtree_result
+{
+ /* Node count of the tree. */
+ int size;
+
+ /* Limit of the tree (max END). */
+ ptrdiff_t limit;
+
+ /* Black height of the tree. */
+ int black_height;
+};
+
+static struct check_subtree_result
+check_subtree (struct itree_node *node,
+ bool check_red_black_invariants, uintmax_t tree_otick,
+ ptrdiff_t offset, ptrdiff_t min_begin,
+ ptrdiff_t max_begin)
+{
+ struct check_subtree_result result = { .size = 0,
+ .limit = PTRDIFF_MIN,
+ .black_height = 0 };
+ if (node == NULL)
+ return result;
+
+ /* Validate structure. */
+ eassert (node->left == NULL || node->left->parent == node);
+ eassert (node->right == NULL || node->right->parent == node);
+
+ /* Validate otick. A node's otick must be <= to the tree's otick
+ and <= to its parent's otick.
+
+ Note: we cannot assert that (NODE.otick == NODE.parent.otick)
+ implies (NODE.offset == 0) because interval_tree_inherit_offset()
+ doesn't always update otick. It could, but it is not clear there
+ is a need. */
+ eassert (node->otick <= tree_otick);
+ eassert (node->parent == NULL || node->otick <= node->parent->otick);
+ eassert (node->otick != tree_otick || node->offset == 0);
+
+ offset += node->offset;
+ ptrdiff_t begin = node->begin + offset;
+ ptrdiff_t end = node->end + offset;
+ ptrdiff_t limit = node->limit + offset;
+
+ eassert (min_begin <= max_begin);
+ eassert (min_begin <= begin);
+ eassert (begin <= max_begin);
+ eassert (end <= limit);
+
+ struct check_subtree_result left_result
+ = check_subtree (node->left, check_red_black_invariants,
+ tree_otick, offset, min_begin, begin);
+ struct check_subtree_result right_result
+ = check_subtree (node->right, check_red_black_invariants,
+ tree_otick, offset, begin, max_begin);
+
+ eassert (left_result.limit <= limit);
+ eassert (right_result.limit <= limit);
+ eassert (limit == max (end, max (left_result.limit, right_result.limit)));
+
+ if (check_red_black_invariants)
+ {
+ eassert (left_result.black_height == right_result.black_height);
+ eassert (node->parent == NULL || !node->red || !node->parent->red);
+ }
+
+ result.size = 1 + left_result.size + right_result.size;
+ result.limit = limit;
+ result.black_height = (node->red ? 0 : 1) + left_result.black_height;
+ return result;
+}
+
+/* Validate invariants for TREE. If CHECK_RED_BLACK_INVARIANTS, red
+ nodes with red children are considered invalid.
+
+ This runs in constant time when ENABLE_OVERLAY_CHECKING is 0
+ (i.e. Emacs is not configured with
+ "--enable_checking=yes,overlays"). In this mode it can't check all
+ the invariants. When ENABLE_OVERLAY_CHECKING is 1 it checks the
+ entire tree and validates all invariants.
+*/
+static bool
+check_tree (struct itree_tree *tree,
+ bool check_red_black_invariants)
+{
+ eassert (tree != NULL);
+ eassert (tree->size >= 0);
+ eassert ((tree->size == 0) == (tree->root == NULL));
+ if (tree->root == NULL)
+ return true;
+ eassert (tree->root->parent == NULL);
+ eassert (!check_red_black_invariants || !tree->root->red);
+
+ struct itree_node *node = tree->root;
+ struct check_subtree_result result
+ = check_subtree (node, check_red_black_invariants, tree->otick,
+ node->offset, PTRDIFF_MIN,
+ PTRDIFF_MAX);
+ eassert (result.size == tree->size);
+
+ /* The only way this function fails is eassert(). */
+ return true;
+}
+
+/* +=======================================================================+
+ * | Internal Functions
+ * +=======================================================================+ */
+
+static bool
+null_safe_is_red (struct itree_node *node)
+{
+ return node != NULL && node->red;
+}
+
+static bool
+null_safe_is_black (struct itree_node *node)
+{
+ return node == NULL || !node->red; /* NULL nodes are black */
+}
+
+static inline ptrdiff_t
+itree_newlimit (struct itree_node *node)
+{
+ eassert (node != NULL);
+ return max (node->end,
+ max (node->left == NULL
+ ? PTRDIFF_MIN
+ : node->left->limit + node->left->offset,
+ node->right == NULL
+ ? PTRDIFF_MIN
+ : node->right->limit + node->right->offset));
+}
+
+/* Update NODE's limit attribute according to its children. */
+
+static void
+interval_tree_update_limit (struct itree_node *node)
+{
+ if (node == NULL)
+ return;
+
+ node->limit = itree_newlimit (node);
+}
+
+/* Apply NODE's offset to its begin, end and limit values and
+ propagate it to its children.
+
+ Does nothing, if NODE is clean, i.e. NODE.otick = tree.otick .
+*/
+
+static void
+interval_tree_inherit_offset (uintmax_t otick, struct itree_node *node)
+{
+ eassert (node->parent == NULL || node->parent->otick >= node->otick);
+ if (node->otick == otick)
+ {
+ eassert (node->offset == 0);
+ return;
+ }
+
+ /* Offsets can be inherited from dirty nodes (with out of date
+ otick) during removal, since we do not travel down from the root
+ in that case. In this case rotations are performed on
+ potentially "dirty" nodes, where we only need to make sure the
+ *local* offsets are zero. */
+
+ if (node->offset)
+ {
+ node->begin += node->offset;
+ node->end += node->offset;
+ node->limit += node->offset;
+ if (node->left != NULL)
+ node->left->offset += node->offset;
+ if (node->right != NULL)
+ node->right->offset += node->offset;
+ node->offset = 0;
+ }
+ /* The only thing that matters about `otick` is whether it's equal to
+ that of the tree. We could also "blindly" inherit from parent->otick,
+ but we need to tree's `otick` anyway for when there's no parent. */
+ if (node->parent == NULL || node->parent->otick == otick)
+ node->otick = otick;
+}
+
+/* Update limit of NODE and its ancestors. Stop when it becomes
+ stable, i.e. new_limit = old_limit. */
+
+static void
+interval_tree_propagate_limit (struct itree_node *node)
+{
+ ptrdiff_t newlimit;
+
+ if (node == NULL)
+ return;
+
+ while (1)
+ {
+ newlimit = itree_newlimit (node);
+
+ if (newlimit == node->limit)
+ break;
+ node->limit = newlimit;
+ if (node->parent == NULL)
+ break;
+ node = node->parent;
+ }
+}
+
+static struct itree_node*
+interval_tree_validate (struct itree_tree *tree, struct itree_node *node)
+{
+
+ if (tree->otick == node->otick || node == NULL)
+ return node;
+ if (node != tree->root)
+ interval_tree_validate (tree, node->parent);
+
+ interval_tree_inherit_offset (tree->otick, node);
+ return node;
+}
+
+/* +=======================================================================+
+ * | Tree operations
+ * +=======================================================================+ */
+
+/* Initialize an allocated node. */
+
+void
+itree_node_init (struct itree_node *node,
+ bool front_advance, bool rear_advance,
+ Lisp_Object data)
+{
+ node->parent = NULL;
+ node->left = NULL;
+ node->right = NULL;
+ node->begin = -1;
+ node->end = -1;
+ node->front_advance = front_advance;
+ node->rear_advance = rear_advance;
+ node->data = data;
+}
+
+/* Return NODE's begin value, computing it if necessary. */
+
+ptrdiff_t
+itree_node_begin (struct itree_tree *tree,
+ struct itree_node *node)
+{
+ interval_tree_validate (tree, node);
+ return node->begin;
+}
+
+/* Return NODE's end value, computing it if necessary. */
+
+ptrdiff_t
+itree_node_end (struct itree_tree *tree,
+ struct itree_node *node)
+{
+ interval_tree_validate (tree, node);
+ return node->end;
+}
+
+/* Allocate an interval_tree. Free with interval_tree_destroy. */
+
+struct itree_tree *
+itree_create (void)
+{
+ /* FIXME? Maybe avoid the initialization of itree_null in the same
+ way that is used to call mem_init in alloc.c? It's not really
+ important though. */
+ itree_init ();
+
+ struct itree_tree *tree = xmalloc (sizeof (*tree));
+ itree_clear (tree);
+ return tree;
+}
+
+/* Reset the tree TREE to its empty state. */
+
+void
+itree_clear (struct itree_tree *tree)
+{
+ tree->root = NULL;
+ tree->otick = 1;
+ tree->size = 0;
+}
+
+#ifdef ITREE_TESTING
+/* Initialize a pre-allocated tree (presumably on the stack). */
+
+static void
+interval_tree_init (struct interval_tree *tree)
+{
+ interval_tree_clear (tree);
+ /* tree->iter = itree_iterator_create (tree); */
+}
+#endif
+
+/* Release a tree, freeing its allocated memory. */
+void
+itree_destroy (struct itree_tree *tree)
+{
+ eassert (tree->root == NULL);
+ /* if (tree->iter)
+ * itree_iterator_destroy (tree->iter); */
+ xfree (tree);
+}
+
+/* Return the number of nodes in TREE. */
+
+intmax_t
+itree_size (struct itree_tree *tree)
+{
+ return tree->size;
+}
+
+/* Perform the familiar left-rotation on node NODE. */
+
+static void
+interval_tree_rotate_left (struct itree_tree *tree,
+ struct itree_node *node)
+{
+ eassert (node->right != NULL);
+
+ struct itree_node *right = node->right;
+
+ interval_tree_inherit_offset (tree->otick, node);
+ interval_tree_inherit_offset (tree->otick, right);
+
+ /* Turn right's left subtree into node's right subtree. */
+ node->right = right->left;
+ if (right->left != NULL)
+ right->left->parent = node;
+
+ /* right's parent was node's parent. */
+ if (right != NULL)
+ right->parent = node->parent;
+
+ /* Get the parent to point to right instead of node. */
+ if (node != tree->root)
+ {
+ if (node == node->parent->left)
+ node->parent->left = right;
+ else
+ node->parent->right = right;
+ }
+ else
+ tree->root = right;
+
+ /* Put node on right's left. */
+ right->left = node;
+ if (node != NULL)
+ node->parent = right;
+
+ /* Order matters here. */
+ interval_tree_update_limit (node);
+ interval_tree_update_limit (right);
+}
+
+/* Perform the familiar right-rotation on node NODE. */
+
+static void
+interval_tree_rotate_right (struct itree_tree *tree,
+ struct itree_node *node)
+{
+ eassert (tree && node && node->left != NULL);
+
+ struct itree_node *left = node->left;
+
+ interval_tree_inherit_offset (tree->otick, node);
+ interval_tree_inherit_offset (tree->otick, left);
+
+ node->left = left->right;
+ if (left->right != NULL)
+ left->right->parent = node;
+
+ if (left != NULL)
+ left->parent = node->parent;
+ if (node != tree->root)
+ {
+ if (node == node->parent->right)
+ node->parent->right = left;
+ else
+ node->parent->left = left;
+ }
+ else
+ tree->root = left;
+
+ left->right = node;
+ if (node != NULL)
+ node->parent = left;
+
+ interval_tree_update_limit (left);
+ interval_tree_update_limit (node);
+}
+
+/* Repair the tree after an insertion.
+ The new NODE was added as red, so we may have 2 reds in a row.
+ Rebalance the parents as needed to re-establish the RB invariants. */
+
+static void
+interval_tree_insert_fix (struct itree_tree *tree,
+ struct itree_node *node)
+{
+ eassert (tree->root->red == false);
+
+ while (null_safe_is_red (node->parent))
+ {
+ /* NODE is red and its parent is red. This is a violation of
+ red-black tree property #3. */
+ eassert (node->red);
+
+ if (node->parent == node->parent->parent->left)
+ {
+ /* We're on the left side of our grandparent, and OTHER is
+ our "uncle". */
+ struct itree_node *uncle = node->parent->parent->right;
+
+ if (null_safe_is_red (uncle)) /* case 1.a */
+ {
+ /* Uncle and parent are red but should be black because
+ NODE is red. Change the colors accordingly and
+ proceed with the grandparent. */
+ node->parent->red = false;
+ uncle->red = false;
+ node->parent->parent->red = true;
+ node = node->parent->parent;
+ }
+ else
+ {
+ /* Parent and uncle have different colors; parent is
+ red, uncle is black. */
+ if (node == node->parent->right) /* case 2.a */
+ {
+ node = node->parent;
+ interval_tree_rotate_left (tree, node);
+ }
+ /* case 3.a */
+ node->parent->red = false;
+ node->parent->parent->red = true;
+ interval_tree_rotate_right (tree, node->parent->parent);
+ }
+ }
+ else
+ {
+ /* This is the symmetrical case of above. */
+ struct itree_node *uncle = node->parent->parent->left;
+
+ if (null_safe_is_red (uncle)) /* case 1.b */
+ {
+ node->parent->red = false;
+ uncle->red = false;
+ node->parent->parent->red = true;
+ node = node->parent->parent;
+ }
+ else
+ {
+ if (node == node->parent->left) /* case 2.b */
+ {
+ node = node->parent;
+ interval_tree_rotate_right (tree, node);
+ }
+ /* case 3.b */
+ node->parent->red = false;
+ node->parent->parent->red = true;
+ interval_tree_rotate_left (tree, node->parent->parent);
+ }
+ }
+ }
+
+ /* The root may have been changed to red due to the algorithm.
+ Set it to black so that property #5 is satisfied. */
+ tree->root->red = false;
+ eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
+}
+
+/* Insert a NODE into the TREE.
+ Note, that inserting a node twice results in undefined behaviour. */
+
+static void
+interval_tree_insert (struct itree_tree *tree, struct itree_node *node)
+{
+ eassert (node->begin <= node->end && node != NULL);
+ /* FIXME: The assertion below fails because `delete_all_overlays`
+ doesn't set left/right/parent to NULL. */
+ /* eassert (node->left == NULL && node->right == NULL
+ && node->parent == NULL) */;
+ eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
+
+ struct itree_node *parent = NULL;
+ struct itree_node *child = tree->root;
+ uintmax_t otick = tree->otick;
+ /* It's the responsability of the caller to set `otick` on the node,
+ to "confirm" that the begin/end fields are up to date. */
+ eassert (node->otick == otick);
+
+ /* Find the insertion point, accumulate node's offset and update
+ ancestors limit values. */
+ while (child != NULL)
+ {
+ interval_tree_inherit_offset (otick, child);
+ parent = child;
+ eassert (child->offset == 0);
+ child->limit = max (child->limit, node->end);
+ /* This suggests that nodes in the right subtree are strictly
+ greater. But this is not true due to later rotations. */
+ child = node->begin <= child->begin ? child->left : child->right;
+ }
+
+ /* Insert the node */
+ if (parent == NULL)
+ tree->root = node;
+ else if (node->begin <= parent->begin)
+ parent->left = node;
+ else
+ parent->right = node;
+
+ /* Init the node */
+ node->parent = parent;
+ node->left = NULL;
+ node->right = NULL;
+ node->offset = 0;
+ node->limit = node->end;
+ eassert (node->parent == NULL || node->parent->otick >= node->otick);
+
+ /* Fix/update the tree */
+ ++tree->size;
+ if (node == tree->root)
+ node->red = false;
+ else
+ {
+ node->red = true;
+ eassert (check_tree (tree, false)); /* FIXME: Too expensive. */
+ interval_tree_insert_fix (tree, node);
+ }
+}
+
+void
+itree_insert (struct itree_tree *tree, struct itree_node *node,
+ ptrdiff_t begin, ptrdiff_t end)
+{
+ node->begin = begin;
+ node->end = end;
+ node->otick = tree->otick;
+ interval_tree_insert (tree, node);
+}
+
+/* Safely modify a node's interval. */
+
+void
+itree_node_set_region (struct itree_tree *tree,
+ struct itree_node *node,
+ ptrdiff_t begin, ptrdiff_t end)
+{
+ interval_tree_validate (tree, node);
+ if (begin != node->begin)
+ {
+ itree_remove (tree, node);
+ node->begin = min (begin, PTRDIFF_MAX - 1);
+ node->end = max (node->begin, end);
+ interval_tree_insert (tree, node);
+ }
+ else if (end != node->end)
+ {
+ node->end = max (node->begin, end);
+ eassert (node != NULL);
+ interval_tree_propagate_limit (node);
+ }
+}
+
+/* Return true, if NODE is a member of TREE. */
+
+static bool
+interval_tree_contains (struct itree_tree *tree, struct itree_node *node)
+{
+ eassert (node);
+ struct itree_node *other;
+ ITREE_FOREACH (other, tree, node->begin, PTRDIFF_MAX, ASCENDING)
+ if (other == node)
+ {
+ ITREE_FOREACH_ABORT ();
+ return true;
+ }
+
+ return false;
+}
+
+static bool
+itree_limit_is_stable (struct itree_node *node)
+{
+ if (node == NULL)
+ return true;
+ ptrdiff_t newlimit = itree_newlimit (node);
+ return (newlimit == node->limit);
+}
+
+static struct itree_node*
+interval_tree_subtree_min (uintmax_t otick, struct itree_node *node)
+{
+ if (node == NULL)
+ return node;
+ while ((interval_tree_inherit_offset (otick, node),
+ node->left != NULL))
+ node = node->left;
+ return node;
+}
+
+/* Repair the tree after a deletion.
+ The black-depth of NODE is one less than that of its sibling,
+ so re-balance the parents to re-establish the RB invariants. */
+
+static void
+interval_tree_remove_fix (struct itree_tree *tree,
+ struct itree_node *node,
+ struct itree_node *parent)
+{
+ if (parent == NULL)
+ eassert (node == tree->root);
+ else
+ eassert (node == NULL || node->parent == parent);
+
+ while (parent != NULL && null_safe_is_black (node))
+ {
+ eassert (node == parent->left || node == parent->right);
+
+ if (node == parent->left)
+ {
+ struct itree_node *other = parent->right;
+
+ if (null_safe_is_red (other)) /* case 1.a */
+ {
+ other->red = false;
+ parent->red = true;
+ interval_tree_rotate_left (tree, parent);
+ other = parent->right;
+ }
+ eassume (other != NULL);
+
+ if (null_safe_is_black (other->left) /* 2.a */
+ && null_safe_is_black (other->right))
+ {
+ other->red = true;
+ node = parent;
+ eassert (node != NULL);
+ parent = node->parent;
+ }
+ else
+ {
+ if (null_safe_is_black (other->right)) /* 3.a */
+ {
+ other->left->red = false;
+ other->red = true;
+ interval_tree_rotate_right (tree, other);
+ other = parent->right;
+ }
+ other->red = parent->red; /* 4.a */
+ parent->red = false;
+ other->right->red = false;
+ interval_tree_rotate_left (tree, parent);
+ node = tree->root;
+ parent = NULL;
+ }
+ }
+ else
+ {
+ struct itree_node *other = parent->left;
+
+ if (null_safe_is_red (other)) /* 1.b */
+ {
+ other->red = false;
+ parent->red = true;
+ interval_tree_rotate_right (tree, parent);
+ other = parent->left;
+ }
+ eassume (other != NULL);
+
+ if (null_safe_is_black (other->right) /* 2.b */
+ && null_safe_is_black (other->left))
+ {
+ other->red = true;
+ node = parent;
+ eassert (node != NULL);
+ parent = node->parent;
+ }
+ else
+ {
+ if (null_safe_is_black (other->left)) /* 3.b */
+ {
+ other->right->red = false;
+ other->red = true;
+ interval_tree_rotate_left (tree, other);
+ other = parent->left;
+ }
+
+ other->red = parent->red; /* 4.b */
+ parent->red = false;
+ other->left->red = false;
+ interval_tree_rotate_right (tree, parent);
+ node = tree->root;
+ parent = NULL;
+ }
+ }
+ }
+
+ if (node != NULL)
+ node->red = false;
+}
+
+/* Return accumulated offsets of NODE's parents. */
+static ptrdiff_t
+itree_total_offset (struct itree_node *node)
+{
+ eassert (node != NULL);
+ ptrdiff_t offset = 0;
+ while (node->parent != NULL)
+ {
+ node = node->parent;
+ offset += node->offset;
+ }
+ return offset;
+}
+
+/* Replace DEST with SOURCE as a child of DEST's parent. Adjusts
+ *only* the parent linkage of SOURCE and either the parent's child
+ link the tree root.
+
+ Warning: DEST is left unmodified. SOURCE's child links are
+ unchanged. Caller is responsible for recalculation of `limit`.
+ Requires both nodes to be using the same effective `offset`. */
+static void
+interval_tree_replace_child (struct itree_tree *tree,
+ struct itree_node *source,
+ struct itree_node *dest)
+{
+ eassert (tree && dest != NULL);
+ eassert (source == NULL
+ || itree_total_offset (source) == itree_total_offset (dest));
+
+ if (dest == tree->root)
+ tree->root = source;
+ else if (dest == dest->parent->left)
+ dest->parent->left = source;
+ else
+ dest->parent->right = source;
+
+ if (source != NULL)
+ source->parent = dest->parent;
+}
+/* Replace DEST with SOURCE in the tree. Copies the following fields
+ from DEST to SOURCE: red, parent, left, right. Also updates
+ parent, left and right in surrounding nodes to point to SOURCE.
+
+ Warning: DEST is left unmodified. Caller is responsible for
+ recalculation of `limit`. Requires both nodes to be using the same
+ effective `offset`. */
+static void
+interval_tree_transplant (struct itree_tree *tree,
+ struct itree_node *source,
+ struct itree_node *dest)
+{
+ interval_tree_replace_child (tree, source, dest);
+ source->left = dest->left;
+ if (source->left != NULL)
+ source->left->parent = source;
+ source->right = dest->right;
+ if (source->right != NULL)
+ source->right->parent = source;
+ source->red = dest->red;
+}
+
+/* Remove NODE from TREE and return it. NODE must exist in TREE. */
+
+struct itree_node*
+itree_remove (struct itree_tree *tree, struct itree_node *node)
+{
+ eassert (interval_tree_contains (tree, node));
+ eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
+
+ /* Find `splice`, the leaf node to splice out of the tree. When
+ `node` has at most one child this is `node` itself. Otherwise,
+ it is the in order successor of `node`. */
+ interval_tree_inherit_offset (tree->otick, node);
+ struct itree_node *splice
+ = (node->left == NULL || node->right == NULL)
+ ? node
+ : interval_tree_subtree_min (tree->otick, node->right);
+
+ /* Find `subtree`, the only child of `splice` (may be NULL). Note:
+ `subtree` will not be modified other than changing its parent to
+ `splice`. */
+ eassert (splice->left == NULL || splice->right == NULL);
+ struct itree_node *subtree
+ = (splice->left != NULL) ? splice->left : splice->right;
+
+ /* Save a pointer to the parent of where `subtree` will eventually
+ be in `subtree_parent`. */
+ struct itree_node *subtree_parent
+ = (splice->parent != node) ? splice->parent : splice;
+
+ /* If `splice` is black removing it may violate Red-Black
+ invariants, so note this for later. */
+
+ /* Replace `splice` with `subtree` under subtree's parent. If
+ `splice` is black, this creates a red-red violation, so remember
+ this now as the field can be overwritten when splice is
+ transplanted below. */
+ interval_tree_replace_child (tree, subtree, splice);
+ bool removed_black = !splice->red;
+
+ /* Replace `node` with `splice` in the tree and propagate limit
+ upwards, if necessary. Note: Limit propagation can stabilize at
+ any point, so we must call from bottom to top for every node that
+ has a new child. */
+ if (splice != node)
+ {
+ interval_tree_transplant (tree, splice, node);
+ interval_tree_propagate_limit (subtree_parent);
+ if (splice != subtree_parent)
+ interval_tree_update_limit (splice);
+ }
+ interval_tree_propagate_limit (splice->parent);
+
+ --tree->size;
+
+ /* Fix any black height violation caused by removing a black node. */
+ if (removed_black)
+ interval_tree_remove_fix (tree, subtree, subtree_parent);
+
+ eassert ((tree->size == 0) == (tree->root == NULL));
+ eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
+
+ /* Clear fields related to the tree for sanity while debugging. */
+ node->red = false;
+ node->right = node->left = node->parent = NULL;
+ node->limit = 0;
+
+ /* Must be clean (all offsets applied). Also, some callers rely on
+ node's otick being the tree's otick. */
+ eassert (node->otick == tree->otick);
+ eassert (node->offset == 0);
+
+ return node;
+}
+
+bool
+itree_iterator_busy_p (void)
+{
+ return (iter && iter->running);
+}
+
+/* Start a iterator enumerating all intervals in [BEGIN,END) in the
+ given ORDER. Only one iterator per tree can be running at any time. */
+
+struct itree_iterator *
+itree_iterator_start (struct itree_tree *tree, ptrdiff_t begin,
+ ptrdiff_t end, enum itree_order order,
+ const char *file, int line)
+{
+ /* struct itree_iterator *iter = tree->iter; */
+ if (iter->running)
+ {
+ fprintf (stderr,
+ "Detected nested iteration!\nOuter: %s:%d\nInner: %s:%d\n",
+ iter->file, iter->line, file, line);
+ emacs_abort ();
+ }
+ iter->begin = begin;
+ iter->end = end;
+ iter->otick = tree->otick;
+ iter->order = order;
+ interval_stack_clear (iter->stack);
+ if (begin <= end && tree->root != NULL)
+ interval_stack_push_flagged (iter->stack, tree->root, false);
+ iter->file = file;
+ iter->line = line;
+ iter->running = true;
+ /* interval_stack_ensure_space (iter->stack,
+ 2 * interval_tree_max_height (tree)); */
+ return iter;
+}
+
+/* Stop using the iterator. */
+
+void
+itree_iterator_finish (struct itree_iterator *iter)
+{
+ eassert (iter->running);
+ iter->running = false;
+}
+
+
+/* +=======================================================================+
+ * | Insert/Delete Gaps
+ * +=======================================================================+ */
+
+/* Insert a gap at POS of length LENGTH expanding all intervals
+ intersecting it, while respecting their rear_advance and
+ front_advance setting. */
+
+void
+itree_insert_gap (struct itree_tree *tree,
+ ptrdiff_t pos, ptrdiff_t length)
+{
+ if (length <= 0 || tree->root == NULL)
+ return;
+ uintmax_t ootick = tree->otick;
+
+ /* FIXME: Don't allocate iterator/stack anew every time. */
+
+ /* Nodes with front_advance starting at pos may mess up the tree
+ order, so we need to remove them first. */
+ struct interval_stack *saved = interval_stack_create (0);
+ struct itree_node *node = NULL;
+ ITREE_FOREACH (node, tree, pos, pos + 1, PRE_ORDER)
+ {
+ if (node->begin == pos && node->front_advance
+ && (node->begin != node->end || node->rear_advance))
+ interval_stack_push (saved, node);
+ }
+ for (int i = 0; i < saved->length; ++i)
+ itree_remove (tree, nav_nodeptr (saved->nodes[i]));
+
+ /* We can't use an iterator here, because we can't effectively
+ narrow AND shift some subtree at the same time. */
+ if (tree->root != NULL)
+ {
+ const int size = interval_tree_max_height (tree) + 1;
+ struct interval_stack *stack = interval_stack_create (size);
+ interval_stack_push (stack, tree->root);
+ nodeptr_and_flag nav;
+ while ((nav = interval_stack_pop (stack),
+ node = nav_nodeptr (nav)))
+ {
+ /* Process in pre-order. */
+ interval_tree_inherit_offset (tree->otick, node);
+ if (node->right != NULL)
+ {
+ if (node->begin > pos)
+ {
+ /* All nodes in this subtree are shifted by length. */
+ node->right->offset += length;
+ ++tree->otick;
+ }
+ else
+ interval_stack_push (stack, node->right);
+ }
+ if (node->left != NULL
+ && pos <= node->left->limit + node->left->offset)
+ interval_stack_push (stack, node->left);
+
+ /* node->begin == pos implies no front-advance. */
+ if (node->begin > pos)
+ node->begin += length;
+ if (node->end > pos || (node->end == pos && node->rear_advance))
+ {
+ node->end += length;
+ eassert (node != NULL);
+ interval_tree_propagate_limit (node);
+ }
+ }
+ interval_stack_destroy (stack);
+ }
+
+ /* Reinsert nodes starting at POS having front-advance. */
+ uintmax_t notick = tree->otick;
+ nodeptr_and_flag nav;
+ while ((nav = interval_stack_pop (saved),
+ node = nav_nodeptr (nav)))
+ {
+ eassert (node->otick == ootick);
+ node->begin += length;
+ if (node->end != pos || node->rear_advance)
+ node->end += length;
+ node->otick = notick;
+ interval_tree_insert (tree, node);
+ }
+
+ interval_stack_destroy (saved);
+}
+
+/* Delete a gap at POS of length LENGTH, contracting all intervals
+ intersecting it. */
+
+void
+itree_delete_gap (struct itree_tree *tree,
+ ptrdiff_t pos, ptrdiff_t length)
+{
+ if (length <= 0 || tree->root == NULL)
+ return;
+
+ /* FIXME: Don't allocate stack anew every time. */
+
+ /* Can't use the iterator here, because by decrementing begin, we
+ might unintentionally bring shifted nodes back into our search space. */
+ const int size = interval_tree_max_height (tree) + 1;
+ struct interval_stack *stack = interval_stack_create (size);
+ struct itree_node *node;
+
+ interval_stack_push (stack, tree->root);
+ nodeptr_and_flag nav;
+ while ((nav = interval_stack_pop (stack)))
+ {
+ node = nav_nodeptr (nav);
+ interval_tree_inherit_offset (tree->otick, node);
+ if (node->right != NULL)
+ {
+ if (node->begin > pos + length)
+ {
+ /* Shift right subtree to the left. */
+ node->right->offset -= length;
+ ++tree->otick;
+ }
+ else
+ interval_stack_push (stack, node->right);
+ }
+ if (node->left != NULL
+ && pos <= node->left->limit + node->left->offset)
+ interval_stack_push (stack, node->left);
+
+ if (pos < node->begin)
+ node->begin = max (pos, node->begin - length);
+ if (node->end > pos)
+ {
+ node->end = max (pos , node->end - length);
+ eassert (node != NULL);
+ interval_tree_propagate_limit (node);
+ }
+ }
+ interval_stack_destroy (stack);
+}
+
+
+
+/* +=======================================================================+
+ * | Iterator
+ * +=======================================================================+ */
+
+/* Return true, if NODE's interval intersects with [BEGIN, END).
+ Note: We always include empty nodes at BEGIN (and not at END),
+ but if BEGIN==END, then we don't include non-empty nodes starting
+ at BEGIN or ending at END. This seems to match the behavior of the
+ old overlays code but it's not clear if it's The Right Thing
+ (e.g. it breaks the expectation that if NODE1 is included, then
+ a NODE2 strictly bigger than NODE1 should also be included). */
+
+static inline bool
+interval_node_intersects (const struct itree_node *node,
+ ptrdiff_t begin, ptrdiff_t end)
+{
+ return (begin < node->end && node->begin < end)
+ || (node->begin == node->end && begin == node->begin);
+}
+
+/* Return the next node of the iterator in the order given when it was
+ started; or NULL if there are no more nodes. */
+
+struct itree_node *
+itree_iterator_next (struct itree_iterator *g)
+{
+ eassert (g->running);
+
+ struct itree_node *const null = NULL;
+ struct itree_node *node;
+
+ /* The `visited` flag stored in each node is used here (and only here):
+ We keep a "workstack" of nodes we need to consider. This stack
+ consist of nodes of two types: nodes that we have decided
+ should be returned by the iterator, and nodes which we may
+ need to consider (including checking their children).
+ We start an iteration with a stack containing just the root
+ node marked as "not visited" which means that it (and its children)
+ needs to be considered but we haven't yet decided whether it's included
+ in the iterator's output. */
+
+ do
+ {
+ nodeptr_and_flag nav;
+ bool visited;
+ while ((nav = interval_stack_pop (g->stack),
+ node = nav_nodeptr (nav),
+ visited = nav_flag (nav),
+ node && !visited))
+ {
+ struct itree_node *const left = node->left;
+ struct itree_node *const right = node->right;
+
+ interval_tree_inherit_offset (g->otick, node);
+ eassert (itree_limit_is_stable (node));
+ switch (g->order)
+ {
+ case ITREE_ASCENDING:
+ if (right != null && node->begin <= g->end)
+ interval_stack_push_flagged (g->stack, right, false);
+ if (interval_node_intersects (node, g->begin, g->end))
+ interval_stack_push_flagged (g->stack, node, true);
+ /* Node's children may still be off-set and we need to add it. */
+ if (left != null && g->begin <= left->limit + left->offset)
+ interval_stack_push_flagged (g->stack, left, false);
+ break;
+ case ITREE_DESCENDING:
+ if (left != null && g->begin <= left->limit + left->offset)
+ interval_stack_push_flagged (g->stack, left, false);
+ if (interval_node_intersects (node, g->begin, g->end))
+ interval_stack_push_flagged (g->stack, node, true);
+ if (right != null && node->begin <= g->end)
+ interval_stack_push_flagged (g->stack, right, false);
+ break;
+ case ITREE_PRE_ORDER:
+ if (right != null && node->begin <= g->end)
+ interval_stack_push_flagged (g->stack, right, false);
+ if (left != null && g->begin <= left->limit + left->offset)
+ interval_stack_push_flagged (g->stack, left, false);
+ if (interval_node_intersects (node, g->begin, g->end))
+ interval_stack_push_flagged (g->stack, node, true);
+ break;
+ }
+ }
+ /* Node may have been invalidated by itree_iterator_narrow
+ after it was pushed: Check if it still intersects. */
+ } while (node && ! interval_node_intersects (node, g->begin, g->end));
+
+ return node;
+}
+
+/* Limit G to the new interval [BEGIN, END), which must be a subset of
+ the current one. I.E. it can't grow on either side. */
+
+void
+itree_iterator_narrow (struct itree_iterator *g,
+ ptrdiff_t begin, ptrdiff_t end)
+{
+ eassert (g->running);
+ eassert (begin >= g->begin);
+ eassert (end <= g->end);
+ g->begin = max (begin, g->begin);
+ g->end = min (end, g->end);
+}
diff --git a/src/itree.h b/src/itree.h
new file mode 100644
index 0000000000..c6b68d3667
--- /dev/null
+++ b/src/itree.h
@@ -0,0 +1,182 @@
+/* This file implements an efficient interval data-structure.
+
+Copyright (C) 2017-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 <http://www.gnu.org/licenses/>. */
+
+#ifndef ITREE_H
+#define ITREE_H
+#include <config.h>
+#include <stddef.h>
+#include <inttypes.h>
+
+#include "lisp.h"
+
+/* The tree and node structs are mainly here, so they can be
+ allocated.
+
+ NOTE: The only time where it is safe to modify node.begin and
+ node.end directly, is while the node is not part of any tree.
+
+ NOTE: It is safe to read node.begin and node.end directly, if the
+ node came from an iterator, because it validates the nodes it
+ returns as a side-effect. See ITREE_FOREACH.
+ */
+
+struct itree_node
+{
+ /* The normal parent, left and right links found in binary trees.
+ See also `red`, below, which completes the Red-Black tree
+ representation. */
+ struct itree_node *parent;
+ struct itree_node *left;
+ struct itree_node *right;
+
+ /* The following five fields comprise the interval abstraction.
+
+ BEGIN, END are buffer positions describing the range. When a
+ node is in a tree these fields are read only, written only by
+ itree functions.
+
+ The LIMIT, OFFSET and OTICK fields should be considered internal
+ to itree.c and used only by itree functions.
+
+ LIMIT is a buffer position, the maximum of END of this node and
+ its children. See itree.c for its use.
+
+ OFFSET is in buffer position units, and will be non-zero only
+ when the node is dirty.
+
+ OTICK determines whether BEGIN, END, LIMIT and OFFSET are
+ considered dirty. A node is clean when its OTICK is equal to the
+ OTICK of its tree (see struct itree_tree). Otherwise, it is
+ dirty.
+
+ In a clean node, BEGIN, END and LIMIT are correct buffer
+ positions, and OFFSET is zero. The parent of a clean node is
+ also clean, recursively.
+
+ In a dirty node, the node's OTICK won't equal its tree's OTICK,
+ and its OFFSET may be non-zero. At all times the descendents of
+ a dirty node are also dirty. BEGIN, END and LIMIT require
+ adjustment before use as buffer positions.
+
+ NOTE: BEGIN and END must not be modified while the node is part
+ of a tree. Use itree_insert_gap and itree_delete_gap instead.
+
+ NOTE: The interval iterators ensure nodes are clean before
+ yielding them, so BEGIN and END may be safely used as buffer
+ positions then. */
+
+ ptrdiff_t begin; /* The beginning of this interval. */
+ ptrdiff_t end; /* The end of the interval. */
+ ptrdiff_t limit; /* The maximum end in this subtree. */
+ ptrdiff_t offset; /* The amount of shift to apply to this
subtree. */
+ uintmax_t otick; /* offset modified tick */
+ Lisp_Object data; /* Exclusively used by the client. */
+ bool_bf red : 1;
+ bool_bf rear_advance : 1; /* Same as for marker and overlays. */
+ bool_bf front_advance : 1; /* Same as for marker and overlays. */
+};
+
+struct itree_tree
+{
+ struct itree_node *root;
+ uintmax_t otick; /* offset tick, compared with node's otick. */
+ intmax_t size; /* Number of nodes in the tree. */
+};
+
+enum itree_order
+ {
+ ITREE_ASCENDING,
+ ITREE_DESCENDING,
+ ITREE_PRE_ORDER,
+ };
+
+extern void itree_node_init (struct itree_node *, bool, bool, Lisp_Object);
+extern ptrdiff_t itree_node_begin (struct itree_tree *, struct itree_node *);
+extern ptrdiff_t itree_node_end (struct itree_tree *, struct itree_node *);
+extern void itree_node_set_region (struct itree_tree *, struct itree_node *,
+ ptrdiff_t, ptrdiff_t);
+extern struct itree_tree *itree_create (void);
+extern void itree_destroy (struct itree_tree *);
+extern intmax_t itree_size (struct itree_tree *);
+extern void itree_clear (struct itree_tree *);
+extern void itree_insert (struct itree_tree *, struct itree_node *,
+ ptrdiff_t, ptrdiff_t);
+extern struct itree_node *itree_remove (struct itree_tree *,
+ struct itree_node *);
+extern void itree_insert_gap (struct itree_tree *, ptrdiff_t, ptrdiff_t);
+extern void itree_delete_gap (struct itree_tree *, ptrdiff_t, ptrdiff_t);
+
+/* Iteration functions. Almost all code should use ITREE_FOREACH
+ instead. */
+extern bool itree_iterator_busy_p (void);
+extern struct itree_iterator *itree_iterator_start (struct itree_tree *,
+ ptrdiff_t,
+ ptrdiff_t,
+ enum itree_order,
+ const char *, int);
+extern void itree_iterator_narrow (struct itree_iterator *, ptrdiff_t,
+ ptrdiff_t);
+extern void itree_iterator_finish (struct itree_iterator *);
+extern struct itree_node *itree_iterator_next (struct itree_iterator *);
+
+/* Iterate over the intervals between BEG and END in the tree T.
+ N will hold successive nodes. ORDER can be one of : `ASCENDING`,
+ `DESCENDING`, or `PRE_ORDER`.
+ It should be used as:
+
+ ITREE_FOREACH (n, t, beg, end, order)
+ {
+ .. do the thing with n ..
+ }
+
+ BEWARE:
+ - The expression T may be evaluated more than once, so make sure
+ it is cheap a pure.
+ - Only a single iteration can happen at a time, so make sure none of the
+ code within the loop can start another tree iteration, i.e. it shouldn't
+ be able to run ELisp code, nor GC since GC can run ELisp by way
+ of `post-gc-hook`.
+ - If you need to exit the loop early, you *have* to call `ITREE_ABORT`
+ just before exiting (e.g. with `break` or `return`).
+ - Non-local exits are not supported within the body of the loop.
+ - Don't modify the tree during the iteration.
+ */
+#define ITREE_FOREACH(n, t, beg, end, order) \
+ /* FIXME: We'd want to declare `x` right here, but I can't figure out
+ how to make that work here: the `for` syntax only allows a single
+ clause for the var declarations where we need 2 different types.
+ We could use the `struct {foo x; bar y; } p;` trick to declare two
+ vars `p.x` and `p.y` of unrelated types, but then none of the names
+ of the vars matches the `n` we receive :-(. */ \
+ if (!t) \
+ { } \
+ else \
+ for (struct itree_iterator *itree_iter_ \
+ = itree_iterator_start (t, beg, end, ITREE_##order, \
+ __FILE__, __LINE__); \
+ ((n = itree_iterator_next (itree_iter_)) \
+ || (itree_iterator_finish (itree_iter_), false));)
+
+#define ITREE_FOREACH_ABORT() \
+ itree_iterator_finish (itree_iter_)
+
+#define ITREE_FOREACH_NARROW(beg, end) \
+ itree_iterator_narrow (itree_iter_, beg, end)
+
+#endif
diff --git a/src/keyboard.c b/src/keyboard.c
index 224512bfc9..069cf0627b 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1270,7 +1270,6 @@ command_loop_1 (void)
{
modiff_count prev_modiff = 0;
struct buffer *prev_buffer = NULL;
- bool already_adjusted = 0;
kset_prefix_arg (current_kboard, Qnil);
kset_last_prefix_arg (current_kboard, Qnil);
@@ -1460,8 +1459,6 @@ command_loop_1 (void)
safe_run_hooks_maybe_narrowed (Qpre_command_hook,
XWINDOW (selected_window));
- already_adjusted = 0;
-
if (NILP (Vthis_command))
/* nil means key is undefined. */
call0 (Qundefined);
@@ -1617,9 +1614,8 @@ command_loop_1 (void)
the automatic composition, we must update the
display. */
windows_or_buffers_changed = 21;
- if (!already_adjusted)
- adjust_point_for_property (last_point_position,
- MODIFF != prev_modiff);
+ adjust_point_for_property (last_point_position,
+ MODIFF != prev_modiff);
}
else if (PT > BEGV && PT < ZV
&& (composition_adjust_point (last_point_position, PT)
@@ -1701,8 +1697,8 @@ adjust_point_for_property (ptrdiff_t last_pt, bool
modified)
&& display_prop_intangible_p (val, overlay, PT, PT_BYTE)
&& (!OVERLAYP (overlay)
? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil)
- : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)),
- end = OVERLAY_POSITION (OVERLAY_END (overlay))))
+ : (beg = OVERLAY_START (overlay),
+ end = OVERLAY_END (overlay)))
&& (beg < PT /* && end > PT <- It's always the case. */
|| (beg <= PT && STRINGP (val) && SCHARS (val) == 0)))
{
diff --git a/src/lisp.h b/src/lisp.h
index 5f6721595c..d87f954938 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1,7 +1,6 @@
/* Fundamental definitions for GNU Emacs Lisp interpreter. -*- coding: utf-8
-*-
-Copyright (C) 1985-1987, 1993-1995, 1997-2022 Free Software Foundation,
-Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -643,10 +642,8 @@ extern bool initialized;
extern struct gflags
{
/* True means this Emacs instance was born to dump. */
-#if defined HAVE_PDUMPER || defined HAVE_UNEXEC
bool will_dump_ : 1;
bool will_bootstrap_ : 1;
-#endif
#ifdef HAVE_PDUMPER
/* Set in an Emacs process that will likely dump with pdumper; all
Emacs processes may dump with pdumper, however. */
@@ -2608,10 +2605,9 @@ struct Lisp_Overlay
*/
{
union vectorlike_header header;
- Lisp_Object start;
- Lisp_Object end;
Lisp_Object plist;
- struct Lisp_Overlay *next;
+ struct buffer *buffer; /* eassert (live buffer || NULL). */
+ struct itree_node *interval;
} GCALIGNED_STRUCT;
struct Lisp_Misc_Ptr
@@ -3187,10 +3183,11 @@ CHECK_SUBR (Lisp_Object x)
`minargs' should be a number, the minimum number of arguments allowed.
`maxargs' should be a number, the maximum number of arguments allowed,
or else MANY or UNEVALLED.
- MANY means pass a vector of evaluated arguments,
- in the form of an integer number-of-arguments
- followed by the address of a vector of Lisp_Objects
- which contains the argument values.
+ MANY means there are &rest arguments. Here we pass a vector
+ of evaluated arguments in the form of an integer
+ number-of-arguments followed by the address of a vector of
+ Lisp_Objects which contains the argument values. (We also use
+ this convention when calling a subr with more than 8 parameters.)
UNEVALLED means pass the list of unevaluated arguments
`intspec' says how interactive arguments are to be fetched.
If the string starts with a `(', `intspec' is evaluated and the resulting
@@ -4422,7 +4419,6 @@ extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
extern specpdl_ref inhibit_garbage_collection (void);
extern Lisp_Object build_symbol_with_pos (Lisp_Object, Lisp_Object);
-extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
extern void init_alloc_once (void);
extern void init_alloc (void);
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/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 1fc72d83f6..17f40dc7e3 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -4237,7 +4237,12 @@ ns_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
for (i = 0; i < s->nchars; i++, glyph++)
{
- char buf[7];
+#ifdef GCC_LINT
+ enum { PACIFY_GCC_BUG_81401 = 1 };
+#else
+ enum { PACIFY_GCC_BUG_81401 = 0 };
+#endif
+ char buf[8 + PACIFY_GCC_BUG_81401];
char *str = NULL;
int len = glyph->u.glyphless.len;
@@ -4263,7 +4268,7 @@ ns_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
{
unsigned int ch = glyph->u.glyphless.ch;
eassume (ch <= MAX_CHAR);
- snprintf (buf, 7, "%0*X", ch < 0x10000 ? 4 : 6, ch);
+ snprintf (buf, 8, "%0*X", ch < 0x10000 ? 4 : 6, ch);
str = buf;
}
@@ -9158,6 +9163,7 @@ ns_create_font_panel_buttons (id target, SEL select, SEL
cancel_action)
NSTRACE ("[EmacsWindow dealloc]");
/* We need to release the toolbar ourselves. */
+ [self setToolbar: nil];
[[self toolbar] release];
/* Also the last button press event . */
diff --git a/src/pdumper.c b/src/pdumper.c
index 5e6ccd9bd8..d6ae57afb2 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2133,17 +2133,64 @@ dump_marker (struct dump_context *ctx, const struct
Lisp_Marker *marker)
return finish_dump_pvec (ctx, &out->header);
}
+static dump_off
+dump_interval_node (struct dump_context *ctx, struct itree_node *node,
+ dump_off parent_offset)
+{
+#if CHECK_STRUCTS && !defined (HASH_interval_node_5765524F7E)
+# error "interval_node changed. See CHECK_STRUCTS comment in config.h."
+#endif
+ struct itree_node out;
+ dump_object_start (ctx, &out, sizeof (out));
+ if (node->parent)
+ dump_field_fixup_later (ctx, &out, node, &node->parent);
+ if (node->left)
+ dump_field_fixup_later (ctx, &out, node, &node->parent);
+ if (node->right)
+ dump_field_fixup_later (ctx, &out, node, &node->parent);
+ DUMP_FIELD_COPY (&out, node, begin);
+ DUMP_FIELD_COPY (&out, node, end);
+ DUMP_FIELD_COPY (&out, node, limit);
+ DUMP_FIELD_COPY (&out, node, offset);
+ DUMP_FIELD_COPY (&out, node, otick);
+ dump_field_lv (ctx, &out, node, &node->data, WEIGHT_STRONG);
+ DUMP_FIELD_COPY (&out, node, red);
+ DUMP_FIELD_COPY (&out, node, rear_advance);
+ DUMP_FIELD_COPY (&out, node, front_advance);
+ dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
+ if (node->parent)
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct itree_node, parent),
+ dump_interval_node (ctx, node->parent, offset));
+ if (node->left)
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct itree_node, left),
+ dump_interval_node (ctx, node->left, offset));
+ if (node->right)
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct itree_node, right),
+ dump_interval_node (ctx, node->right, offset));
+ return offset;
+}
+
static dump_off
dump_overlay (struct dump_context *ctx, const struct Lisp_Overlay *overlay)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_72EADA9882)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_1CD4249AEC)
# error "Lisp_Overlay changed. See CHECK_STRUCTS comment in config.h."
#endif
START_DUMP_PVEC (ctx, &overlay->header, struct Lisp_Overlay, out);
dump_pseudovector_lisp_fields (ctx, &out->header, &overlay->header);
- dump_field_lv_rawptr (ctx, out, overlay, &overlay->next,
- Lisp_Vectorlike, WEIGHT_STRONG);
- return finish_dump_pvec (ctx, &out->header);
+ dump_field_fixup_later (ctx, &out, overlay, &overlay->interval);
+ dump_off offset = finish_dump_pvec (ctx, &out->header);
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct Lisp_Overlay, interval),
+ dump_interval_node (ctx, overlay->interval, offset));
+ return offset;
}
static void
@@ -2701,7 +2748,7 @@ dump_hash_table (struct dump_context *ctx,
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_AA373AEE10
+#if CHECK_STRUCTS && !defined HASH_buffer_F0F08347A5
# error "buffer changed. See CHECK_STRUCTS comment in config.h."
#endif
struct buffer munged_buffer = *in_buffer;
@@ -2816,13 +2863,12 @@ dump_buffer (struct dump_context *ctx, const struct
buffer *in_buffer)
DUMP_FIELD_COPY (out, buffer, inhibit_buffer_hooks);
DUMP_FIELD_COPY (out, buffer, long_line_optimizations_p);
- dump_field_lv_rawptr (ctx, out, buffer, &buffer->overlays_before,
- Lisp_Vectorlike, WEIGHT_NORMAL);
-
- dump_field_lv_rawptr (ctx, out, buffer, &buffer->overlays_after,
- Lisp_Vectorlike, WEIGHT_NORMAL);
+ if (buffer->overlays && buffer->overlays->root != NULL)
+ /* We haven't implemented the code to dump overlays. */
+ emacs_abort ();
+ else
+ out->overlays = NULL;
- DUMP_FIELD_COPY (out, buffer, overlay_center);
dump_field_lv (ctx, out, buffer, &buffer->undo_list_,
WEIGHT_STRONG);
dump_off offset = finish_dump_pvec (ctx, &out->header);
diff --git a/src/print.c b/src/print.c
index 1c96ec14b8..65218084a4 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1,7 +1,6 @@
/* Lisp object printing and output streams.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2022 Free Software
-Foundation, Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -594,8 +593,7 @@ temp_output_buffer_setup (const char *bufname)
bset_read_only (current_buffer, Qnil);
bset_filename (current_buffer, Qnil);
bset_undo_list (current_buffer, Qt);
- eassert (current_buffer->overlays_before == NULL);
- eassert (current_buffer->overlays_after == NULL);
+ eassert (current_buffer->overlays == NULL);
bset_enable_multibyte_characters
(current_buffer, BVAR (&buffer_defaults, enable_multibyte_characters));
specbind (Qinhibit_read_only, Qt);
@@ -1745,15 +1743,15 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
case PVEC_OVERLAY:
print_c_string ("#<overlay ", printcharfun);
- if (! XMARKER (OVERLAY_START (obj))->buffer)
+ if (! OVERLAY_BUFFER (obj))
print_c_string ("in no buffer", printcharfun);
else
{
int len = sprintf (buf, "from %"pD"d to %"pD"d in ",
- marker_position (OVERLAY_START (obj)),
- marker_position (OVERLAY_END (obj)));
+ OVERLAY_START (obj),
+ OVERLAY_END (obj));
strout (buf, len, len, printcharfun);
- print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name),
+ print_string (BVAR (OVERLAY_BUFFER (obj), name),
printcharfun);
}
printchar ('>', printcharfun);
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 1526e344e5..08bf696b8c 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -50,6 +50,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int64,
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 int, sqlite3_extended_errcode, (sqlite3*));
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*));
@@ -88,6 +89,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
# undef sqlite3_bind_double
# undef sqlite3_bind_null
# undef sqlite3_bind_int
+# undef sqlite3_extended_errcode
# undef sqlite3_errmsg
# undef sqlite3_errstr
# undef sqlite3_step
@@ -113,6 +115,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
# define sqlite3_bind_double fn_sqlite3_bind_double
# define sqlite3_bind_null fn_sqlite3_bind_null
# define sqlite3_bind_int fn_sqlite3_bind_int
+# define sqlite3_extended_errcode fn_sqlite3_extended_errcode
# define sqlite3_errmsg fn_sqlite3_errmsg
# define sqlite3_errstr fn_sqlite3_errstr
# define sqlite3_step fn_sqlite3_step
@@ -141,6 +144,7 @@ load_dll_functions (HMODULE library)
LOAD_DLL_FN (library, sqlite3_bind_double);
LOAD_DLL_FN (library, sqlite3_bind_null);
LOAD_DLL_FN (library, sqlite3_bind_int);
+ LOAD_DLL_FN (library, sqlite3_extended_errcode);
LOAD_DLL_FN (library, sqlite3_errmsg);
LOAD_DLL_FN (library, sqlite3_errstr);
LOAD_DLL_FN (library, sqlite3_step);
@@ -233,13 +237,13 @@ check_sqlite (Lisp_Object db, bool is_statement)
init_sqlite_functions ();
CHECK_SQLITE (db);
if (is_statement && !XSQLITE (db)->is_statement)
- xsignal1 (Qerror, build_string ("Invalid set object"));
+ xsignal1 (Qsqlite_error, build_string ("Invalid set object"));
else if (!is_statement && XSQLITE (db)->is_statement)
- xsignal1 (Qerror, build_string ("Invalid database object"));
+ xsignal1 (Qsqlite_error, build_string ("Invalid database object"));
if (!is_statement && !XSQLITE (db)->db)
- xsignal1 (Qerror, build_string ("Database closed"));
+ xsignal1 (Qsqlite_error, build_string ("Database closed"));
else if (is_statement && !XSQLITE (db)->db)
- xsignal1 (Qerror, build_string ("Statement closed"));
+ xsignal1 (Qsqlite_error, build_string ("Statement closed"));
}
static int db_count = 0;
@@ -259,7 +263,7 @@ If FILE is nil, an in-memory database will be opened
instead. */)
#endif
if (!init_sqlite_functions ())
- xsignal1 (Qerror, build_string ("sqlite support is not available"));
+ xsignal1 (Qsqlite_error, build_string ("sqlite support is not available"));
if (!NILP (file))
name = ENCODE_FILE (Fexpand_file_name (file, Qnil));
@@ -272,7 +276,7 @@ If FILE is nil, an in-memory database will be opened
instead. */)
name = CALLN (Fformat, memory_fmt, make_int (++db_count));
flags |= SQLITE_OPEN_MEMORY;
#else
- xsignal1 (Qerror, build_string ("sqlite in-memory is not available"));
+ xsignal1 (Qsqlite_error, build_string ("sqlite in-memory is not
available"));
#endif
}
@@ -342,7 +346,7 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object
values)
if (blob)
{
if (SBYTES (value) != SCHARS (value))
- xsignal1 (Qerror, build_string ("BLOB values must be unibyte"));
+ xsignal1 (Qsqlite_error, build_string ("BLOB values must be
unibyte"));
ret = sqlite3_bind_blob (stmt, i + 1,
SSDATA (value), SBYTES (value),
NULL);
@@ -422,16 +426,15 @@ row_to_value (sqlite3_stmt *stmt)
}
static Lisp_Object
-sqlite_prepare_errmsg (int code, sqlite3 *sdb)
+sqlite_prepare_errdata (int code, sqlite3 *sdb)
{
- Lisp_Object errmsg = build_string (sqlite3_errstr (code));
+ Lisp_Object errstr = build_string (sqlite3_errstr (code));
+ Lisp_Object errcode = make_fixnum (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;
+ Lisp_Object ext_errcode = make_fixnum (sqlite3_extended_errcode (sdb));
+ const char *errmsg = sqlite3_errmsg (sdb);
+ return list4 (errstr, errmsg ? build_string (errmsg) : Qnil,
+ errcode, ext_errcode);
}
DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0,
@@ -447,7 +450,7 @@ Value is the number of affected rows. */)
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"));
+ xsignal1 (Qsqlite_error, build_string ("VALUES must be a list or a
vector"));
sqlite3 *sdb = XSQLITE (db)->db;
Lisp_Object errmsg = Qnil,
@@ -466,7 +469,7 @@ Value is the number of affected rows. */)
sqlite3_reset (stmt);
}
- errmsg = sqlite_prepare_errmsg (ret, sdb);
+ errmsg = sqlite_prepare_errdata (ret, sdb);
goto exit;
}
@@ -505,7 +508,7 @@ Value is the number of affected rows. */)
exit:
sqlite3_finalize (stmt);
xsignal1 (ret == SQLITE_LOCKED || ret == SQLITE_BUSY?
- Qsqlite_locked_error: Qerror,
+ Qsqlite_locked_error: Qsqlite_error,
errmsg);
}
@@ -525,14 +528,15 @@ DEFUN ("sqlite-select", Fsqlite_select, Ssqlite_select,
2, 4, 0,
If VALUES is non-nil, it should be a list or a vector specifying the
values that will be interpolated into a parameterized statement.
-By default, the return value is a list where the first element is a
-list of column names, and the rest of the elements are the matching data.
+By default, the return value is a list, whose contents depend on
+the value of the optional argument RETURN-TYPE.
-RETURN-TYPE can be either nil (which means that the matching data
-should be returned as a list of rows), or `full' (the same, but the
-first element in the return list will be the column names), or `set',
-which means that we return a set object that can be queried with
-`sqlite-next' and other functions to get the data. */)
+If RETURN-TYPE is nil or omitted, the function returns a list of rows
+matching QUERY. If RETURN-TYPE is `full', the function returns a
+list whose first element is the list of column names, and the rest
+of the elements are the rows matching QUERY. If RETURN-TYPE is `set',
+the function returns a set object that can be queried with functions
+like `sqlite-next' etc., in order to get the data. */)
(Lisp_Object db, Lisp_Object query, Lisp_Object values,
Lisp_Object return_type)
{
@@ -540,7 +544,7 @@ which means that we return a set object that can be queried
with
CHECK_STRING (query);
if (!(NILP (values) || CONSP (values) || VECTORP (values)))
- xsignal1 (Qerror, build_string ("VALUES must be a list or a vector"));
+ xsignal1 (Qsqlite_error, build_string ("VALUES must be a list or a
vector"));
sqlite3 *sdb = XSQLITE (db)->db;
Lisp_Object retval = Qnil, errmsg = Qnil,
@@ -553,7 +557,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);
+ errmsg = sqlite_prepare_errdata (ret, sdb);
goto exit;
}
@@ -589,7 +593,7 @@ which means that we return a set object that can be queried
with
exit:
if (! NILP (errmsg))
- xsignal1 (Qerror, errmsg);
+ xsignal1 (Qsqlite_error, errmsg);
return retval;
}
@@ -675,7 +679,7 @@ Only modules on Emacs' list of allowed modules can be
loaded. */)
}
if (!do_allow)
- xsignal (Qerror, build_string ("Module name not on allowlist"));
+ xsignal1 (Qsqlite_error, build_string ("Module name not on allowlist"));
int result = sqlite3_load_extension
(XSQLITE (db)->db,
@@ -695,7 +699,7 @@ DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0,
int ret = sqlite3_step (XSQLITE (set)->stmt);
if (ret != SQLITE_ROW && ret != SQLITE_OK && ret != SQLITE_DONE)
- xsignal1 (Qerror, build_string (sqlite3_errmsg (XSQLITE (set)->db)));
+ xsignal1 (Qsqlite_error, build_string (sqlite3_errmsg (XSQLITE
(set)->db)));
if (ret == SQLITE_DONE)
{
@@ -794,9 +798,15 @@ syms_of_sqlite (void)
defsubr (&Ssqlitep);
defsubr (&Ssqlite_available_p);
+ DEFSYM (Qsqlite_error, "sqlite-error");
+ Fput (Qsqlite_error, Qerror_conditions,
+ Fpurecopy (list2 (Qsqlite_error, Qerror)));
+ Fput (Qsqlite_error, Qerror_message,
+ build_pure_c_string ("Database error"));
+
DEFSYM (Qsqlite_locked_error, "sqlite-locked-error");
Fput (Qsqlite_locked_error, Qerror_conditions,
- Fpurecopy (list2 (Qsqlite_locked_error, Qerror)));
+ Fpurecopy (list3 (Qsqlite_locked_error, Qsqlite_error, Qerror)));
Fput (Qsqlite_locked_error, Qerror_message,
build_pure_c_string ("Database locked"));
diff --git a/src/textprop.c b/src/textprop.c
index c22b579af2..ca693fd680 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -1,6 +1,5 @@
/* Interface code for dealing with text properties.
- Copyright (C) 1993-1995, 1997, 1999-2022 Free Software Foundation,
- Inc.
+ Copyright (C) 1993-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -634,36 +633,40 @@ get_char_property_and_overlay (Lisp_Object position,
register Lisp_Object prop,
}
if (BUFFERP (object))
{
- ptrdiff_t noverlays;
- Lisp_Object *overlay_vec;
- struct buffer *obuf = current_buffer;
-
- if (! (BUF_BEGV (XBUFFER (object)) <= pos
- && pos <= BUF_ZV (XBUFFER (object))))
+ struct buffer *b = XBUFFER (object);
+ struct itree_node *node;
+ struct sortvec items[2];
+ struct sortvec *result = NULL;
+ Lisp_Object result_tem = Qnil;
+
+ if (! (BUF_BEGV (b) <= pos
+ && pos <= BUF_ZV (b)))
xsignal1 (Qargs_out_of_range, position);
- set_buffer_temp (XBUFFER (object));
-
- USE_SAFE_ALLOCA;
- GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false);
- noverlays = sort_overlays (overlay_vec, noverlays, w);
-
- set_buffer_temp (obuf);
-
/* Now check the overlays in order of decreasing priority. */
- while (--noverlays >= 0)
+ ITREE_FOREACH (node, b->overlays, pos, pos + 1, ASCENDING)
{
- Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
- if (!NILP (tem))
- {
- if (overlay)
- /* Return the overlay we got the property from. */
- *overlay = overlay_vec[noverlays];
- SAFE_FREE ();
- return tem;
- }
+ Lisp_Object tem = Foverlay_get (node->data, prop);
+ struct sortvec *this;
+
+ if (NILP (tem) || node->end < pos + 1
+ || (w && ! overlay_matches_window (w, node->data)))
+ continue;
+
+ this = (result == items ? items + 1 : items);
+ make_sortvec_item (this, node->data);
+ if (! result || (compare_overlays (result, this) < 0))
+ {
+ result = this;
+ result_tem = tem;
+ }
}
- SAFE_FREE ();
+ if (result)
+ {
+ if (overlay)
+ *overlay = result->overlay;
+ return result_tem;
+ }
}
if (overlay)
diff --git a/src/w32fns.c b/src/w32fns.c
index 5f652ae9e4..93b7f80f26 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -2734,8 +2734,7 @@ setup_w32_kbdhook (void)
int i;
CoCreateGuid (&guid);
- StringFromGUID2 (&guid, newTitle, 64);
- if (newTitle != NULL)
+ if (oldTitle != NULL && StringFromGUID2 (&guid, newTitle, 64))
{
GetConsoleTitleW (oldTitle, 1024);
SetConsoleTitleW (newTitle);
diff --git a/src/window.h b/src/window.h
index 93817a9544..b5d0c69ab5 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1212,6 +1212,16 @@ output_cursor_to (struct window *w, int vpos, int hpos,
int y, int x)
w->output_cursor.y = y;
}
+/* Return true, if overlay OV's properties should have an effect in
+ window W. */
+INLINE bool
+overlay_matches_window (const struct window *w, Lisp_Object ov)
+{
+ eassert (OVERLAYP (ov));
+ Lisp_Object window = Foverlay_get (ov, Qwindow);
+ return (! WINDOWP (window) || XWINDOW (window) == w);
+}
+
INLINE_HEADER_END
#endif /* not WINDOW_H_INCLUDED */
diff --git a/src/xdisp.c b/src/xdisp.c
index e390de6a33..dd243eca98 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -1,7 +1,6 @@
/* Display generation from window structure and buffer text.
-Copyright (C) 1985-1988, 1993-1995, 1997-2022 Free Software Foundation,
-Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -1159,7 +1158,6 @@ static enum move_it_result
static void get_visually_first_element (struct it *);
static void compute_stop_pos (struct it *);
static int face_before_or_after_it_pos (struct it *, bool);
-static ptrdiff_t next_overlay_change (ptrdiff_t);
static int handle_display_spec (struct it *, Lisp_Object, Lisp_Object,
Lisp_Object, struct text_pos *, ptrdiff_t,
bool);
static int handle_single_display_spec (struct it *, Lisp_Object, Lisp_Object,
@@ -4168,39 +4166,6 @@ compute_stop_pos (struct it *it)
&& it->stop_charpos >= IT_CHARPOS (*it)));
}
-
-/* Return the position of the next overlay change after POS in
- current_buffer. Value is point-max if no overlay change
- follows. This is like `next-overlay-change' but doesn't use
- xmalloc. */
-
-static ptrdiff_t
-next_overlay_change (ptrdiff_t pos)
-{
- ptrdiff_t i, noverlays;
- ptrdiff_t endpos;
- Lisp_Object *overlays;
- USE_SAFE_ALLOCA;
-
- /* Get all overlays at the given position. */
- GET_OVERLAYS_AT (pos, overlays, noverlays, &endpos, true);
-
- /* If any of these overlays ends before endpos,
- use its ending point instead. */
- for (i = 0; i < noverlays; ++i)
- {
- Lisp_Object oend;
- ptrdiff_t oendpos;
-
- oend = OVERLAY_END (overlays[i]);
- oendpos = OVERLAY_POSITION (oend);
- endpos = min (endpos, oendpos);
- }
-
- SAFE_FREE ();
- return endpos;
-}
-
/* How many characters forward to search for a display property or
display string. Searching too far forward makes the bidi display
sluggish, especially in small windows. */
@@ -5838,7 +5803,7 @@ handle_single_display_spec (struct it *it, Lisp_Object
spec, Lisp_Object object,
overlay's display string/image twice. */
if (!NILP (overlay))
{
- ptrdiff_t ovendpos = OVERLAY_POSITION (OVERLAY_END (overlay));
+ ptrdiff_t ovendpos = OVERLAY_END (overlay);
/* Some borderline-sane Lisp might call us with the current
buffer narrowed so that overlay-end is outside the
@@ -6572,6 +6537,8 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos)
struct overlay_entry entriesbuf[20];
ptrdiff_t size = ARRAYELTS (entriesbuf);
struct overlay_entry *entries = entriesbuf;
+ struct itree_node *node;
+
USE_SAFE_ALLOCA;
if (charpos <= 0)
@@ -6603,27 +6570,24 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos)
} \
while (false)
- /* Process overlay before the overlay center. */
- for (struct Lisp_Overlay *ov = current_buffer->overlays_before;
- ov; ov = ov->next)
+
+ /* Process overlays. */
+ ITREE_FOREACH (node, current_buffer->overlays, charpos - 1, charpos + 1,
DESCENDING)
{
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
+ Lisp_Object overlay = node->data;
eassert (OVERLAYP (overlay));
- ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- if (end < charpos)
- break;
+ ptrdiff_t start = node->begin;
+ ptrdiff_t end = node->end;
/* Skip this overlay if it doesn't start or end at IT's current
- position. */
+ position. */
if (end != charpos && start != charpos)
- continue;
+ continue;
/* Skip this overlay if it doesn't apply to IT->w. */
Lisp_Object window = Foverlay_get (overlay, Qwindow);
if (WINDOWP (window) && XWINDOW (window) != it->w)
- continue;
+ continue;
/* If the text ``under'' the overlay is invisible, both before-
and after-strings from this overlay are visible; start and
@@ -6634,56 +6598,15 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos)
/* If overlay has a non-empty before-string, record it. */
Lisp_Object str;
if ((start == charpos || (end == charpos && invis != 0))
- && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
- && SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, false);
-
- /* If overlay has a non-empty after-string, record it. */
- if ((end == charpos || (start == charpos && invis != 0))
- && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))
- && SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, true);
- }
-
- /* Process overlays after the overlay center. */
- for (struct Lisp_Overlay *ov = current_buffer->overlays_after;
- ov; ov = ov->next)
- {
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
- ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- if (start > charpos)
- break;
-
- /* Skip this overlay if it doesn't start or end at IT's current
- position. */
- if (end != charpos && start != charpos)
- continue;
-
- /* Skip this overlay if it doesn't apply to IT->w. */
- Lisp_Object window = Foverlay_get (overlay, Qwindow);
- if (WINDOWP (window) && XWINDOW (window) != it->w)
- continue;
-
- /* If the text ``under'' the overlay is invisible, it has a zero
- dimension, and both before- and after-strings apply. */
- Lisp_Object invisible = Foverlay_get (overlay, Qinvisible);
- int invis = TEXT_PROP_MEANS_INVISIBLE (invisible);
-
- /* If overlay has a non-empty before-string, record it. */
- Lisp_Object str;
- if ((start == charpos || (end == charpos && invis != 0))
- && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
- && SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, false);
+ && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
+ && SCHARS (str))
+ RECORD_OVERLAY_STRING (overlay, str, false);
/* If overlay has a non-empty after-string, record it. */
if ((end == charpos || (start == charpos && invis != 0))
- && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))
- && SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, true);
+ && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))
+ && SCHARS (str))
+ RECORD_OVERLAY_STRING (overlay, str, true);
}
#undef RECORD_OVERLAY_STRING
@@ -7088,11 +7011,11 @@ back_to_previous_line_start (struct it *it)
static bool
strings_with_newlines (ptrdiff_t startpos, ptrdiff_t endpos, struct window *w)
{
- /* Process overlays before the overlay center. */
- for (struct Lisp_Overlay *ov = current_buffer->overlays_before;
- ov; ov = ov->next)
+ struct itree_node *node;
+ /* Process overlays. */
+ ITREE_FOREACH (node, current_buffer->overlays, startpos, endpos, DESCENDING)
{
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
+ Lisp_Object overlay = node->data;
eassert (OVERLAYP (overlay));
/* Skip this overlay if it doesn't apply to our window. */
@@ -7100,14 +7023,8 @@ strings_with_newlines (ptrdiff_t startpos, ptrdiff_t
endpos, struct window *w)
if (WINDOWP (window) && XWINDOW (window) != w)
continue;
- ptrdiff_t ostart = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t oend = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- /* Due to the order of overlays in overlays_before, once we get
- to an overlay whose end position is before STARTPOS, all the
- rest also end before STARTPOS, and thus are of no concern to us. */
- if (oend < startpos)
- break;
+ ptrdiff_t ostart = node->begin;
+ ptrdiff_t oend = node->end;
/* Skip overlays that don't overlap the range. */
if (!((startpos < oend && ostart < endpos)
@@ -7119,49 +7036,17 @@ strings_with_newlines (ptrdiff_t startpos, ptrdiff_t
endpos, struct window *w)
str = Foverlay_get (overlay, Qbefore_string);
if (STRINGP (str) && SCHARS (str)
&& memchr (SDATA (str), '\n', SBYTES (str)))
- return true;
- str = Foverlay_get (overlay, Qafter_string);
- if (STRINGP (str) && SCHARS (str)
- && memchr (SDATA (str), '\n', SBYTES (str)))
- return true;
- }
-
- /* Process overlays after the overlay center. */
- for (struct Lisp_Overlay *ov = current_buffer->overlays_after;
- ov; ov = ov->next)
- {
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
-
- /* Skip this overlay if it doesn't apply to our window. */
- Lisp_Object window = Foverlay_get (overlay, Qwindow);
- if (WINDOWP (window) && XWINDOW (window) != w)
- continue;
-
- ptrdiff_t ostart = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t oend = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- /* Due to the order of overlays in overlays_after, once we get
- to an overlay whose start position is after ENDPOS, all the
- rest also start after ENDPOS, and thus are of no concern to us. */
- if (ostart > endpos)
- break;
-
- /* Skip overlays that don't overlap the range. */
- if (!((startpos < oend && ostart < endpos)
- || (ostart == oend
- && (startpos == oend || (endpos == ZV && oend == endpos)))))
- continue;
-
- Lisp_Object str;
- str = Foverlay_get (overlay, Qbefore_string);
- if (STRINGP (str) && SCHARS (str)
- && memchr (SDATA (str), '\n', SBYTES (str)))
- return true;
+ {
+ ITREE_FOREACH_ABORT ();
+ return true;
+ }
str = Foverlay_get (overlay, Qafter_string);
if (STRINGP (str) && SCHARS (str)
&& memchr (SDATA (str), '\n', SBYTES (str)))
- return true;
+ {
+ ITREE_FOREACH_ABORT ();
+ return true;
+ }
}
/* Check for 'display' properties whose values include strings. */
@@ -7404,7 +7289,7 @@ back_to_previous_visible_line_start (struct it *it)
&& !NILP (val = get_char_property_and_overlay
(make_fixnum (pos), Qdisplay, Qnil, &overlay))
&& (OVERLAYP (overlay)
- ? (beg = OVERLAY_POSITION (OVERLAY_START (overlay)))
+ ? (beg = OVERLAY_START (overlay))
: get_property_and_range (pos, Qdisplay, &val, &beg, &end,
Qnil)))
{
RESTORE_IT (it, it, it2data);
@@ -10639,7 +10524,6 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int
to_x, int to_y, int to_vpos
}
/* Reset/increment for the next run. */
- recenter_overlay_lists (current_buffer, IT_CHARPOS (*it));
it->current_x = line_start_x;
line_start_x = 0;
it->hpos = 0;
@@ -13334,7 +13218,10 @@ unwind_format_mode_line (Lisp_Object vector)
if (!EQ (frame, WINDOW_FRAME (XWINDOW (old_window))))
Fselect_window (target_frame_window, Qt);
- if (!NILP (old_top_frame) && !EQ (old_top_frame, frame))
+ if (!NILP (old_top_frame) && !EQ (old_top_frame, frame)
+ /* This could've been destroyed during the formatting,
+ possibly because the terminal was deleted. */
+ && FRAME_LIVE_P (XFRAME (old_top_frame)))
Fselect_frame (old_top_frame, Qt);
}
@@ -13437,6 +13324,7 @@ void
gui_consider_frame_title (Lisp_Object frame)
{
struct frame *f = XFRAME (frame);
+ Lisp_Object format_data;
if ((FRAME_WINDOW_P (f)
|| FRAME_MINIBUF_ONLY_P (f)
@@ -13481,15 +13369,19 @@ gui_consider_frame_title (Lisp_Object frame)
specbind (Qinhibit_redisplay, Qt);
/* Switch to the buffer of selected window of the frame. Set up
- mode_line_target so that display_mode_element will output into
- mode_line_noprop_buf; then display the title. */
- record_unwind_protect (unwind_format_mode_line,
- format_mode_line_unwind_data
- (f, current_buffer, selected_window, false));
+ mode_line_target so that display_mode_element will output
+ into mode_line_noprop_buf; then display the title. Save the
+ original frame and selected window, and possibly the topmost
+ frame of the tty (for tty frames) into a vector; it will be
+ restored later. */
+
+ format_data = format_mode_line_unwind_data (f, current_buffer,
+ selected_window,
+ false);
+ record_unwind_protect (unwind_format_mode_line, format_data);
Fselect_window (f->selected_window, Qt);
- set_buffer_internal_1
- (XBUFFER (XWINDOW (f->selected_window)->contents));
+ set_buffer_internal_1 (XBUFFER (XWINDOW (f->selected_window)->contents));
fmt = FRAME_ICONIFIED_P (f) ? Vicon_title_format : Vframe_title_format;
mode_line_target = MODE_LINE_TITLE;
@@ -13502,8 +13394,9 @@ gui_consider_frame_title (Lisp_Object frame)
/* Make sure that any raw bytes in the title are properly
represented by their multibyte sequences. */
ptrdiff_t nchars = 0;
- len = str_as_multibyte ((unsigned char *)title,
- mode_line_noprop_buf_end - title, len, &nchars);
+ len = str_as_multibyte ((unsigned char *) title,
+ mode_line_noprop_buf_end - title,
+ len, &nchars);
unbind_to (count, Qnil);
/* Set the title only if it's changed. This avoids consing in
@@ -18917,7 +18810,7 @@ try_cursor_movement (Lisp_Object window, struct
text_pos startp,
while (MATRIX_ROW_BOTTOM_Y (row) < last_y
&& MATRIX_ROW_END_CHARPOS (row) == PT
&& row < MATRIX_MODE_LINE_ROW (w->current_matrix)
- && MATRIX_ROW_START_CHARPOS (row+1) == PT
+ && MATRIX_ROW_START_CHARPOS (row+1) >= PT
&& !cursor_row_p (row))
++row;
@@ -19014,7 +18907,12 @@ try_cursor_movement (Lisp_Object window, struct
text_pos startp,
rc = CURSOR_MOVEMENT_SUCCESS;
}
- if (PT < MATRIX_ROW_START_CHARPOS (row)
+ if ((PT < MATRIX_ROW_START_CHARPOS (row)
+ && (row == MATRIX_FIRST_TEXT_ROW (w->current_matrix)
+ /* Don't give up if point is inside invisible text
+ at the beginning of its glyph row. */
+ || (MATRIX_ROW_END_CHARPOS (row-1)
+ == MATRIX_ROW_START_CHARPOS (row))))
|| PT > MATRIX_ROW_END_CHARPOS (row))
{
/* if PT is not in the glyph row, give up. */
@@ -19096,12 +18994,23 @@ try_cursor_movement (Lisp_Object window, struct
text_pos startp,
continuation lines' rows is implemented for
bidi-reordered rows. */
bool rv = false;
+ bool pt_invis = false;
+ Lisp_Object val = get_char_property_and_overlay (make_fixnum (PT),
+ Qinvisible,
+ Qnil, NULL);
+
+ if (TEXT_PROP_MEANS_INVISIBLE (val) != 0)
+ pt_invis = true;
do
{
bool at_zv_p = false, exact_match_p = false;
- if (MATRIX_ROW_START_CHARPOS (row) <= PT
+ /* If point is in invisible text, we cannot assume
+ it must be after row's start position, since the
+ row could have invisible text at its beginning
+ where point is located. */
+ if ((pt_invis || MATRIX_ROW_START_CHARPOS (row) <= PT)
&& PT <= MATRIX_ROW_END_CHARPOS (row)
&& cursor_row_p (row))
rv |= set_cursor_from_row (w, row, w->current_matrix,
@@ -19133,16 +19042,8 @@ try_cursor_movement (Lisp_Object window, struct
text_pos startp,
invisible text? In that case, we trust
'set_cursor_from_row' to do its job and
find the best position for the cursor. */
- if (!exact_match_p)
- {
- Lisp_Object val =
- get_char_property_and_overlay (make_fixnum (PT),
- Qinvisible,
- Qnil, NULL);
-
- if (TEXT_PROP_MEANS_INVISIBLE (val) != 0)
- exact_match_p = true;
- }
+ if (!exact_match_p && pt_invis)
+ exact_match_p = true;
}
if (at_zv_p || exact_match_p)
{
@@ -24601,13 +24502,6 @@ display_line (struct it *it, int cursor_vpos)
it->stretch_adjust = 0;
it->line_number_produced_p = false;
- /* Arrange the overlays nicely for our purposes. Usually, we call
- display_line on only one line at a time, in which case this
- can't really hurt too much, or we call it on lines which appear
- one after another in the buffer, in which case all calls to
- recenter_overlay_lists but the first will be pretty cheap. */
- recenter_overlay_lists (current_buffer, IT_CHARPOS (*it));
-
/* If we are going to display the cursor's line, account for the
hscroll of that line. We subtract the window's min_hscroll,
because that was already accounted for in init_iterator. */
@@ -34912,7 +34806,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
@@ -35239,7 +35133,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
if (BUFFERP (object))
{
/* Put all the overlays we want in a vector in overlay_vec. */
- GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false);
+ GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL);
/* Sort overlays into increasing priority order. */
noverlays = sort_overlays (overlay_vec, noverlays, w);
}
@@ -35267,7 +35161,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
|| (!hlinfo->mouse_face_hidden
&& OVERLAYP (hlinfo->mouse_face_overlay)
/* It's possible the overlay was deleted (Bug#35273). */
- && XMARKER (OVERLAY_START (hlinfo->mouse_face_overlay))->buffer
+ && OVERLAY_BUFFER (hlinfo->mouse_face_overlay)
&& mouse_face_overlay_overlaps (hlinfo->mouse_face_overlay)))
{
/* Find the highest priority overlay with a mouse-face. */
diff --git a/src/xfaces.c b/src/xfaces.c
index 5e3a47d7f8..ed76db9adb 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -6540,8 +6540,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
USE_SAFE_ALLOCA;
{
ptrdiff_t next_overlay;
-
- GET_OVERLAYS_AT (pos, overlay_vec, noverlays, &next_overlay, false);
+ GET_OVERLAYS_AT (pos, overlay_vec, noverlays, &next_overlay);
if (next_overlay < endpos)
endpos = next_overlay;
}
@@ -6594,7 +6593,6 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
{
for (prop = Qnil, i = noverlays - 1; i >= 0 && NILP (prop); --i)
{
- Lisp_Object oend;
ptrdiff_t oendpos;
prop = Foverlay_get (overlay_vec[i], propname);
@@ -6607,8 +6605,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
merge_face_ref (w, f, prop, attrs, true, NULL, attr_filter);
}
- oend = OVERLAY_END (overlay_vec[i]);
- oendpos = OVERLAY_POSITION (oend);
+ oendpos = OVERLAY_END (overlay_vec[i]);
if (oendpos < endpos)
endpos = oendpos;
}
@@ -6617,7 +6614,6 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
{
for (i = 0; i < noverlays; i++)
{
- Lisp_Object oend;
ptrdiff_t oendpos;
prop = Foverlay_get (overlay_vec[i], propname);
@@ -6625,11 +6621,10 @@ face_at_buffer_position (struct window *w, ptrdiff_t
pos,
if (!NILP (prop))
merge_face_ref (w, f, prop, attrs, true, NULL, attr_filter);
- oend = OVERLAY_END (overlay_vec[i]);
- oendpos = OVERLAY_POSITION (oend);
- if (oendpos < endpos)
- endpos = oendpos;
- }
+ oendpos = OVERLAY_END (overlay_vec[i]);
+ if (oendpos < endpos)
+ endpos = oendpos;
+ }
}
*endptr = endpos;
diff --git a/src/xfns.c b/src/xfns.c
index e8732986eb..3ff7a8c286 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -7913,7 +7913,7 @@ Otherwise, the return value is a vector with the
following fields:
DEFUN ("x-translate-coordinates", Fx_translate_coordinates,
Sx_translate_coordinates,
- 1, 5, 0, doc: /* Translate coordinates from FRAME.
+ 1, 6, 0, doc: /* Translate coordinates from FRAME.
Translate the given coordinates SOURCE-X and SOURCE-Y from
SOURCE-WINDOW's coordinate space to that of DEST-WINDOW, on FRAME.
@@ -7929,16 +7929,21 @@ Return a list of (X Y CHILD) if the given coordinates
are on the same
screen, or nil otherwise, where X and Y are the coordinates in
DEST-WINDOW's coordinate space, and CHILD is the window ID of any
mapped child in DEST-WINDOW at those coordinates, or nil if there is
-no such window. */)
+no such window. If REQUIRE-CHILD is nil, avoid fetching CHILD if it
+would result in an avoidable request to the X server, thereby
+improving performance when the X connection is over a slow network.
+Otherwise, always obtain the mapped child window from the X
+server. */)
(Lisp_Object frame, Lisp_Object source_window,
Lisp_Object dest_window, Lisp_Object source_x,
- Lisp_Object source_y)
+ Lisp_Object source_y, Lisp_Object require_child)
{
struct x_display_info *dpyinfo;
struct frame *source_frame;
int dest_x, dest_y;
Window child_return, src, dest;
Bool rc;
+ Lisp_Object temp_result;
dpyinfo = check_x_display_info (frame);
dest_x = 0;
@@ -7956,6 +7961,8 @@ no such window. */)
dest_y = XFIXNUM (source_y);
}
+ source_frame = NULL;
+
if (!NILP (source_window))
CONS_TO_INTEGER (source_window, Window, src);
else
@@ -7964,6 +7971,17 @@ no such window. */)
src = FRAME_X_WINDOW (source_frame);
}
+ /* If require_child is nil, try to avoid an avoidable roundtrip to
+ the X server. */
+ if (NILP (require_child) && source_frame)
+ {
+ temp_result
+ = x_handle_translate_coordinates (source_frame, dest_window, dest_x,
+ dest_y);
+ if (!NILP (temp_result))
+ return temp_result;
+ }
+
if (!src)
src = dpyinfo->root_window;
diff --git a/src/xmenu.c b/src/xmenu.c
index 9d35e3529f..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 */
@@ -2537,6 +2540,8 @@ pop_down_menu (void *arg)
}
#endif
+ /* Decrement the popup_activated_flag. */
+ popup_activated_flag = 0;
#endif /* HAVE_X_WINDOWS */
unblock_input ();
@@ -2747,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,
@@ -2787,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 498c28af53..db5c7853e7 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -2787,7 +2787,6 @@ x_handle_dnd_message (struct frame *f, const
XClientMessageEvent *event,
unsigned char *data = (unsigned char *) event->data.b;
int idata[5];
ptrdiff_t i;
- Window child_return;
for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
if (dpyinfo->x_dnd_atoms[i] == event->message_type) break;
@@ -2822,11 +2821,7 @@ x_handle_dnd_message (struct frame *f, const
XClientMessageEvent *event,
if (!root_window_coords)
x_relative_mouse_position (f, &x, &y);
else
- XTranslateCoordinates (dpyinfo->display,
- dpyinfo->root_window,
- FRAME_X_WINDOW (f),
- root_x, root_y,
- &x, &y, &child_return);
+ x_translate_coordinates (f, root_x, root_y, &x, &y);
bufp->kind = DRAG_N_DROP_EVENT;
bufp->frame_or_window = frame;
diff --git a/src/xsettings.c b/src/xsettings.c
index e4a9865d68..15e7ff5499 100644
--- a/src/xsettings.c
+++ b/src/xsettings.c
@@ -54,12 +54,14 @@ typedef unsigned int CARD32;
#include <gconf/gconf-client.h>
#endif
-#if defined USE_CAIRO || defined HAVE_XFT
#ifdef USE_CAIRO
#include <fontconfig/fontconfig.h>
-#else /* HAVE_XFT */
+#elif defined HAVE_XFT
#include <X11/Xft/Xft.h>
#endif
+
+#if defined USE_CAIRO && defined CAIRO_HAS_FT_FONT
+#include <cairo/cairo-ft.h>
#endif
static char *current_mono_font;
@@ -804,16 +806,30 @@ static void
apply_xft_settings (Display_Info *dpyinfo,
struct xsettings *settings)
{
-#ifdef HAVE_XFT
+#if defined HAVE_XFT \
+ || (defined USE_CAIRO && defined CAIRO_HAS_FC_FONT \
+ && defined CAIRO_HAS_FT_FONT)
FcPattern *pat;
struct xsettings oldsettings;
bool changed = false;
+#ifndef HAVE_XFT
+ cairo_font_options_t *options;
+#endif
+
memset (&oldsettings, 0, sizeof (oldsettings));
pat = FcPatternCreate ();
+#ifdef HAVE_XFT
XftDefaultSubstitute (dpyinfo->display,
XScreenNumberOfScreen (dpyinfo->screen),
pat);
+#else
+ FcConfigSubstitute (NULL, pat, FcMatchPattern);
+ options = cairo_font_options_create ();
+ cairo_ft_font_options_substitute (options, pat);
+ cairo_font_options_destroy (options);
+ FcDefaultSubstitute (pat);
+#endif
FcPatternGetBool (pat, FC_ANTIALIAS, 0, &oldsettings.aa);
FcPatternGetBool (pat, FC_HINTING, 0, &oldsettings.hinting);
#ifdef FC_HINT_STYLE
@@ -912,8 +928,11 @@ apply_xft_settings (Display_Info *dpyinfo,
- sizeof "%f")
};
char buf[sizeof format + d_formats * d_growth + lf_formats * lf_growth];
-
+#ifdef HAVE_XFT
XftDefaultSet (dpyinfo->display, pat);
+#else
+ FcPatternDestroy (pat);
+#endif
store_config_changed_event (Qfont_render,
XCAR (dpyinfo->name_list_element));
Vxft_settings
@@ -925,7 +944,7 @@ apply_xft_settings (Display_Info *dpyinfo,
}
else
FcPatternDestroy (pat);
-#endif /* HAVE_XFT */
+#endif /* HAVE_XFT || (USE_CAIRO && CAIRO_HAS_FC_FONT && CAIRO_HAS_FT_FONT) */
}
#endif
diff --git a/src/xterm.c b/src/xterm.c
index 8b3d6f77a6..7dd969b821 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -1143,7 +1143,6 @@ static Window x_get_window_below (Display *, Window, int,
int, int *, int *);
#ifndef USE_TOOLKIT_SCROLL_BARS
static void x_scroll_bar_redraw (struct scroll_bar *);
#endif
-static void x_translate_coordinates (struct frame *, int, int, int *, int *);
/* Global state maintained during a drag-and-drop operation. */
@@ -5370,7 +5369,6 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
valuator->emacs_value = DBL_MIN;
valuator->increment = info->increment;
valuator->number = info->number;
- valuator->pending_enter_reset = false;
break;
}
@@ -5416,7 +5414,6 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
{
xi_device->valuators[c].invalid_p = false;
xi_device->valuators[c].current_value = tem->current_value;
- xi_device->valuators[c].pending_enter_reset = true;
}
}
}
@@ -5610,8 +5607,8 @@ xi_find_touch_point (struct xi_device_t *device, int
detail)
#ifdef HAVE_XINPUT2_1
static void
-xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int
id,
- bool pending_only)
+xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo,
+ int id)
{
struct xi_device_t *device = xi_device_from_id (dpyinfo, id);
struct xi_scroll_valuator_t *valuator;
@@ -5625,11 +5622,6 @@ xi_reset_scroll_valuators_for_device_id (struct
x_display_info *dpyinfo, int id,
for (int i = 0; i < device->scroll_valuator_count; ++i)
{
valuator = &device->valuators[i];
-
- if (pending_only && !valuator->pending_enter_reset)
- continue;
-
- valuator->pending_enter_reset = false;
valuator->invalid_p = true;
valuator->emacs_value = 0.0;
}
@@ -7735,6 +7727,28 @@ 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. */
@@ -7745,7 +7759,6 @@ 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);
@@ -7787,12 +7800,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);
@@ -10834,6 +10851,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
@@ -13079,14 +13106,6 @@ xi_handle_device_changed (struct x_display_info
*dpyinfo,
{
valuator->invalid_p = false;
valuator->current_value = valuator_info->value;
-
- /* Make sure that this is reset if the pointer moves
- into a window of ours.
-
- Otherwise the valuator state could be left
- invalid if the DeviceChange event happened with
- the pointer outside any Emacs frame. */
- valuator->pending_enter_reset = true;
}
break;
@@ -13623,7 +13642,7 @@ x_compute_root_window_offset (struct frame *f, int
root_x, int root_y,
many cases while handling events, which would otherwise result in
slowdowns over slow network connections. */
-static void
+void
x_translate_coordinates (struct frame *f, int root_x, int root_y,
int *x_out, int *y_out)
{
@@ -13696,6 +13715,31 @@ x_translate_coordinates_to_root (struct frame *f, int
x, int y,
}
}
+/* Do x-translate-coordinates, but try to avoid a roundtrip to the X
+ server at the cost of not returning `child', which most callers
+ have no reason to use. */
+
+Lisp_Object
+x_handle_translate_coordinates (struct frame *f, Lisp_Object dest_window,
+ int source_x, int source_y)
+{
+ if (NILP (dest_window))
+ {
+ /* We are translating coordinates from a frame to the root
+ window. Avoid a roundtrip if possible by using cached
+ coordinates. */
+
+ if (!FRAME_X_OUTPUT (f)->window_offset_certain_p)
+ return Qnil;
+
+ return list3 (make_fixnum (source_x + FRAME_X_OUTPUT (f)->root_x),
+ make_fixnum (source_y + FRAME_X_OUTPUT (f)->root_y),
+ Qnil);
+ }
+
+ return Qnil;
+}
+
/* The same, but for an XIDeviceEvent. */
#ifdef HAVE_XINPUT2
@@ -17809,6 +17853,7 @@ x_coords_from_dnd_message (struct x_display_info
*dpyinfo,
static void
x_handle_wm_state (struct frame *f, struct input_event *ie)
{
+ struct x_display_info *dpyinfo;
Atom type;
int format;
unsigned long nitems, bytes_after;
@@ -17816,10 +17861,11 @@ x_handle_wm_state (struct frame *f, struct
input_event *ie)
unsigned long *state;
data = NULL;
+ dpyinfo = FRAME_DISPLAY_INFO (f);
if (XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- FRAME_DISPLAY_INFO (f)->Xatom_wm_state, 0, 2,
- False, AnyPropertyType, &type, &format, &nitems,
+ dpyinfo->Xatom_wm_state, 0, 2, False,
+ AnyPropertyType, &type, &format, &nitems,
&bytes_after, &data) != Success)
return;
@@ -17844,6 +17890,20 @@ x_handle_wm_state (struct frame *f, struct input_event
*ie)
ie->kind = DEICONIFY_EVENT;
XSETFRAME (ie->frame_or_window, f);
}
+ else if (state[0] == IconicState
+ /* _NET_WM_STATE_HIDDEN should be used if the window
+ manager supports that. */
+ && !x_wm_supports (f, dpyinfo->Xatom_net_wm_state_hidden))
+ {
+ /* The frame is actually iconified right now. Mark it as
+ such. */
+
+ SET_FRAME_VISIBLE (f, 0);
+ SET_FRAME_ICONIFIED (f, true);
+
+ ie->kind = ICONIFY_EVENT;
+ XSETFRAME (ie->frame_or_window, f);
+ }
/* state[0] can also be WithdrawnState, meaning that the window has
been withdrawn and is no longer iconified. However, Emacs sets
@@ -18858,8 +18918,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
x_real_positions (f, &f->left_pos, &f->top_pos);
/* Perhaps reparented due to a WM restart. Reset this. */
- FRAME_DISPLAY_INFO (f)->wm_type = X_WMTYPE_UNKNOWN;
- FRAME_DISPLAY_INFO (f)->net_supported_window = 0;
+ dpyinfo->wm_type = X_WMTYPE_UNKNOWN;
+ dpyinfo->net_supported_window = 0;
#ifndef USE_GTK
/* The window manager could have restarted and the new
@@ -18887,11 +18947,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
goto OTHER;
case Expose:
- f = x_window_to_frame (dpyinfo, event->xexpose.window);
+
#ifdef HAVE_XWIDGETS
{
- struct xwidget_view *xv =
- xwidget_view_from_window (event->xexpose.window);
+ struct xwidget_view *xv;
+
+ xv = xwidget_view_from_window (event->xexpose.window);
if (xv)
{
@@ -18900,6 +18961,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
}
#endif
+
+ f = x_window_to_frame (dpyinfo, event->xexpose.window);
if (f)
{
if (!FRAME_VISIBLE_P (f))
@@ -19328,7 +19391,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
*finish = X_EVENT_DROP;
#endif
- xkey.state |= x_emacs_to_x_modifiers (FRAME_DISPLAY_INFO (f),
+ xkey.state |= x_emacs_to_x_modifiers (dpyinfo,
extra_keyboard_modifiers);
modifiers = xkey.state;
@@ -19445,7 +19508,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
/* Common for all keysym input events. */
XSETFRAME (inev.ie.frame_or_window, f);
inev.ie.modifiers
- = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers);
+ = x_x_to_emacs_modifiers (dpyinfo, modifiers);
inev.ie.timestamp = xkey.time;
/* First deal with keysyms which have defined
@@ -19703,28 +19766,16 @@ handle_one_xevent (struct x_display_info *dpyinfo,
case EnterNotify:
x_display_set_last_user_time (dpyinfo, event->xcrossing.time,
- event->xcrossing.send_event, false);
-
-#ifdef HAVE_XINPUT2
- /* For whatever reason, the X server continues to deliver
- EnterNotify and LeaveNotify events despite us selecting for
- related XI_Enter and XI_Leave events. It's not just our
- problem, since windows created by "xinput test-xi2" suffer
- from the same defect. Simply ignore all such events while
- the input extension is enabled. (bug#57468) */
-
- if (dpyinfo->supports_xi2)
- goto OTHER;
-#endif
-
- if (x_top_window_to_frame (dpyinfo, event->xcrossing.window))
- x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+ event->xcrossing.send_event,
+ false);
#ifdef HAVE_XWIDGETS
{
- struct xwidget_view *xvw = xwidget_view_from_window
(event->xcrossing.window);
+ struct xwidget_view *xvw;
Mouse_HLInfo *hlinfo;
+ xvw = xwidget_view_from_window (event->xcrossing.window);
+
if (xvw)
{
xwidget_motion_or_crossing (xvw, event);
@@ -19738,14 +19789,28 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
if (any_help_event_p)
- {
- do_help = -1;
- }
+ do_help = -1;
+
goto OTHER;
}
}
#endif
+#ifdef HAVE_XINPUT2
+ /* For whatever reason, the X server continues to deliver
+ EnterNotify and LeaveNotify events despite us selecting for
+ related XI_Enter and XI_Leave events. It's not just our
+ problem, since windows created by "xinput test-xi2" suffer
+ from the same defect. Simply ignore all such events while
+ the input extension is enabled. (bug#57468) */
+
+ if (dpyinfo->supports_xi2)
+ goto OTHER;
+#endif
+
+ if (x_top_window_to_frame (dpyinfo, event->xcrossing.window))
+ x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+
f = any;
if (f && event->xcrossing.window == FRAME_X_WINDOW (f))
@@ -19838,12 +19903,27 @@ 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
{
- struct xwidget_view *xvw = xwidget_view_from_window
(event->xcrossing.window);
+ struct xwidget_view *xvw;
+
+ xvw = xwidget_view_from_window (event->xcrossing.window);
if (xvw)
{
@@ -19856,6 +19936,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. */
@@ -20198,7 +20283,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
f = 0;
#endif
#ifdef HAVE_XWIDGETS
- struct xwidget_view *xvw = xwidget_view_from_window
(event->xmotion.window);
+ struct xwidget_view *xvw;
+
+ xvw = xwidget_view_from_window (event->xmotion.window);
if (xvw)
xwidget_motion_or_crossing (xvw, event);
@@ -20649,7 +20736,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
event->xbutton.send_event, true);
#ifdef HAVE_XWIDGETS
- struct xwidget_view *xvw = xwidget_view_from_window
(event->xbutton.window);
+ struct xwidget_view *xvw;
+
+ xvw = xwidget_view_from_window (event->xbutton.window);
if (xvw)
{
@@ -20773,7 +20862,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
event->xbutton.time);
}
else if (x_dnd_last_seen_window != None
- && x_dnd_last_protocol_version != -1)
+ && x_dnd_last_protocol_version != -1)
{
x_dnd_pending_finish_target = x_dnd_last_seen_toplevel;
x_dnd_waiting_for_finish_proto =
x_dnd_last_protocol_version;
@@ -21308,16 +21397,16 @@ handle_one_xevent (struct x_display_info *dpyinfo,
&& enter->mode != XINotifyGrab
&& enter->mode != XINotifyPassiveGrab
&& enter->mode != XINotifyPassiveUngrab)
- xi_reset_scroll_valuators_for_device_id (dpyinfo,
enter->deviceid,
- true);
+ xi_reset_scroll_valuators_for_device_id (dpyinfo,
+ enter->deviceid);
#endif
{
#ifdef HAVE_XWIDGETS
- struct xwidget_view *xwidget_view = xwidget_view_from_window
(enter->event);
-#endif
+ struct xwidget_view *xwidget_view;
+
+ xwidget_view = xwidget_view_from_window (enter->event);
-#ifdef HAVE_XWIDGETS
if (xwidget_view)
{
xwidget_motion_or_crossing (xwidget_view, event);
@@ -21422,13 +21511,18 @@ handle_one_xevent (struct x_display_info *dpyinfo,
retrieve the value of a valuator outside of each motion
event.
- As such, to prevent wildly inaccurate results when the
- valuators have changed outside Emacs, we reset our
- records of each valuator's value whenever the pointer
- moves out of a frame (and not into one of its
- children, which we know about). */
+ As such, to prevent wildly inaccurate results when
+ the valuators have changed outside Emacs, we reset
+ our records of each valuator's value whenever the
+ pointer moves out of a frame. Ideally, this would
+ ignore events with a detail of XINotifyInferior, as
+ the window the pointer moved to would be one known to
+ Emacs, but the code to keep track of which valuators
+ had to be reset upon the corresponding XI_Enter event
+ was very complicated and kept running into server
+ bugs. */
#ifdef HAVE_XINPUT2_1
- if (leave->detail != XINotifyInferior && any
+ if (any
/* xfwm4 selects for button events on the frame
window, resulting in passive grabs being
generated along with the delivery of emulated
@@ -21443,7 +21537,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
&& leave->mode != XINotifyPassiveUngrab
&& leave->mode != XINotifyPassiveGrab)
xi_reset_scroll_valuators_for_device_id (dpyinfo,
- leave->deviceid,
false);
+ leave->deviceid);
#endif
x_display_set_last_user_time (dpyinfo, leave->time,
@@ -21451,8 +21545,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#ifdef HAVE_XWIDGETS
{
- struct xwidget_view *xvw
- = xwidget_view_from_window (leave->event);
+ struct xwidget_view *xvw;
+
+ xvw = xwidget_view_from_window (leave->event);
if (xvw)
{
@@ -21479,13 +21574,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
just looks up a top window on Xt builds. */
#ifdef HAVE_XINPUT2_1
- if (leave->detail != XINotifyInferior && f
- && leave->mode != XINotifyUngrab
+ if (f && leave->mode != XINotifyUngrab
&& leave->mode != XINotifyGrab
&& leave->mode != XINotifyPassiveUngrab
&& leave->mode != XINotifyPassiveGrab)
xi_reset_scroll_valuators_for_device_id (dpyinfo,
- leave->deviceid,
false);
+ leave->deviceid);
#endif
if (!f)
@@ -23755,8 +23849,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
xi_compute_root_window_offset_pinch (any, pev);
inev.ie.kind = PINCH_EVENT;
- inev.ie.modifiers = x_x_to_emacs_modifiers
(FRAME_DISPLAY_INFO (any),
-
pev->mods.effective);
+ inev.ie.modifiers
+ = x_x_to_emacs_modifiers (dpyinfo, pev->mods.effective);
+
XSETINT (inev.ie.x, lrint (pev->event_x));
XSETINT (inev.ie.y, lrint (pev->event_y));
XSETFRAME (inev.ie.frame_or_window, any);
@@ -24250,7 +24345,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;
}
@@ -27290,6 +27390,7 @@ static void
x_focus_frame (struct frame *f, bool noactivate)
{
struct x_display_info *dpyinfo;
+ Time time;
dpyinfo = FRAME_DISPLAY_INFO (f);
@@ -27315,16 +27416,25 @@ x_focus_frame (struct frame *f, bool noactivate)
/* Ignore any BadMatch error this request might result in. */
x_ignore_errors_for_next_request (dpyinfo);
if (NILP (Vx_no_window_manager))
- XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- /* 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. */
- RevertToParent, dpyinfo->last_user_time);
+ {
+ /* 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
@@ -28273,7 +28383,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)
@@ -28300,11 +28412,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);
@@ -28764,27 +28879,6 @@ xi_check_toolkit (Display *display)
#endif
-#ifdef HAVE_XFIXES
-
-/* Create and return a special window for receiving events such as
- selection notify events. The window is an 1x1 unmapped
- override-redirect InputOnly window at -1, -1, which should prevent
- it from doing anything. */
-
-static Window
-x_create_special_window (struct x_display_info *dpyinfo)
-{
- XSetWindowAttributes attrs;
-
- attrs.override_redirect = True;
-
- return XCreateWindow (dpyinfo->display, dpyinfo->root_window,
- -1, -1, 1, 1, 0, CopyFromParent, InputOnly,
- CopyFromParent, CWOverrideRedirect, &attrs);
-}
-
-#endif
-
/* 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
@@ -29800,7 +29894,7 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
dpyinfo->n_monitored_selections = num_fast_selections;
dpyinfo->selection_tracking_window
- = x_create_special_window (dpyinfo);
+ = x_create_special_window (dpyinfo, dpyinfo->root_window);
dpyinfo->monitored_selections
= xmalloc (num_fast_selections
* sizeof *dpyinfo->monitored_selections);
@@ -30183,11 +30277,6 @@ x_delete_terminal (struct terminal *terminal)
closing all the displays. */
XrmDestroyDatabase (dpyinfo->rdb);
#endif
-
-#ifdef HAVE_XKB
- if (dpyinfo->xkb_desc)
- XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True);
-#endif
#ifdef USE_GTK
xg_display_close (dpyinfo->display);
#else
@@ -30197,9 +30286,6 @@ x_delete_terminal (struct terminal *terminal)
XCloseDisplay (dpyinfo->display);
#endif
#endif /* ! USE_GTK */
-
- if (dpyinfo->modmap)
- XFreeModifiermap (dpyinfo->modmap);
/* Do not close the connection here because it's already closed
by X(t)CloseDisplay (Bug#18403). */
dpyinfo->display = NULL;
@@ -30212,6 +30298,18 @@ x_delete_terminal (struct terminal *terminal)
else if (dpyinfo->connection >= 0)
emacs_close (dpyinfo->connection);
+ /* Free the keyboard and modifier maps here; that is safe to do
+ without a display, and not doing so leads to a lot of data being
+ leaked upon IO error. */
+
+#ifdef HAVE_XKB
+ if (dpyinfo->xkb_desc)
+ XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True);
+#endif
+
+ if (dpyinfo->modmap)
+ XFreeModifiermap (dpyinfo->modmap);
+
/* No more input on this descriptor. */
delete_keyboard_wait_descriptor (dpyinfo->connection);
/* Mark as dead. */
@@ -31007,10 +31105,16 @@ connection setup. */);
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. 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):
+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.
diff --git a/src/xterm.h b/src/xterm.h
index 0f00dc42f7..1124dcceb4 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -213,20 +213,32 @@ struct color_name_cache_entry
#ifdef HAVE_XINPUT2
#ifdef HAVE_XINPUT2_1
+
struct xi_scroll_valuator_t
{
- bool invalid_p;
- bool pending_enter_reset;
+ /* The ID of the valuator. */
+ int number;
+
+ /* Whether or not it represents X axis movement. */
+ bool_bf horizontal : 1;
+
+ /* Whether or not the value is currently invalid. */
+ bool_bf invalid_p : 1;
+
+ /* The current value. */
double current_value;
+
+ /* Value used to tally up deltas until a threshold is met. */
double emacs_value;
- double increment;
- int number;
- int horizontal;
+ /* The scroll increment. */
+ double increment;
};
+
#endif
#ifdef HAVE_XINPUT2_2
+
struct xi_touch_point_t
{
struct xi_touch_point_t *next;
@@ -234,6 +246,7 @@ struct xi_touch_point_t
int number;
double x, y;
};
+
#endif
struct xi_device_t
@@ -295,8 +308,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
{
@@ -1696,8 +1708,12 @@ 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 (struct frame *, int, int, int *, int *);
extern void x_translate_coordinates_to_root (struct frame *, int, int,
int *, int *);
+extern Lisp_Object x_handle_translate_coordinates (struct frame *, Lisp_Object,
+ 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/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 4bbff6d057..568820ec42 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -507,7 +507,7 @@ This expects `auto-revert--messages' to be bound by
(should (equal (auto-revert-test--buffer-string buf-1) "1-a"))
(auto-revert-test--write-file "1-b" file-1)
;; Since the file is deleted, it needs at least
- ;; `autorevert-interval' to recognize the new file,
+ ;; `auto-revert-interval' to recognize the new file,
;; while polling. So increase the timeout.
(auto-revert-test--wait-for-buffer-text
buf-1 "1-b" (* 2 (auto-revert--timeout)))
diff --git a/test/lisp/elide-head-tests.el b/test/lisp/elide-head-tests.el
index 6f351170f1..429ef26657 100644
--- a/test/lisp/elide-head-tests.el
+++ b/test/lisp/elide-head-tests.el
@@ -3,7 +3,6 @@
;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
-;; Keywords:
;; This file is part of GNU Emacs.
@@ -20,10 +19,6 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;; Commentary:
-
-;;
-
;;; Code:
(require 'elide-head)
@@ -169,6 +164,22 @@
***************************************************************************/
" "This program is distributed in the hope that")
+;; from mentor.el [no "/" in the gnu.org URL]
+(elide-head--add-test gpl3-5 "\
+;; Mentor 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, or (at your option)
+;; any later version.
+;;
+;; Mentor 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 Mentor. If not, see <https://www.gnu.org/licenses>.
+" "Mentor is distributed in the hope that")
+
;;; GPLv2
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/cconv-tests.el
b/test/lisp/emacs-lisp/cconv-tests.el
index 37470f863f..e666fe0a4c 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -351,11 +351,18 @@
(let ((f (let ((d 51695))
(lambda (data)
(interactive (progn (setq d (1+ d)) (list d)))
- (list (called-interactively-p 'any) data)))))
- (should (equal (list (call-interactively f)
- (funcall f 51695)
- (call-interactively f))
- '((t 51696) (nil 51695) (t 51697))))))
+ (list (called-interactively-p 'any) data))))
+ (f-interp
+ (eval '(let ((d 51695))
+ (lambda (data)
+ (interactive (progn (setq d (1+ d)) (list d)))
+ (list (called-interactively-p 'any) data)))
+ t)))
+ (dolist (f (list f f-interp))
+ (should (equal (list (call-interactively f)
+ (funcall f 51695)
+ (call-interactively f))
+ '((t 51696) (nil 51695) (t 51697)))))))
(provide 'cconv-tests)
;;; cconv-tests.el ends here
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/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/hierarchy-tests.el
b/test/lisp/emacs-lisp/hierarchy-tests.el
index 41d3f2f3cc..97a0f7ba52 100644
--- a/test/lisp/emacs-lisp/hierarchy-tests.el
+++ b/test/lisp/emacs-lisp/hierarchy-tests.el
@@ -552,5 +552,148 @@
(hierarchy-sort organisms)
(should (equal (hierarchy-roots organisms) '(animal plant)))))
+(defun hierarchy-examples-delayed--find-number (num)
+ "Find a number, NUM, by adding 1s together until you reach it.
+This is entire contrived and mostly meant to be purposefully inefficient to
+not be possible on a large scale.
+Running the number 200 causes this function to crash; running this function in
+`hierarchy-add-tree' with a root of 80 and no delayed children causes that to
+ crash.
+If generating hierarchy children is not delayed, tests for that functionality
+should fail as this function will crash."
+
+ (funcall (lambda (funct) (funcall funct 1 funct))
+ (lambda (n funct)
+ (if (< n num)
+ (+ 1 (funcall funct (+ 1 n) funct))
+ 1))))
+
+(defun hierarchy-examples-delayed--childrenfn (hier-elem)
+ "Return the children of HIER-ELEM.
+Basially, feed the number, minus 1, to
`hierarchy-examples-delayed--find-number'
+and then create a list of the number plus 0.0–0.9."
+
+ (when (> hier-elem 1)
+ (let ((next (hierarchy-examples-delayed--find-number (1- hier-elem))))
+ (mapcar (lambda (dec) (+ next dec)) '(.0 .1 .2 .3 .4 .5 .6 .7 .8 .9)))))
+
+(ert-deftest hierarchy-delayed-add-one-root ()
+ (let ((parentfn (lambda (_) nil))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(190)))))
+
+(ert-deftest hierarchy-delayed-add-one-item-with-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(191)))
+ (should (equal (hierarchy-children hierarchy 191) '(190)))
+ (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-one-item-with-parent-and-grand-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191)
+ (191 192))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(192)))
+ (should (equal (hierarchy-children hierarchy 192) '(191)))
+ (should (equal (hierarchy-children hierarchy 191) '(190)))
+ (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-same-root-twice ()
+ (let ((parentfn (lambda (_) nil))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(190)))))
+
+(ert-deftest hierarchy-delayed-add-same-child-twice ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(191)))
+ (should (equal (hierarchy-children hierarchy 191) '(190)))
+ (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-item-and-its-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (hierarchy-add-tree hierarchy 191 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(191)))
+ (should (equal (hierarchy-children hierarchy 191) '(190)))
+ (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-item-and-its-child ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 191 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(191)))
+ (should (equal (hierarchy-children hierarchy 191) '(190)))
+ (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-two-items-sharing-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191)
+ (190.5 191))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (hierarchy-add-tree hierarchy 190.5 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(191)))
+ (should (equal (hierarchy-children hierarchy 191) '(190 190.5)))))
+
+(ert-deftest hierarchy-delayed-add-two-hierarchies ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191)
+ (circle 'shape))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (hierarchy-add-tree hierarchy 'circle parentfn)
+ (should (equal (hierarchy-roots hierarchy) '(191 shape)))
+ (should (equal (hierarchy-children hierarchy 191) '(190)))
+ (should (equal (hierarchy-children hierarchy 'shape) '(circle)))))
+
+(ert-deftest hierarchy-delayed-add-trees ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 '191)
+ (190.5 '191)
+ (191 '192))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-trees hierarchy '(190 190.5) parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(192)))
+ (should (equal (hierarchy-children hierarchy '192) '(191)))
+ (should (equal (hierarchy-children hierarchy '191) '(190 190.5)))))
+
(provide 'hierarchy-tests)
;;; hierarchy-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/international/textsec-tests.el
b/test/lisp/international/textsec-tests.el
index 6b0773dc40..1f7fb97a6b 100644
--- a/test/lisp/international/textsec-tests.el
+++ b/test/lisp/international/textsec-tests.el
@@ -77,7 +77,7 @@
(should (eq (textsec-restriction-level "切foo")
'highly-restrictive))
(should (eq (textsec-restriction-level "հfoo")
- 'moderately-retrictive))
+ 'moderately-restrictive))
(should (eq (textsec-restriction-level "Сirсlе")
'unrestricted)))
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/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index 81c9217c62..8330525394 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -46,10 +46,7 @@ always located at the beginning of buffer."
(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)))))
+ (while (not (python-util-comint-end-of-output-p))
(sit-for 0.1))))
(defmacro python-tests-with-temp-buffer-with-shell (contents &rest body)
@@ -4478,6 +4475,21 @@ print('Hello')
(insert "u")
(should-not (nth 2 (python-completion-at-point))))))
+(ert-deftest python-completion-at-point-while-running-1 ()
+ "Should not try to complete when a program is running in the Shell buffer."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import time
+
+time.sleep(3)
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (goto-char (point-max))
+ (insert "time.")
+ (should-not (with-timeout (1 t) (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
@@ -4552,6 +4564,31 @@ import abc
;;; FFAP
+(ert-deftest python-ffap-module-path-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)
+ (should (file-exists-p (python-ffap-module-path "abc"))))))
+
+(ert-deftest python-ffap-module-path-while-running-1 ()
+ "Should not get module path when a program is running in the Shell buffer."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+import time
+
+time.sleep(3)
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (should-not (with-timeout (1 t) (python-ffap-module-path "abc"))))))
+
;;; Code check
@@ -4615,6 +4652,32 @@ some_symbol some_other_symbol
(should (string= (python-eldoc--get-symbol-at-point)
"some_symbol"))))
+(ert-deftest python-eldoc--get-doc-at-point-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import time
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (python-tests-look-at "time")
+ (should (python-eldoc--get-doc-at-point)))))
+
+(ert-deftest python-eldoc--get-doc-at-point-while-running-1 ()
+ "Should not get documentation when a program is running in the Shell buffer."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import time
+
+time.sleep(3)
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (python-tests-look-at "time")
+ (should-not (with-timeout (1 t) (python-eldoc--get-doc-at-point))))))
+
;;; Imenu
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/manual/noverlay/.gitignore b/test/manual/noverlay/.gitignore
new file mode 100644
index 0000000000..ca7fc452b8
--- /dev/null
+++ b/test/manual/noverlay/.gitignore
@@ -0,0 +1 @@
+itree-tests
diff --git a/test/manual/noverlay/Makefile.in b/test/manual/noverlay/Makefile.in
new file mode 100644
index 0000000000..beef1dbc09
--- /dev/null
+++ b/test/manual/noverlay/Makefile.in
@@ -0,0 +1,32 @@
+PROGRAM = itree-tests
+LIBS = check
+top_srcdir = @top_srcdir@
+CFLAGS += -O0 -g3 $(shell pkg-config --cflags $(LIBS)) -I $(top_srcdir)/src
+LDFLAGS += $(shell pkg-config --libs $(LIBS)) -lm
+OBJECTS = itree-tests.o
+CC = gcc
+EMACS ?= ../../../src/emacs
+
+.PHONY: all check have-libcheck
+
+all: check
+
+have-libcheck:
+ pkg-config --cflags $(LIBS)
+
+check: have-libcheck $(PROGRAM)
+ ./check-sanitize.sh ./$(PROGRAM)
+
+itree-tests.o: emacs-compat.h itree-tests.c $(top_srcdir)/src/itree.c
$(top_srcdir)/src/itree.h
+
+$(PROGRAM): $(OBJECTS)
+ $(CC) $(CFLAGS) $(LDFLAGS) $(OBJECTS) -o $(PROGRAM)
+
+perf:
+ -$(EMACS) -Q -l ./overlay-perf.el -f perf-run-batch
+
+clean:
+ rm -f -- $(OBJECTS) $(PROGRAM)
+
+distclean: clean
+ rm -f -- Makefile
diff --git a/test/manual/noverlay/check-sanitize.sh
b/test/manual/noverlay/check-sanitize.sh
new file mode 100755
index 0000000000..03eedce8a6
--- /dev/null
+++ b/test/manual/noverlay/check-sanitize.sh
@@ -0,0 +1,11 @@
+#!/bin/bash
+
+prog=$1
+shift
+
+[ -z "$prog" ] && {
+ echo "usage:$(basename $0) CHECK_PRGOGRAM";
+ exit 1;
+}
+
+"$prog" "$@" | sed -e 's/^\([^:]\+\):\([0-9]\+\):[PFE]:[^:]*:\([^:]*\):[^:]*:
*\(.*\)/\1:\2:\3:\4/'
diff --git a/test/manual/noverlay/emacs-compat.h
b/test/manual/noverlay/emacs-compat.h
new file mode 100644
index 0000000000..812f8e48a3
--- /dev/null
+++ b/test/manual/noverlay/emacs-compat.h
@@ -0,0 +1,52 @@
+#ifndef TEST_COMPAT_H
+#define TEST_COMPAT_H
+
+#include <stdio.h>
+#include <limits.h>
+
+typedef int Lisp_Object;
+
+void *
+xmalloc (size_t size)
+{
+ return malloc (size);
+}
+
+void
+xfree (void *ptr)
+{
+ free (ptr);
+}
+
+void *
+xrealloc (void *block, size_t size)
+{
+ return realloc (block, size);
+}
+
+void
+emacs_abort ()
+{
+ fprintf (stderr, "Aborting...\n");
+ exit (1);
+}
+
+#ifndef eassert
+#define eassert(cond) \
+ do { \
+ if (! (cond)) { \
+ fprintf (stderr, "\n%s:%d:eassert condition failed: %s\n", \
+ __FILE__, __LINE__ ,#cond); \
+ exit (1); \
+ } \
+ } while (0)
+#endif
+
+#ifndef max
+#define max(x,y) ((x) >= (y) ? (x) : (y))
+#endif
+#ifndef min
+#define min(x,y) ((x) <= (y) ? (x) : (y))
+#endif
+
+#endif
diff --git a/test/manual/noverlay/itree-tests.c
b/test/manual/noverlay/itree-tests.c
new file mode 100644
index 0000000000..a318389213
--- /dev/null
+++ b/test/manual/noverlay/itree-tests.c
@@ -0,0 +1,1381 @@
+#include <config.h>
+#include <check.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include "emacs-compat.h"
+
+#define EMACS_LISP_H /* lisp.h inclusion guard */
+#define ITREE_DEBUG 1
+#define ITREE_TESTING
+#include "itree.c"
+
+/* Basic tests of the interval_tree data-structure. */
+
+/*
+===================================================================================+
+ * | Insert
+ *
+===================================================================================+
*/
+
+/* The graphs below display the trees after each insertion (as they
+ should be). See the source code for the different cases
+ applied. */
+
+#define N_50 (n[0])
+#define N_30 (n[1])
+#define N_20 (n[2])
+#define N_10 (n[3])
+#define N_15 (n[4])
+#define N_05 (n[5])
+
+#define DEF_TEST_SETUP() \
+ struct interval_tree tree; \
+ struct interval_node n[6]; \
+ interval_tree_init (&tree); \
+ const int values[] = {50, 30, 20, 10, 15, 5}; \
+ for (int i = 0; i < 6; ++i) \
+ { \
+ n[i].begin = values[i]; \
+ n[i].end = values[i]; \
+ }
+
+START_TEST (test_insert_1)
+{
+ /*
+ * [50]
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (&N_50 == tree.root);
+}
+END_TEST
+
+START_TEST (test_insert_2)
+{
+ /*
+ * [50]
+ * /
+ * (30)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_30);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_RED);
+ ck_assert (&N_50 == tree.root);
+ ck_assert (N_30.parent == &N_50);
+ ck_assert (N_50.left == &N_30);
+ ck_assert (N_50.right == &tree.nil);
+ ck_assert (N_30.left == &tree.nil);
+ ck_assert (N_30.right == &tree.nil);
+}
+END_TEST
+
+START_TEST (test_insert_3)
+{
+ /* case 3.a
+ * [30]
+ * / \
+ * (20) (50)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_30);
+ interval_tree_insert (&tree, &N_20);
+ ck_assert (N_50.color == ITREE_RED);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_20.color == ITREE_RED);
+ ck_assert (&N_30 == tree.root);
+ ck_assert (N_50.parent == &N_30);
+ ck_assert (N_30.right == &N_50);
+ ck_assert (N_30.left == &N_20);
+ ck_assert (N_20.left == &tree.nil);
+ ck_assert (N_20.right == &tree.nil);
+ ck_assert (N_20.parent == &N_30);
+}
+END_TEST
+
+START_TEST (test_insert_4)
+{
+ /* 1.a
+ * [30]
+ * / \
+ * [20] [50]
+ * /
+ * (10)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_30);
+ interval_tree_insert (&tree, &N_20);
+ interval_tree_insert (&tree, &N_10);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_20.color == ITREE_BLACK);
+ ck_assert (N_10.color == ITREE_RED);
+ ck_assert (&N_30 == tree.root);
+ ck_assert (N_50.parent == &N_30);
+ ck_assert (N_30.right == &N_50);
+ ck_assert (N_30.left == &N_20);
+ ck_assert (N_20.left == &N_10);
+ ck_assert (N_20.right == &tree.nil);
+ ck_assert (N_20.parent == &N_30);
+ ck_assert (N_10.parent == &N_20);
+ ck_assert (N_20.left == &N_10);
+ ck_assert (N_10.right == &tree.nil);
+}
+END_TEST
+
+START_TEST (test_insert_5)
+{
+ /* 2.a
+ * [30]
+ * / \
+ * [15] [50]
+ * / \
+ * (10) (20)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_30);
+ interval_tree_insert (&tree, &N_20);
+ interval_tree_insert (&tree, &N_10);
+ interval_tree_insert (&tree, &N_15);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_20.color == ITREE_RED);
+ ck_assert (N_10.color == ITREE_RED);
+ ck_assert (N_15.color == ITREE_BLACK);
+ ck_assert (&N_30 == tree.root);
+ ck_assert (N_50.parent == &N_30);
+ ck_assert (N_30.right == &N_50);
+ ck_assert (N_30.left == &N_15);
+ ck_assert (N_20.left == &tree.nil);
+ ck_assert (N_20.right == &tree.nil);
+ ck_assert (N_20.parent == &N_15);
+ ck_assert (N_10.parent == &N_15);
+ ck_assert (N_20.left == &tree.nil);
+ ck_assert (N_10.right == &tree.nil);
+ ck_assert (N_15.right == &N_20);
+ ck_assert (N_15.left == &N_10);
+ ck_assert (N_15.parent == &N_30);
+
+}
+END_TEST
+
+START_TEST (test_insert_6)
+{
+ /* 1.a
+ * [30]
+ * / \
+ * (15) [50]
+ * / \
+ * [10] [20]
+ * /
+ * (5)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_30);
+ interval_tree_insert (&tree, &N_20);
+ interval_tree_insert (&tree, &N_10);
+ interval_tree_insert (&tree, &N_15);
+ interval_tree_insert (&tree, &N_05);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_20.color == ITREE_BLACK);
+ ck_assert (N_10.color == ITREE_BLACK);
+ ck_assert (N_15.color == ITREE_RED);
+ ck_assert (N_05.color == ITREE_RED);
+ ck_assert (&N_30 == tree.root);
+ ck_assert (N_50.parent == &N_30);
+ ck_assert (N_30.right == &N_50);
+ ck_assert (N_30.left == &N_15);
+ ck_assert (N_20.left == &tree.nil);
+ ck_assert (N_20.right == &tree.nil);
+ ck_assert (N_20.parent == &N_15);
+ ck_assert (N_10.parent == &N_15);
+ ck_assert (N_20.left == &tree.nil);
+ ck_assert (N_10.right == &tree.nil);
+ ck_assert (N_15.right == &N_20);
+ ck_assert (N_15.left == &N_10);
+ ck_assert (N_15.parent == &N_30);
+ ck_assert (N_05.parent == &N_10);
+ ck_assert (N_10.left == &N_05);
+ ck_assert (N_05.right == &tree.nil);
+}
+END_TEST
+
+#undef N_50
+#undef N_30
+#undef N_20
+#undef N_10
+#undef N_15
+#undef N_05
+#undef DEF_TEST_SETUP
+
+
+
+/* These are the mirror cases to the above ones. */
+
+#define N_50 (n[0])
+#define N_70 (n[1])
+#define N_80 (n[2])
+#define N_90 (n[3])
+#define N_85 (n[4])
+#define N_95 (n[5])
+
+#define DEF_TEST_SETUP() \
+ struct interval_tree tree; \
+ struct interval_node n[6]; \
+ interval_tree_init (&tree); \
+ const int values[] = {50, 70, 80, 90, 85, 95}; \
+ for (int i = 0; i < 6; ++i) \
+ { \
+ n[i].begin = values[i]; \
+ n[i].end = values[i]; \
+ }
+
+START_TEST (test_insert_7)
+{
+ /*
+ * [50]
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (&N_50 == tree.root);
+}
+END_TEST
+
+START_TEST (test_insert_8)
+{
+ /*
+ * [50]
+ * \
+ * (70)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_70);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (N_70.color == ITREE_RED);
+ ck_assert (&N_50 == tree.root);
+ ck_assert (N_70.parent == &N_50);
+ ck_assert (N_50.right == &N_70);
+ ck_assert (N_50.left == &tree.nil);
+ ck_assert (N_70.right == &tree.nil);
+ ck_assert (N_70.left == &tree.nil);
+}
+END_TEST
+
+START_TEST (test_insert_9)
+{
+ /* 3.a
+ * [70]
+ * / \
+ * (50) (80)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_70);
+ interval_tree_insert (&tree, &N_80);
+ ck_assert (N_50.color == ITREE_RED);
+ ck_assert (N_70.color == ITREE_BLACK);
+ ck_assert (N_80.color == ITREE_RED);
+ ck_assert (&N_70 == tree.root);
+ ck_assert (N_50.parent == &N_70);
+ ck_assert (N_70.right == &N_80);
+ ck_assert (N_70.left == &N_50);
+ ck_assert (N_80.right == &tree.nil);
+ ck_assert (N_80.left == &tree.nil);
+ ck_assert (N_80.parent == &N_70);
+}
+END_TEST
+
+START_TEST (test_insert_10)
+{
+ /* 1.b
+ * [70]
+ * / \
+ * [50] [80]
+ * \
+ * (90)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_70);
+ interval_tree_insert (&tree, &N_80);
+ interval_tree_insert (&tree, &N_90);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (N_70.color == ITREE_BLACK);
+ ck_assert (N_80.color == ITREE_BLACK);
+ ck_assert (N_90.color == ITREE_RED);
+ ck_assert (&N_70 == tree.root);
+ ck_assert (N_50.parent == &N_70);
+ ck_assert (N_70.right == &N_80);
+ ck_assert (N_70.left == &N_50);
+ ck_assert (N_80.right == &N_90);
+ ck_assert (N_80.left == &tree.nil);
+ ck_assert (N_80.parent == &N_70);
+ ck_assert (N_90.parent == &N_80);
+ ck_assert (N_80.right == &N_90);
+ ck_assert (N_90.left == &tree.nil);
+}
+END_TEST
+
+START_TEST (test_insert_11)
+{
+ /* 2.b
+ * [70]
+ * / \
+ * [50] [85]
+ * / \
+ * (80) (90)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_70);
+ interval_tree_insert (&tree, &N_80);
+ interval_tree_insert (&tree, &N_90);
+ interval_tree_insert (&tree, &N_85);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (N_70.color == ITREE_BLACK);
+ ck_assert (N_80.color == ITREE_RED);
+ ck_assert (N_90.color == ITREE_RED);
+ ck_assert (N_85.color == ITREE_BLACK);
+ ck_assert (&N_70 == tree.root);
+ ck_assert (N_50.parent == &N_70);
+ ck_assert (N_70.right == &N_85);
+ ck_assert (N_70.left == &N_50);
+ ck_assert (N_80.right == &tree.nil);
+ ck_assert (N_80.left == &tree.nil);
+ ck_assert (N_80.parent == &N_85);
+ ck_assert (N_90.parent == &N_85);
+ ck_assert (N_80.right == &tree.nil);
+ ck_assert (N_90.left == &tree.nil);
+ ck_assert (N_85.right == &N_90);
+ ck_assert (N_85.left == &N_80);
+ ck_assert (N_85.parent == &N_70);
+
+}
+END_TEST
+
+START_TEST (test_insert_12)
+{
+ /* 1.b
+ * [70]
+ * / \
+ * [50] (85)
+ * / \
+ * [80] [90]
+ * \
+ * (95)
+ */
+
+ DEF_TEST_SETUP ();
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_70);
+ interval_tree_insert (&tree, &N_80);
+ interval_tree_insert (&tree, &N_90);
+ interval_tree_insert (&tree, &N_85);
+ interval_tree_insert (&tree, &N_95);
+ ck_assert (N_50.color == ITREE_BLACK);
+ ck_assert (N_70.color == ITREE_BLACK);
+ ck_assert (N_80.color == ITREE_BLACK);
+ ck_assert (N_90.color == ITREE_BLACK);
+ ck_assert (N_85.color == ITREE_RED);
+ ck_assert (N_95.color == ITREE_RED);
+ ck_assert (&N_70 == tree.root);
+ ck_assert (N_50.parent == &N_70);
+ ck_assert (N_70.right == &N_85);
+ ck_assert (N_70.left == &N_50);
+ ck_assert (N_80.right == &tree.nil);
+ ck_assert (N_80.left == &tree.nil);
+ ck_assert (N_80.parent == &N_85);
+ ck_assert (N_90.parent == &N_85);
+ ck_assert (N_80.right == &tree.nil);
+ ck_assert (N_90.left == &tree.nil);
+ ck_assert (N_85.right == &N_90);
+ ck_assert (N_85.left == &N_80);
+ ck_assert (N_85.parent == &N_70);
+ ck_assert (N_95.parent == &N_90);
+ ck_assert (N_90.right == &N_95);
+ ck_assert (N_95.left == &tree.nil);
+}
+END_TEST
+
+#undef N_50
+#undef N_70
+#undef N_80
+#undef N_90
+#undef N_85
+#undef N_95
+#undef DEF_TEST_SETUP
+
+struct interval_tree*
+test_get_tree4 (struct interval_node **n)
+{
+ static struct interval_tree tree;
+ static struct interval_node nodes[4];
+ memset (&tree, 0, sizeof (struct interval_tree));
+ memset (&nodes, 0, 4 * sizeof (struct interval_node));
+ interval_tree_init (&tree);
+ for (int i = 0; i < 4; ++i)
+ {
+ nodes[i].begin = 10 * (i + 1);
+ nodes[i].end = nodes[i].begin;
+ interval_tree_insert (&tree, &nodes[i]);
+ }
+ *n = nodes;
+ return &tree;
+}
+
+static void
+shuffle (int *index, int n)
+{
+ for (int i = n - 1; i >= 0; --i)
+ {
+ int j = random () % (i + 1);
+ int h = index[j];
+ index[j] = index[i];
+ index[i] = h;
+ }
+}
+
+#define N_10 (nodes[0])
+#define N_20 (nodes[1])
+#define N_30 (nodes[2])
+#define N_40 (nodes[3])
+
+START_TEST (test_insert_13)
+{
+ struct interval_node *nodes = NULL;
+ struct interval_tree *tree = test_get_tree4 (&nodes);
+
+
+ ck_assert (tree->root == &N_20);
+ ck_assert (N_20.left == &N_10);
+ ck_assert (N_20.right == &N_30);
+ ck_assert (N_30.right == &N_40);
+ ck_assert (N_10.color == ITREE_BLACK);
+ ck_assert (N_20.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_40.color == ITREE_RED);
+}
+END_TEST
+
+START_TEST (test_insert_14)
+{
+ struct interval_tree tree;
+ struct interval_node nodes[3];
+
+ nodes[0].begin = nodes[1].begin = nodes[2].begin = 10;
+ nodes[0].end = nodes[1].end = nodes[2].end = 10;
+
+ for (int i = 0; i < 3; ++i)
+ interval_tree_insert (&tree, &nodes[i]);
+ for (int i = 0; i < 3; ++i)
+ ck_assert (interval_tree_contains (&tree, &nodes[i]));
+}
+END_TEST
+
+
+
+
+/*
+===================================================================================+
+ * | Remove
+ *
+===================================================================================+
*/
+
+#define A (nodes[0])
+#define B (nodes[1])
+#define C (nodes[2])
+#define D (nodes[3])
+#define E (nodes[4])
+
+/* Creating proper test trees for the formal tests via insertions is
+ way to tedious, so we just fake it and only test the
+ fix-routine. */
+#define DEF_TEST_SETUP() \
+ struct interval_tree tree; \
+ struct interval_node nodes[5]; \
+ interval_tree_init (&tree); \
+ tree.root = &B; \
+ A.parent = &B; B.parent = &tree.nil; C.parent = &D; \
+ D.parent = &B; E.parent = &D; \
+ A.left = A.right = C.left = C.right = &tree.nil; \
+ E.left = E.right = &tree.nil; \
+ B.left = &A; B.right = &D; D.left = &C; D.right = &E \
+
+/* 1.a -> 2.a
+ * [B]
+ * / \
+ * [A] (D)
+ * / \
+ * [C] [E]
+ */
+
+
+START_TEST (test_remove_1)
+{
+ DEF_TEST_SETUP ();
+ B.color = A.color = C.color = E.color = ITREE_BLACK;
+ D.color = ITREE_RED;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_RED);
+ ck_assert (D.color == ITREE_BLACK);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.left == &A);
+ ck_assert (B.right == &C);
+ ck_assert (C.parent == &B);
+ ck_assert (E.parent == &D);
+ ck_assert (D.right == &E);
+ ck_assert (D.left == &B);
+ ck_assert (tree.root == &D);
+}
+END_TEST
+
+/* 2.a */
+START_TEST (test_remove_2)
+{
+ DEF_TEST_SETUP ();
+ B.color = D.color = A.color = C.color = E.color = ITREE_BLACK;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_BLACK);
+ ck_assert (D.color == ITREE_RED);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.left == &A);
+ ck_assert (B.right == &D);
+ ck_assert (C.parent == &D);
+ ck_assert (E.parent == &D);
+ ck_assert (tree.root == &B);
+}
+END_TEST
+
+/* 3.a -> 4.a*/
+START_TEST (test_remove_3)
+{
+ DEF_TEST_SETUP ();
+ D.color = A.color = E.color = ITREE_BLACK;
+ B.color = C.color = ITREE_RED;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_BLACK);
+ ck_assert (D.color == ITREE_BLACK);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.left == &A);
+ ck_assert (B.right == &tree.nil);
+ ck_assert (&C == tree.root);
+ ck_assert (C.left == &B);
+ ck_assert (C.right == &D);
+ ck_assert (E.parent == &D);
+ ck_assert (D.left == &tree.nil);
+
+}
+END_TEST
+
+/* 4.a */
+START_TEST (test_remove_4)
+{
+ DEF_TEST_SETUP ();
+ B.color = C.color = E.color = ITREE_RED;
+ A.color = D.color = ITREE_BLACK;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_RED);
+ ck_assert (D.color == ITREE_BLACK);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.left == &A);
+ ck_assert (B.right == &C);
+ ck_assert (C.parent == &B);
+ ck_assert (E.parent == &D);
+ ck_assert (tree.root == &D);
+}
+END_TEST
+
+
+#undef A
+#undef B
+#undef C
+#undef D
+#undef E
+#undef DEF_TEST_SETUP
+
+
+
+/* These are the mirrored cases. */
+
+#define A (nodes[0])
+#define B (nodes[1])
+#define C (nodes[2])
+#define D (nodes[3])
+#define E (nodes[4])
+
+#define DEF_TEST_SETUP() \
+ struct interval_tree tree; \
+ struct interval_node nodes[5]; \
+ interval_tree_init (&tree); \
+ tree.root = &B; \
+ A.parent = &B; B.parent = &tree.nil; C.parent = &D; \
+ D.parent = &B; E.parent = &D; \
+ A.right = A.left = C.right = C.left = &tree.nil; \
+ E.right = E.left = &tree.nil; \
+ B.right = &A; B.left = &D; D.right = &C; D.left = &E \
+
+/* 1.b -> 2.b
+ * [B]
+ * / \
+ * [A] (D)
+ * / \
+ * [C] [E]
+ */
+
+
+START_TEST (test_remove_5)
+{
+ DEF_TEST_SETUP ();
+ B.color = A.color = C.color = E.color = ITREE_BLACK;
+ D.color = ITREE_RED;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_RED);
+ ck_assert (D.color == ITREE_BLACK);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.right == &A);
+ ck_assert (B.left == &C);
+ ck_assert (C.parent == &B);
+ ck_assert (E.parent == &D);
+ ck_assert (D.left == &E);
+ ck_assert (D.right == &B);
+ ck_assert (tree.root == &D);
+}
+END_TEST
+
+/* 2.b */
+START_TEST (test_remove_6)
+{
+ DEF_TEST_SETUP ();
+ B.color = D.color = A.color = C.color = E.color = ITREE_BLACK;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_BLACK);
+ ck_assert (D.color == ITREE_RED);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.right == &A);
+ ck_assert (B.left == &D);
+ ck_assert (C.parent == &D);
+ ck_assert (E.parent == &D);
+ ck_assert (tree.root == &B);
+}
+END_TEST
+
+/* 3.b -> 4.b*/
+START_TEST (test_remove_7)
+{
+ DEF_TEST_SETUP ();
+ D.color = A.color = E.color = ITREE_BLACK;
+ B.color = C.color = ITREE_RED;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_BLACK);
+ ck_assert (D.color == ITREE_BLACK);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.right == &A);
+ ck_assert (B.left == &tree.nil);
+ ck_assert (&C == tree.root);
+ ck_assert (C.right == &B);
+ ck_assert (C.left == &D);
+ ck_assert (E.parent == &D);
+ ck_assert (D.right == &tree.nil);
+
+}
+END_TEST
+
+/* 4.b */
+START_TEST (test_remove_8)
+{
+ DEF_TEST_SETUP ();
+ B.color = C.color = E.color = ITREE_RED;
+ A.color = D.color = ITREE_BLACK;
+ interval_tree_remove_fix (&tree, &A);
+
+ ck_assert (A.color == ITREE_BLACK);
+ ck_assert (B.color == ITREE_BLACK);
+ ck_assert (C.color == ITREE_RED);
+ ck_assert (D.color == ITREE_BLACK);
+ ck_assert (E.color == ITREE_BLACK);
+ ck_assert (A.parent == &B);
+ ck_assert (B.right == &A);
+ ck_assert (B.left == &C);
+ ck_assert (C.parent == &B);
+ ck_assert (E.parent == &D);
+ ck_assert (tree.root == &D);
+}
+END_TEST
+
+
+#undef A
+#undef B
+#undef C
+#undef D
+#undef E
+#undef DEF_TEST_SETUP
+
+
+START_TEST (test_remove_9)
+{
+ struct interval_node *nodes = NULL;
+ struct interval_tree *tree = test_get_tree4 (&nodes);
+
+ ck_assert (tree->root == &N_20);
+ ck_assert (N_20.left == &N_10);
+ ck_assert (N_20.right == &N_30);
+ ck_assert (N_30.right == &N_40);
+ ck_assert (N_20.color == ITREE_BLACK);
+ ck_assert (N_10.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_40.color == ITREE_RED);
+
+ interval_tree_remove (tree, &N_10);
+
+ ck_assert (tree->root == &N_30);
+ ck_assert (N_30.parent == &tree->nil);
+ ck_assert (N_30.left == &N_20);
+ ck_assert (N_30.right == &N_40);
+ ck_assert (N_20.color == ITREE_BLACK);
+ ck_assert (N_30.color == ITREE_BLACK);
+ ck_assert (N_40.color == ITREE_BLACK);
+}
+END_TEST
+
+#define N 3
+
+START_TEST (test_remove_10)
+{
+ struct interval_tree tree;
+ struct interval_node nodes[N];
+ int index[N];
+
+ srand (42);
+ interval_tree_init (&tree);
+ for (int i = 0; i < N; ++i)
+ {
+ nodes[i].begin = (i + 1) * 10;
+ nodes[i].end = nodes[i].begin + 1;
+ index[i] = i;
+ }
+ shuffle (index, N);
+ for (int i = 0; i < N; ++i)
+ interval_tree_insert (&tree, &nodes[index[i]]);
+
+ shuffle (index, N);
+ for (int i = 0; i < N; ++i)
+ {
+ ck_assert (interval_tree_contains (&tree, &nodes[index[i]]));
+ interval_tree_remove (&tree, &nodes[index[i]]);
+ }
+ ck_assert (tree.root == &tree.nil);
+ ck_assert (tree.size == 0);
+}
+END_TEST
+
+
+/*
+===================================================================================+
+ * | Generator
+ *
+===================================================================================+
*/
+
+START_TEST (test_generator_1)
+{
+ struct interval_tree tree;
+ struct interval_node node, *n;
+ struct interval_generator *g;
+ interval_tree_init (&tree);
+ node.begin = 10;
+ node.end = 20;
+ interval_tree_insert (&tree, &node);
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 0, 30, ITREE_ASCENDING);
+ n = interval_generator_next (g);
+ ck_assert (n == &node);
+ ck_assert (n->begin == 10 && n->end == 20);
+ ck_assert (interval_generator_next (g) == NULL);
+ ck_assert (interval_generator_next (g) == NULL);
+ ck_assert (interval_generator_next (g) == NULL);
+ interval_generator_destroy (g);
+
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 30, 50, ITREE_ASCENDING);
+ ck_assert (interval_generator_next (g) == NULL);
+ ck_assert (interval_generator_next (g) == NULL);
+ ck_assert (interval_generator_next (g) == NULL);
+ interval_generator_destroy (g);
+}
+END_TEST
+
+void
+test_check_generator (struct interval_tree *tree,
+ ptrdiff_t begin, ptrdiff_t end,
+ int n, ...)
+{
+ va_list ap;
+ struct interval_generator *g = interval_generator_create (tree);
+ interval_generator_reset (g, begin, end, ITREE_ASCENDING);
+
+ va_start (ap, n);
+ for (int i = 0; i < n; ++i)
+ {
+ ptrdiff_t begin = va_arg (ap, ptrdiff_t);
+ struct interval_node *node = interval_generator_next (g);
+ ck_assert (node);
+ ck_assert_int_eq (node->begin, begin);
+ }
+ va_end (ap);
+ ck_assert (! interval_generator_next (g));
+ ck_assert (! interval_generator_next (g));
+ interval_generator_destroy (g);
+}
+
+#define DEF_TEST_SETUP() \
+
+
+START_TEST (test_generator_2)
+{
+ struct interval_tree tree;
+ struct interval_node nodes[3];
+
+ interval_tree_init (&tree);
+
+ for (int i = 0; i < 3; ++i) {
+ nodes[i].begin = 10 * (i + 1);
+ nodes[i].end = 10 * (i + 2);
+ interval_tree_insert (&tree, &nodes[i]);
+ }
+
+ test_check_generator (&tree, 0, 50, 3,
+ 10, 20, 30);
+ test_check_generator (&tree, 0, 10, 0);
+ test_check_generator (&tree, 40, 50, 0);
+ test_check_generator (&tree, 15, 35, 3,
+ 10, 20, 30);
+ test_check_generator (&tree, -100, -50, 0);
+ test_check_generator (&tree, -100, -50, 0);
+ test_check_generator (&tree, 100, 50, 0);
+ test_check_generator (&tree, 100, 150, 0);
+ test_check_generator (&tree, 0, 0, 0);
+ test_check_generator (&tree, 40, 40, 0);
+ test_check_generator (&tree, 30, 30, 0);
+ test_check_generator (&tree, 35, 35, 1,
+ 30);
+}
+END_TEST
+
+
+struct interval_node*
+test_create_tree (struct interval_tree *tree, int n,
+ bool doshuffle, ...)
+{
+ va_list ap;
+ struct interval_node *nodes = calloc (n, sizeof (struct interval_node));
+ int *index = calloc (n, sizeof (int));
+
+ interval_tree_init (tree);
+ va_start (ap, doshuffle);
+ for (int i = 0; i < n; ++i)
+ {
+ ptrdiff_t begin = va_arg (ap, ptrdiff_t);
+ ptrdiff_t end = va_arg (ap, ptrdiff_t);
+ nodes[i].begin = begin;
+ nodes[i].end = end;
+ index[i] = i;
+ }
+ va_end (ap);
+ srand (42);
+ if (doshuffle)
+ shuffle (index, n);
+ for (int i = 0; i < n; ++i)
+ interval_tree_insert (tree, &nodes[index[i]]);
+ free (index);
+
+ return nodes;
+}
+
+START_TEST (test_generator_3)
+{
+ struct interval_tree tree;
+ struct interval_node *nodes = NULL;
+
+ nodes = test_create_tree (&tree, 3, true,
+ 10, 10,
+ 10, 10,
+ 10, 10);
+ test_check_generator (&tree, 0, 10, 0);
+ test_check_generator (&tree, 10, 10, 3, 10, 10, 10);
+ test_check_generator (&tree, 10, 20, 3, 10, 10, 10);
+ free (nodes);
+}
+END_TEST
+
+#define FOREACH(n, g) \
+ for ((n) = interval_generator_next (g); (n) != NULL; \
+ (n) = interval_generator_next (g))
+
+START_TEST (test_generator_5)
+{
+ struct interval_tree tree;
+ struct interval_node *nodes;
+ struct interval_generator *g;
+ nodes = test_create_tree (&tree, 4, false,
+ 10, 30,
+ 20, 40,
+ 30, 50,
+ 40, 60);
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 0, 100, ITREE_PRE_ORDER);
+ for (int i = 0; i < 4; ++i)
+ {
+ struct interval_node *n = interval_generator_next (g);
+ ck_assert (n);
+ switch (i)
+ {
+ case 0: ck_assert_int_eq (20, n->begin); break;
+ case 1: ck_assert_int_eq (10, n->begin); break;
+ case 2: ck_assert_int_eq (30, n->begin); break;
+ case 3: ck_assert_int_eq (40, n->begin); break;
+ }
+ }
+ interval_generator_destroy (g);
+ free (nodes);
+
+}
+END_TEST
+
+START_TEST (test_generator_6)
+{
+ struct interval_tree tree;
+ struct interval_node *nodes;
+ struct interval_generator *g;
+ nodes = test_create_tree (&tree, 4, true,
+ 10, 30,
+ 20, 40,
+ 30, 50,
+ 40, 60);
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 0, 100, ITREE_ASCENDING);
+ for (int i = 0; i < 4; ++i)
+ {
+ struct interval_node *n = interval_generator_next (g);
+ ck_assert (n);
+ switch (i)
+ {
+ case 0: ck_assert_int_eq (10, n->begin); break;
+ case 1: ck_assert_int_eq (20, n->begin); break;
+ case 2: ck_assert_int_eq (30, n->begin); break;
+ case 3: ck_assert_int_eq (40, n->begin); break;
+ }
+ }
+ interval_generator_destroy (g);
+ free (nodes);
+
+}
+END_TEST
+
+START_TEST (test_generator_7)
+{
+ struct interval_tree tree;
+ struct interval_node *nodes;
+ struct interval_generator *g;
+ nodes = test_create_tree (&tree, 4, true,
+ 10, 30,
+ 20, 40,
+ 30, 50,
+ 40, 60);
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 0, 100, ITREE_DESCENDING);
+ for (int i = 0; i < 4; ++i)
+ {
+ struct interval_node *n = interval_generator_next (g);
+ ck_assert (n);
+ switch (i)
+ {
+ case 0: ck_assert_int_eq (40, n->begin); break;
+ case 1: ck_assert_int_eq (30, n->begin); break;
+ case 2: ck_assert_int_eq (20, n->begin); break;
+ case 3: ck_assert_int_eq (10, n->begin); break;
+ }
+ }
+ interval_generator_destroy (g);
+ free (nodes);
+
+}
+END_TEST
+
+START_TEST (test_generator_8)
+{
+ struct interval_tree tree;
+ struct interval_node *nodes, *n;
+ struct interval_generator *g;
+ nodes = test_create_tree (&tree, 2, false,
+ 20, 30,
+ 40, 50);
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 1, 60, ITREE_DESCENDING);
+ n = interval_generator_next (g);
+ ck_assert_int_eq (n->begin, 40);
+ interval_generator_narrow (g, 50, 60);
+ n = interval_generator_next (g);
+ ck_assert (n == NULL);
+ free (nodes);
+}
+END_TEST
+
+
+START_TEST (test_generator_9)
+{
+ struct interval_tree tree;
+ struct interval_node *nodes, *n;
+ struct interval_generator *g;
+ nodes = test_create_tree (&tree, 2, false,
+ 25, 25,
+ 20, 30);
+ g = interval_generator_create (&tree);
+ interval_generator_reset (g, 1, 30, ITREE_DESCENDING);
+ n = interval_generator_next (g);
+ ck_assert_int_eq (n->begin, 25);
+ interval_generator_narrow (g, 25, 35);
+ n = interval_generator_next (g);
+ ck_assert_int_eq (n->begin, 20);
+ free (nodes);
+}
+END_TEST
+
+
+/*
+===================================================================================+
+ * | Insert Gap
+ *
+===================================================================================+
*/
+
+static struct interval_tree gap_tree;
+static struct interval_node gap_node;
+
+#define N_BEG (interval_tree_validate (&gap_tree, &gap_node)->begin)
+#define N_END (interval_tree_validate (&gap_tree, &gap_node)->end)
+
+static void
+test_setup_gap_node (ptrdiff_t begin, ptrdiff_t end,
+ bool front_advance, bool rear_advance)
+{
+ interval_tree_init (&gap_tree);
+ gap_node.begin = begin;
+ gap_node.end = end;
+ gap_node.front_advance = front_advance;
+ gap_node.rear_advance = rear_advance;
+ interval_tree_insert (&gap_tree, &gap_node);
+}
+
+static void
+test_setup_gap_node_noadvance (ptrdiff_t begin, ptrdiff_t end)
+{
+ test_setup_gap_node (begin, end, false, false);
+}
+
+START_TEST (test_gap_insert_1)
+{
+ test_setup_gap_node (100, 200, false, false);
+ interval_tree_insert_gap (&gap_tree, 100 + 10, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200 + 20);
+}
+END_TEST
+
+START_TEST (test_gap_insert_2)
+{
+ test_setup_gap_node (100, 200, false, false);
+ interval_tree_insert_gap (&gap_tree, 300, 10);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200);
+}
+END_TEST
+
+START_TEST (test_gap_insert_3)
+{
+ test_setup_gap_node (100, 200, false, false);
+ interval_tree_insert_gap (&gap_tree, 0, 15);
+ ck_assert_int_eq (N_BEG, 100 + 15);
+ ck_assert_int_eq (N_END, 200 + 15);
+}
+END_TEST
+
+START_TEST (test_gap_insert_4)
+{
+ test_setup_gap_node (100, 200, true, false);
+ interval_tree_insert_gap (&gap_tree, 100, 20);
+ ck_assert_int_eq (N_BEG, 100 + 20);
+ ck_assert_int_eq (N_END, 200 + 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_5)
+{
+ test_setup_gap_node (100, 200, false, false);
+ interval_tree_insert_gap (&gap_tree, 100, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200 + 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_6)
+{
+ test_setup_gap_node (100, 200, false, true);
+ interval_tree_insert_gap (&gap_tree, 200, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200 + 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_7)
+{
+ test_setup_gap_node (100, 200, false, false);
+ interval_tree_insert_gap (&gap_tree, 200, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_8)
+{
+ test_setup_gap_node (100, 100, true, true);
+ interval_tree_insert_gap (&gap_tree, 100, 20);
+ ck_assert_int_eq (N_BEG, 100 + 20);
+ ck_assert_int_eq (N_END, 100 + 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_9)
+{
+ test_setup_gap_node (100, 100, false, true);
+ interval_tree_insert_gap (&gap_tree, 100, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 100 + 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_10)
+{
+ test_setup_gap_node (100, 100, true, false);
+ interval_tree_insert_gap (&gap_tree, 100, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 100);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_11)
+{
+ test_setup_gap_node (100, 100, false, false);
+ interval_tree_insert_gap (&gap_tree, 100, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 100);
+
+}
+END_TEST
+
+
+/*
+===================================================================================+
+ * | Delete Gap
+ *
+===================================================================================+
*/
+
+START_TEST (test_gap_delete_1)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ interval_tree_delete_gap (&gap_tree, 100 + 10, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200 - 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_delete_2)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ interval_tree_delete_gap (&gap_tree, 200 + 10, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200);
+
+}
+END_TEST
+
+START_TEST (test_gap_delete_3)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ interval_tree_delete_gap (&gap_tree, 200, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200);
+
+}
+END_TEST
+
+START_TEST (test_gap_delete_4)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ interval_tree_delete_gap (&gap_tree, 100 - 20, 20);
+ ck_assert_int_eq (N_BEG, 100 - 20);
+ ck_assert_int_eq (N_END, 200 - 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_delete_5)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ interval_tree_delete_gap (&gap_tree, 70, 20);
+ ck_assert_int_eq (N_BEG, 100 - 20);
+ ck_assert_int_eq (N_END, 200 - 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_delete_6)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ interval_tree_delete_gap (&gap_tree, 80, 100);
+ ck_assert_int_eq (N_BEG, 80);
+ ck_assert_int_eq (N_END, 100);
+}
+END_TEST
+
+START_TEST (test_gap_delete_7)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ interval_tree_delete_gap (&gap_tree, 120, 100);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 120);
+}
+END_TEST
+
+START_TEST (test_gap_delete_8)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ interval_tree_delete_gap (&gap_tree, 100 - 20, 200 + 20);
+ ck_assert_int_eq (N_BEG, 100 - 20);
+ ck_assert_int_eq (N_END, 100 - 20);
+
+}
+END_TEST
+
+
+
+Suite * basic_suite ()
+{
+ Suite *s = suite_create ("basic_suite");
+ TCase *tc = tcase_create ("basic_test");
+
+ tcase_add_test (tc, test_insert_1);
+ tcase_add_test (tc, test_insert_2);
+ tcase_add_test (tc, test_insert_3);
+ tcase_add_test (tc, test_insert_4);
+ tcase_add_test (tc, test_insert_5);
+ tcase_add_test (tc, test_insert_6);
+ tcase_add_test (tc, test_insert_7);
+ tcase_add_test (tc, test_insert_8);
+ tcase_add_test (tc, test_insert_9);
+ tcase_add_test (tc, test_insert_10);
+ tcase_add_test (tc, test_insert_11);
+ tcase_add_test (tc, test_insert_12);
+ tcase_add_test (tc, test_insert_13);
+
+ tcase_add_test (tc, test_remove_1);
+ tcase_add_test (tc, test_remove_2);
+ tcase_add_test (tc, test_remove_3);
+ tcase_add_test (tc, test_remove_4);
+ tcase_add_test (tc, test_remove_5);
+ tcase_add_test (tc, test_remove_6);
+ tcase_add_test (tc, test_remove_7);
+ tcase_add_test (tc, test_remove_8);
+ tcase_add_test (tc, test_remove_9);
+ tcase_add_test (tc, test_remove_10);
+
+ tcase_add_test (tc, test_generator_1);
+ tcase_add_test (tc, test_generator_2);
+ tcase_add_test (tc, test_generator_3);
+ tcase_add_test (tc, test_generator_5);
+ tcase_add_test (tc, test_generator_6);
+ tcase_add_test (tc, test_generator_7);
+ tcase_add_test (tc, test_generator_8);
+ tcase_add_test (tc, test_generator_9);
+
+ tcase_add_test (tc, test_gap_insert_1);
+ tcase_add_test (tc, test_gap_insert_2);
+ tcase_add_test (tc, test_gap_insert_3);
+ tcase_add_test (tc, test_gap_insert_4);
+ tcase_add_test (tc, test_gap_insert_5);
+ tcase_add_test (tc, test_gap_insert_6);
+ tcase_add_test (tc, test_gap_insert_7);
+ tcase_add_test (tc, test_gap_insert_8);
+ tcase_add_test (tc, test_gap_insert_9);
+ tcase_add_test (tc, test_gap_insert_10);
+ tcase_add_test (tc, test_gap_insert_11);
+
+ tcase_add_test (tc, test_gap_delete_1);
+ tcase_add_test (tc, test_gap_delete_2);
+ tcase_add_test (tc, test_gap_delete_3);
+ tcase_add_test (tc, test_gap_delete_4);
+ tcase_add_test (tc, test_gap_delete_5);
+ tcase_add_test (tc, test_gap_delete_6);
+ tcase_add_test (tc, test_gap_delete_7);
+ tcase_add_test (tc, test_gap_delete_8);
+
+ /* tcase_set_timeout (tc, 120); */
+ suite_add_tcase (s, tc);
+ return s;
+}
+
+int
+main (void)
+{
+ int nfailed;
+ Suite *s = basic_suite ();
+ SRunner *sr = srunner_create (s);
+
+ srunner_run_all (sr, CK_NORMAL);
+ nfailed = srunner_ntests_failed (sr);
+ srunner_free (sr);
+ return (nfailed == 0) ? EXIT_SUCCESS : EXIT_FAILURE;
+}
diff --git a/test/manual/noverlay/many-errors.py
b/test/manual/noverlay/many-errors.py
new file mode 100644
index 0000000000..fa4ef5f98d
--- /dev/null
+++ b/test/manual/noverlay/many-errors.py
@@ -0,0 +1,2480 @@
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
diff --git a/test/manual/noverlay/overlay-perf.el
b/test/manual/noverlay/overlay-perf.el
new file mode 100644
index 0000000000..e84941c08f
--- /dev/null
+++ b/test/manual/noverlay/overlay-perf.el
@@ -0,0 +1,764 @@
+;; -*- lexical-binding:t -*-
+(require 'cl-lib)
+(require 'subr-x)
+(require 'seq)
+(require 'hi-lock)
+
+
+;;
+===================================================================================+
+;; | Framework
+;;
+===================================================================================+
+
+(defmacro perf-define-constant-test (name &optional doc &rest body)
+ (declare (indent 1) (debug (symbol &optional string &rest form)))
+ `(progn
+ (put ',name 'perf-constant-test t)
+ (defun ,name nil ,doc ,@body)))
+
+(defmacro perf-define-variable-test (name args &optional doc &rest body)
+ (declare (indent 2) (debug defun))
+ (unless (and (consp args)
+ (= (length args) 1))
+ (error "Function %s should accept exactly one argument." name))
+ `(progn
+ (put ',name 'perf-variable-test t)
+ (defun ,name ,args ,doc ,@body)))
+
+(defmacro perf-define-test-suite (name &rest tests)
+ (declare (indent 1))
+ `(put ',name 'perf-test-suite
+ ,(cons 'list tests)))
+
+(defun perf-constant-test-p (test)
+ (get test 'perf-constant-test))
+
+(defun perf-variable-test-p (test)
+ (get test 'perf-variable-test))
+
+(defun perf-test-suite-p (suite)
+ (not (null (perf-test-suite-elements suite))))
+
+(defun perf-test-suite-elements (suite)
+ (get suite 'perf-test-suite))
+
+(defun perf-expand-suites (test-and-suites)
+ (apply #' append (mapcar (lambda (elt)
+ (if (perf-test-suite-p elt)
+ (perf-test-suite-elements elt)
+ (list elt)))
+ test-and-suites)))
+(defun perf-test-p (symbol)
+ (or (perf-variable-test-p symbol)
+ (perf-constant-test-p symbol)))
+
+(defun perf-all-tests ()
+ (let (result)
+ (mapatoms (lambda (symbol)
+ (when (and (fboundp symbol)
+ (perf-test-p symbol))
+ (push symbol result))))
+ (sort result #'string-lessp)))
+
+(defvar perf-default-test-argument 4096)
+
+(defun perf-run-1 (&optional k n &rest tests)
+ "Run TESTS K times using N as argument for non-constant ones.
+
+Return test-total elapsed time."
+ (random "")
+ (when (and n (not (numberp n)))
+ (push k tests)
+ (push n tests)
+ (setq n nil k nil))
+ (when (and k (not (numberp k)))
+ (push k tests)
+ (setq k nil))
+ (let* ((k (or k 1))
+ (n (or n perf-default-test-argument))
+ (tests (perf-expand-suites (or tests
+ (perf-all-tests))))
+ (variable-tests (seq-filter #'perf-variable-test-p tests))
+ (constant-tests (seq-filter #'perf-constant-test-p tests))
+ (max-test-string-width (perf-max-symbol-length tests)))
+ (unless (seq-every-p #'perf-test-p tests)
+ (error "Some of these are not tests: %s" tests))
+ (cl-labels ((format-result (result)
+ (cond
+ ((numberp result) (format "%.2f" result))
+ ((stringp result) result)
+ ((null result) "N/A")))
+ (format-test (fn)
+ (concat (symbol-name fn)
+ (make-string
+ (+ (- max-test-string-width
+ (length (symbol-name fn)))
+ 1)
+ ?\s)))
+ (format-summary (results _total)
+ (let ((min (apply #'min results))
+ (max (apply #'max results))
+ (avg (/ (apply #'+ results) (float (length results)))))
+ (format "n=%d min=%.2f avg=%.2f max=%.2f" (length results)
min avg max)))
+ (run-test (fn)
+ (let ((total 0) results)
+ (dotimes (_ (max 0 k))
+ (garbage-collect)
+ (princ (concat " " (format-test fn)))
+ (let ((result (condition-case-unless-debug err
+ (cond
+ ((perf-variable-test-p fn)
+ (random "") (car (funcall fn n)))
+ ((perf-constant-test-p fn)
+ (random "") (car (funcall fn)))
+ (t "skip"))
+ (error (error-message-string err)))))
+ (when (numberp result)
+ (cl-incf total result)
+ (push result results))
+ (princ (format-result result))
+ (terpri)))
+ (when (> (length results) 1)
+ (princ (concat "#" (format-test fn)
+ (format-summary results total)))
+ (terpri)))))
+ (when variable-tests
+ (terpri)
+ (dolist (fn variable-tests)
+ (run-test fn)
+ (terpri)))
+ (when constant-tests
+ (dolist (fn constant-tests)
+ (run-test fn)
+ (terpri))))))
+
+(defun perf-run (&optional k n &rest tests)
+ (interactive
+ (let* ((n (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ perf-default-test-argument))
+ (tests (mapcar #'intern
+ (completing-read-multiple
+ (format "Run tests (n=%d): " n)
+ (perf-all-tests) nil t nil 'perf-test-history))))
+ (cons 1 (cons n tests))))
+ (with-current-buffer (get-buffer-create "*perf-results*")
+ (let ((inhibit-read-only t)
+ (standard-output (current-buffer)))
+ (erase-buffer)
+ (apply #'perf-run-1 k n tests)
+ (display-buffer (current-buffer)))))
+
+
+(defun perf-batch-parse-command-line (args)
+ (let ((k 1)
+ (n perf-default-test-argument)
+ tests)
+ (while args
+ (cond ((string-match-p "\\`-[cn]\\'" (car args))
+ (unless (and (cdr args)
+ (string-match-p "\\`[0-9]+\\'" (cadr args)))
+ (error "%s expectes a natnum argument" (car args)))
+ (if (equal (car args) "-c")
+ (setq k (string-to-number (cadr args)))
+ (setq n (string-to-number (cadr args))))
+ (setq args (cddr args)))
+ (t (push (intern (pop args)) tests))))
+ (list k n tests)))
+
+
+(defun perf-run-batch ()
+ "Runs tests from `command-line-args-left' and kill emacs."
+ (let ((standard-output #'external-debugging-output))
+ (condition-case err
+ (cl-destructuring-bind (k n tests)
+ (perf-batch-parse-command-line command-line-args-left)
+ (apply #'perf-run-1 k n tests)
+ (save-buffers-kill-emacs))
+ (error
+ (princ (error-message-string err))
+ (save-buffers-kill-emacs)))))
+
+(defconst perf-number-of-columns 70)
+
+(defun perf-insert-lines (n)
+ "Insert N lines into the current buffer."
+ (dotimes (i n)
+ (insert (make-string 70 (if (= (% i 2) 0)
+ ?.
+ ?O))
+ ?\n)))
+
+(defun perf-switch-to-buffer-scroll-random (n &optional buffer)
+ (interactive)
+ (set-window-buffer nil (or buffer (current-buffer)))
+ (goto-char (point-min))
+ (redisplay t)
+ (dotimes (_ n)
+ (goto-char (random (point-max)))
+ (recenter)
+ (redisplay t)))
+
+(defun perf-insert-overlays (n &optional create-callback random-p)
+ (if random-p
+ (perf-insert-overlays-random n create-callback)
+ (perf-insert-overlays-sequential n create-callback)))
+
+(defun perf-insert-overlays-sequential (n &optional create-callback)
+ "Insert an overlay every Nth line."
+ (declare (indent 1))
+ (let ((i 0)
+ (create-callback (or create-callback #'ignore)))
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (= 0 (% i n))
+ (let ((ov (make-overlay (point-at-bol) (point-at-eol))))
+ (funcall create-callback ov)
+ (overlay-put ov 'priority (random (buffer-size)))))
+ (cl-incf i)
+ (forward-line)))))
+
+(defun perf-insert-overlays-random (n &optional create-callback)
+ "Insert an overlay every Nth line."
+ (declare (indent 1))
+ (let ((create-callback (or create-callback #'ignore)))
+ (save-excursion
+ (while (>= (cl-decf n) 0)
+ (let* ((beg (1+ (random (point-max))))
+ (ov (make-overlay beg (+ beg (random 70)))))
+ (funcall create-callback ov)
+ (overlay-put ov 'priority (random (buffer-size))))))))
+
+(defun perf-insert-overlays-hierarchical (n &optional create-callback)
+ (let ((create-callback (or create-callback #'ignore)))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((spacing (floor (/ (/ (count-lines (point-min) (point-max))
+ (float 3))
+ n))))
+ (when (< spacing 1)
+ (error "Hierarchical overlay overflow !!"))
+ (dotimes (i n)
+ (funcall create-callback
+ (make-overlay (point)
+ (save-excursion
+ (goto-char (point-max))
+ (forward-line (- (* spacing i)))
+ (point))))
+
+ (when (eobp)
+ (error "End of buffer in hierarchical overlays"))
+ (forward-line spacing))))))
+
+(defun perf-overlay-ascii-chart (&optional buffer width)
+ (interactive)
+ (save-current-buffer
+ (when buffer (set-buffer buffer))
+ (unless width (setq width 100))
+ (let* ((ovl (sort (overlays-in (point-min) (point-max))
+ (lambda (ov1 ov2)
+ (or (<= (overlay-start ov1)
+ (overlay-start ov2))
+ (and
+ (= (overlay-start ov1)
+ (overlay-start ov2))
+ (< (overlay-end ov1)
+ (overlay-end ov2)))))))
+ (ov-width (apply #'max (mapcar (lambda (ov)
+ (- (overlay-end ov)
+ (overlay-start ov)))
+ ovl)))
+ (ov-min (apply #'min (mapcar #'overlay-start ovl)))
+ (ov-max (apply #'max (mapcar #'overlay-end ovl)))
+ (scale (/ (float width) (+ ov-min ov-width))))
+ (with-current-buffer (get-buffer-create "*overlay-ascii-chart*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (buffer-disable-undo)
+ (insert (format "%06d%s%06d\n" ov-min (make-string (- width 12) ?\s)
ov-max))
+ (dolist (ov ovl)
+ (let ((length (round (* scale (- (overlay-end ov)
+ (overlay-start ov))))))
+ (insert (make-string (round (* scale (overlay-start ov))) ?\s))
+ (cl-case length
+ (0 (insert "O"))
+ (1 (insert "|"))
+ (t (insert (format "|%s|" (make-string (- length 2) ?-)))))
+ (insert "\n")))
+ (goto-char (point-min)))
+ (read-only-mode 1)
+ (pop-to-buffer (current-buffer))))))
+
+(defconst perf-overlay-faces (mapcar #'intern (seq-take hi-lock-face-defaults
3)))
+
+(defun perf-overlay-face-callback (ov)
+ (overlay-put ov 'face (nth (random (length perf-overlay-faces))
+ perf-overlay-faces)))
+
+(defun perf-overlay-invisible-callback (ov)
+ (overlay-put ov 'invisble (= 1 (random 2))))
+
+(defun perf-overlay-display-callback (ov)
+ (overlay-put ov 'display (make-string 70 ?*)))
+
+(defmacro perf-define-display-test (overlay-type property-type scroll-type)
+ (let ((name (intern (format "perf-display-%s/%s/%s"
+ overlay-type property-type scroll-type)))
+ (arg (make-symbol "n")))
+
+ `(perf-define-variable-test ,name (,arg)
+ (with-temp-buffer
+ (perf-insert-lines ,arg)
+ (overlay-recenter (point-max))
+ ,@(perf-define-display-test-1 arg overlay-type property-type
scroll-type)))))
+
+(defun perf-define-display-test-1 (arg overlay-type property-type scroll-type)
+ (list (append (cl-case overlay-type
+ (sequential
+ (list 'perf-insert-overlays-sequential 2))
+ (hierarchical
+ `(perf-insert-overlays-hierarchical (/ ,arg 10)))
+ (random
+ `(perf-insert-overlays-random (/ ,arg 2)))
+ (t (error "Invalid insert type: %s" overlay-type)))
+ (list
+ (cl-case property-type
+ (display '#'perf-overlay-display-callback)
+ (face '#'perf-overlay-face-callback)
+ (invisible '#'perf-overlay-invisible-callback)
+ (t (error "Invalid overlay type: %s" overlay-type)))))
+ (list 'benchmark-run 1
+ (cl-case scroll-type
+ (scroll '(perf-switch-to-buffer-scroll-up-and-down))
+ (random `(perf-switch-to-buffer-scroll-random (/ ,arg 50)))
+ (t (error "Invalid scroll type: %s" overlay-type))))))
+
+(defun perf-max-symbol-length (symbols)
+ "Return the longest symbol in SYMBOLS, or -1 if symbols is nil."
+ (if (null symbols)
+ -1
+ (apply #'max (mapcar
+ (lambda (elt)
+ (length (symbol-name elt)))
+ symbols))))
+
+(defun perf-insert-text (n)
+ "Insert N character into the current buffer."
+ (let ((ncols 68)
+ (char ?.))
+ (dotimes (_ (/ n ncols))
+ (insert (make-string (1- ncols) char) ?\n))
+ (when (> (% n ncols) 0)
+ (insert (make-string (1- (% n ncols)) char) ?\n))))
+
+(defconst perf-insert-overlays-default-length 24)
+
+(defun perf-insert-overlays-scattered (n &optional length)
+ "Insert N overlays of max length 24 randomly."
+ (dotimes (_ n)
+ (let ((begin (random (1+ (point-max)))))
+ (make-overlay
+ begin (+ begin (random (1+ (or length
perf-insert-overlays-default-length 0))))))))
+
+(defvar perf-marker-gc-protection nil)
+
+(defun perf-insert-marker-scattered (n)
+ "Insert N marker randomly."
+ (setq perf-marker-gc-protection nil)
+ (dotimes (_ n)
+ (push (copy-marker (random (1+ (point-max))))
+ perf-marker-gc-protection)))
+
+(defun perf-switch-to-buffer-scroll-up-and-down (&optional buffer)
+ (interactive)
+ (set-window-buffer nil (or buffer (current-buffer)))
+ (goto-char (point-min))
+ (redisplay t)
+ (while (condition-case nil
+ (progn (scroll-up) t)
+ (end-of-buffer nil))
+ (redisplay t))
+ (while (condition-case nil
+ (progn (scroll-down) t)
+ (beginning-of-buffer nil))
+ (redisplay t)))
+
+(defun perf-emacs-lisp-setup ()
+ (add-to-list 'imenu-generic-expression
+ '(nil
"^\\s-*(perf-define\\(?:\\w\\|\\s_\\)*\\s-*\\(\\(?:\\w\\|\\s_\\)+\\)" 1)))
+
+(add-hook 'emacs-lisp-mode 'perf-emacs-lisp-setup)
+
+
+;;
+===================================================================================+
+;; | Basic performance tests
+;;
+===================================================================================+
+
+(perf-define-variable-test perf-make-overlay (n)
+ (with-temp-buffer
+ (overlay-recenter (point-min))
+ (benchmark-run 1
+ (dotimes (_ n)
+ (make-overlay 1 1)))))
+
+(perf-define-variable-test perf-make-overlay-continuous (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (overlay-recenter (point-max))
+ (benchmark-run 1
+ (dotimes (i n)
+ (make-overlay i (1+ i))))))
+
+(perf-define-variable-test perf-make-overlay-scatter (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (benchmark-run 1
+ (perf-insert-overlays-scattered n))))
+
+(perf-define-variable-test perf-delete-overlay (n)
+ (with-temp-buffer
+ (let ((ovls (cl-loop for i from 1 to n
+ collect (make-overlay 1 1))))
+ (overlay-recenter (point-min))
+ (benchmark-run 1
+ (mapc #'delete-overlay ovls)))))
+
+(perf-define-variable-test perf-delete-overlay-continuous (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (let ((ovls (cl-loop for i from 1 to n
+ collect (make-overlay i (1+ i)))))
+ (overlay-recenter (point-min))
+ (benchmark-run 1
+ (mapc #'delete-overlay ovls)))))
+
+(perf-define-variable-test perf-delete-overlay-scatter (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (let ((ovls (progn (perf-insert-overlays-scattered n)
+ (overlays-in (point-min) (point-max)))))
+ (benchmark-run 1
+ (mapc #'delete-overlay ovls)))))
+
+(perf-define-variable-test perf-overlays-at (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (benchmark-run 1
+ (dotimes (i (point-max))
+ (overlays-at i)))))
+
+(perf-define-variable-test perf-overlays-in (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (let ((len perf-insert-overlays-default-length))
+ (benchmark-run 1
+ (dotimes (i (- (point-max) len))
+ (overlays-in i (+ i len)))))))
+
+(perf-define-variable-test perf-insert-before (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (goto-char 1)
+ (overlay-recenter (point-min))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ (insert ?X)))))
+
+(perf-define-variable-test perf-insert-before-empty (n)
+ (let ((perf-insert-overlays-default-length 0))
+ (perf-insert-before n)))
+(perf-define-variable-test perf-insert-after-empty (n)
+ (let ((perf-insert-overlays-default-length 0))
+ (perf-insert-after n)))
+(perf-define-variable-test perf-insert-scatter-empty (n)
+ (let ((perf-insert-overlays-default-length 0))
+ (perf-insert-scatter n)))
+(perf-define-variable-test perf-delete-before-empty (n)
+ (let ((perf-insert-overlays-default-length 0))
+ (perf-delete-before n)))
+(perf-define-variable-test perf-delete-after-empty (n)
+ (let ((perf-insert-overlays-default-length 0))
+ (perf-delete-after n)))
+(perf-define-variable-test perf-delete-scatter-empty (n)
+ (let ((perf-insert-overlays-default-length 0))
+ (perf-delete-scatter n)))
+
+(defmacro perf-define-marker-test (type where)
+ (let ((name (intern (format "perf-%s-%s-marker" type where))))
+ `(perf-define-variable-test ,name (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-marker-scattered n)
+ (goto-char ,(cl-case where
+ (after (list 'point-max))
+ (t (list 'point-min))))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ ,@(when (eq where 'scatter)
+ (list '(goto-char (max 1 (random (point-max))))))
+ ,(cl-case type
+ (insert (list 'insert ?X))
+ (delete (list 'delete-char (if (eq where 'after) -1 1))))))))))
+
+(perf-define-test-suite perf-marker-suite
+ (perf-define-marker-test insert before)
+ (perf-define-marker-test insert after)
+ (perf-define-marker-test insert scatter)
+ (perf-define-marker-test delete before)
+ (perf-define-marker-test delete after)
+ (perf-define-marker-test delete scatter))
+
+(perf-define-variable-test perf-insert-after (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (goto-char (point-max))
+ (overlay-recenter (point-max))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ (insert ?X)))))
+
+(perf-define-variable-test perf-insert-scatter (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (goto-char (point-max))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ (goto-char (1+ (random (point-max))))
+ (insert ?X)))))
+
+(perf-define-variable-test perf-delete-before (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (goto-char 1)
+ (overlay-recenter (point-min))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ (delete-char 1)))))
+
+(perf-define-variable-test perf-delete-after (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (goto-char (point-max))
+ (overlay-recenter (point-max))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ (delete-char -1)))))
+
+(perf-define-variable-test perf-delete-scatter (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (goto-char (point-max))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ (goto-char (max 1 (random (point-max))))
+ (delete-char 1)))))
+
+(perf-define-test-suite perf-insert-delete-suite
+ 'perf-insert-before
+ 'perf-insert-after
+ 'perf-insert-scatter
+ 'perf-delete-before
+ 'perf-delete-after
+ 'perf-delete-scatter
+ )
+
+
+;;
+===================================================================================+
+;; | Redisplay (new)
+;;
+===================================================================================+
+
+;; 5000
+;; 25000
+;; 75000
+
+;; Number of Overlays = N / 2
+;;
+;; (except for the hierarchical case, where it is divided by 10.)
+
+ ;; . scrolling through a buffer with lots of overlays that affect faces
+ ;; of characters in the buffer text
+ ;; . scrolling through a buffer with lots of overlays that define
+ ;; 'display' properties which are strings
+ ;; . scrolling through a buffer with lots of overlays that define
+ ;; 'invisible' properties
+
+(perf-define-test-suite perf-display-suite
+ (perf-define-display-test sequential display scroll)
+ (perf-define-display-test sequential display random)
+ (perf-define-display-test sequential face scroll)
+ (perf-define-display-test sequential face random)
+ (perf-define-display-test sequential invisible scroll)
+ (perf-define-display-test sequential invisible random)
+ (perf-define-display-test random display scroll)
+ (perf-define-display-test random display random)
+ (perf-define-display-test random face scroll)
+ (perf-define-display-test random face random)
+ (perf-define-display-test random invisible scroll)
+ (perf-define-display-test random invisible random))
+
+;; |------------|
+;; |--------|
+;; |----|
+(perf-define-display-test hierarchical face scroll)
+
+
+
+
+;;
+===================================================================================+
+;; | Real World
+;;
+===================================================================================+
+
+(require 'python)
+
+(defconst perf-many-errors-file
+ (expand-file-name "many-errors.py"
+ (and load-file-name (file-name-directory load-file-name))))
+
+(perf-define-constant-test perf-realworld-flycheck
+ (interactive)
+ (package-initialize)
+ (when (and (require 'flycheck nil t)
+ (file-exists-p perf-many-errors-file)
+ (or (executable-find "pylint")
+ (executable-find "flake8")))
+ (setq flycheck-python-pylint-executable
+ (executable-find "pylint"))
+ (setq flycheck-python-flake8-executable
+ (executable-find "flake8"))
+ (setq python-indent-guess-indent-offset-verbose nil)
+ (setq flycheck-check-syntax-automatically nil)
+ (setq flycheck-checker-error-threshold nil)
+ (setq flycheck-display-errors-function nil)
+ (with-current-buffer (find-file-noselect perf-many-errors-file)
+ (let* ((done)
+ (flycheck-after-syntax-check-hook
+ (list (lambda () (setq done t)))))
+ (flycheck-mode 1)
+ (flycheck-buffer)
+ (benchmark-run 1
+ (while (not done)
+ (accept-process-output))
+ (perf-switch-to-buffer-scroll-up-and-down)
+ (flycheck-mode -1))))))
+
+;; https://lists.gnu.org/archive/html/emacs-devel/2009-04/msg00242.html
+(defun make-lines-invisible (regexp &optional arg)
+ "Make all lines matching a regexp invisible and intangible.
+With a prefix arg, make it visible again. It is not necessary
+that REGEXP matches the whole line; if a hit is found, the
+affected line gets automatically selected.
+
+This command affects the whole buffer."
+ (interactive "MRegexp: \nP")
+ (let (ov
+ ovs
+ count)
+ (cond
+ ((equal arg '(4))
+ (setq ovs (overlays-in (point-min) (point-max)))
+ (mapc (lambda (o)
+ (if (overlay-get o 'make-lines-invisible)
+ (delete-overlay o)))
+ ovs))
+ (t
+ (save-excursion
+ (goto-char (point-min))
+ (setq count 0)
+ (while (re-search-forward regexp nil t)
+ (setq count (1+ count))
+ (if (= (% count 100) 0)
+ (message "%d" count))
+ (setq ov (make-overlay (line-beginning-position)
+ (1+ (line-end-position))))
+ (overlay-put ov 'make-lines-invisible t)
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'intangible t)
+ (goto-char (line-end-position))))))))
+
+(perf-define-constant-test perf-realworld-make-lines-invisible
+ (with-temp-buffer
+ (insert-file-contents "/usr/share/dict/words")
+ (set-window-buffer nil (current-buffer))
+ (redisplay t)
+ (overlay-recenter (point-max))
+ (benchmark-run 1
+ (make-lines-invisible "a"))))
+
+(perf-define-constant-test perf-realworld-line-numbering
+ (interactive)
+ (with-temp-buffer
+ (insert-file-contents "/usr/share/dict/words")
+ (overlay-recenter (point-max))
+ (goto-char (point-min))
+ (let* ((nlines (count-lines (point-min) (point-max)))
+ (line 1)
+ (width 0))
+ (dotimes (i nlines) ;;-with-progress-reporter "Creating overlays"
+ (let ((ov (make-overlay (point) (point)))
+ (str (propertize (format "%04d" line) 'face 'shadow)))
+ (overlay-put ov 'before-string
+ (propertize " " 'display `((margin left-margin) ,str)))
+ (setq width (max width (length str)))
+ (cl-incf line)
+ (forward-line)))
+ (benchmark-run 1
+ (let ((left-margin-width width))
+ (perf-switch-to-buffer-scroll-up-and-down))))))
+
+(perf-define-test-suite perf-realworld-suite
+ 'perf-realworld-flycheck
+ 'perf-realworld-make-lines-invisible
+ 'perf-realworld-line-numbering)
+
+
+;;
+===================================================================================+
+;; | next-overlay-change
+;;
+===================================================================================+
+
+(perf-define-variable-test perf-noc-hierarchical/forward/linear (n)
+ "Search linear for the next change on every line."
+ (with-temp-buffer
+ (perf-insert-lines (* 3 n))
+ (perf-insert-overlays-hierarchical n)
+ (goto-char (point-min))
+ (benchmark-run 1
+ (while (not (eobp))
+ (next-overlay-change (point))
+ (forward-line)))))
+
+(perf-define-variable-test perf-noc-sequential/forward/linear (n)
+ "Search linear for the next change on every line."
+ (with-temp-buffer
+ (perf-insert-lines (* 3 n))
+ (perf-insert-overlays-sequential n)
+ (goto-char (point-min))
+ (benchmark-run 1
+ (while (not (eobp))
+ (next-overlay-change (point))
+ (forward-line)))))
+
+(perf-define-variable-test perf-noc-hierarchical/forward/backnforth (n)
+ "Search back and forth for the next change from `point-min' to `point-max'."
+ (with-temp-buffer
+ (perf-insert-lines (* 3 n))
+ (overlay-recenter (point-max))
+ (perf-insert-overlays-hierarchical n)
+ (goto-char (point-min))
+ (benchmark-run 1
+ (while (not (eobp))
+ (next-overlay-change (point))
+ (next-overlay-change (+ (point) 2))
+ (forward-char)))))
+
+(perf-define-test-suite perf-noc-suite
+ 'perf-noc-hierarchical/forward/linear
+ 'perf-noc-hierarchical/forward/backnforth
+ 'perf-noc-hierarchical/forward/backnforth)
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 558d05de14..e020732524 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -20,6 +20,7 @@
;;; Code:
(require 'ert)
+(require 'seq)
(require 'ert-x)
(require 'cl-lib)
(require 'let-alist)
@@ -859,6 +860,33 @@ with parameters from the *Messages* buffer modification."
(should-length 1 (overlays-at 15))
(should-length 1 (overlays-at (point-max))))))
+(defun sorted-overlays (overlays)
+ (sort
+ (mapcar (lambda (overlay)
+ (list (overlay-start overlay)
+ (overlay-end overlay)))
+ overlays)
+ (lambda (first second)
+ (cl-loop for a in first
+ for b in second
+ thereis (< a b)
+ until (> a b)))))
+
+(defun sorted-overlays-at (pos)
+ (sorted-overlays (overlays-at pos)))
+
+(defun sorted-overlays-in (beg end)
+ (sorted-overlays (overlays-in beg end)))
+
+(ert-deftest test-overlays-at-narrow-to-region-end ()
+ ;; See bug#58703.
+ (with-temp-buffer
+ (insert (make-string 30 ?x))
+ (make-overlay 10 11)
+ (narrow-to-region 10 10)
+ (should (equal
+ '((10 11))
+ (sorted-overlays-at 10)))))
;; +==========================================================================+
;; | overlay-in
@@ -936,6 +964,39 @@ with parameters from the *Messages* buffer modification."
(deftest-overlays-in-1 ae 9 11 (a) (a 10 10))
(deftest-overlays-in-1 af 10 11 (a) (a 10 10))
+;; behavior for empty range
+(ert-deftest test-overlays-in-empty-range ()
+ (with-temp-buffer
+ (insert (make-string 4 ?x))
+ (cl-loop for start from (point-min) to (point-max)
+ do (cl-loop for end from start to (point-max)
+ do (when (<= start end)
+ (make-overlay start end))))
+
+ (cl-loop for pos from (point-min) to (point-max)
+ do (ert-info ((format "after (overlay-recenter %d)" pos))
+ (overlay-recenter pos)
+ (should (equal
+ '((1 1))
+ (sorted-overlays-in (point-min) (point-min))))
+ (should (equal
+ '((1 3) (1 4) (1 5) (2 2))
+ (sorted-overlays-in 2 2)))
+ (should (equal
+ '((1 4) (1 5) (2 4) (2 5) (3 3))
+ (sorted-overlays-in 3 3)))
+ (should (equal
+ '((1 5) (2 5) (3 5) (4 4))
+ (sorted-overlays-in 4 4)))
+ (should (equal
+ '((5 5))
+ (sorted-overlays-in (point-max) (point-max))))))))
+
+(ert-deftest test-overlays-in-empty-range-bug58672 ()
+ (with-temp-buffer
+ (insert (make-string 10 ?=))
+ (make-overlay 5 7 nil nil t)
+ (should (equal nil (overlays-in 5 5)))))
;; behavior at point-max
(ert-deftest test-overlays-in-2 ()
@@ -1047,6 +1108,49 @@ with parameters from the *Messages* buffer modification."
(should-not (delete-all-overlays))))
+;; +==========================================================================+
+;; | get-pos-property
+;; +==========================================================================+
+
+(ert-deftest get-pos-property-overlay-beg ()
+ "Test `get-pos-property' at the beginning of an overlay.
+Regression test for bug#58706."
+ (with-temp-buffer
+ (insert (make-string 10000 ?x))
+ (let ((overlay (make-overlay 9999 10001)))
+ (overlay-put overlay 'forty-two 42))
+ (should (equal 42 (get-pos-property 9999 'forty-two)))))
+
+(ert-deftest get-pos-property-overlay-empty-rear-advance ()
+ "Test `get-pos-property' at the end of an empty rear-advance overlay.
+Regression test for bug#58706."
+ (with-temp-buffer
+ (insert (make-string 10000 ?x))
+ (let ((overlay (make-overlay 9999 9999 nil nil t)))
+ (overlay-put overlay 'forty-two 42))
+ (should (equal 42 (get-pos-property 9999 'forty-two)))))
+
+(ert-deftest get-pos-property-overlay-past-rear-advance ()
+ "Test `get-pos-property' past the end of an empty rear-advance overlay.
+Regression test for bug#58706."
+ (with-temp-buffer
+ (insert (make-string 10000 ?x))
+ (let ((overlay (make-overlay 9998 9998 nil nil t)))
+ (overlay-put overlay 'forty-two 42))
+ (should (equal nil (get-pos-property 9999 'forty-two)))))
+
+(ert-deftest get-pos-property-overlay-at-narrowed-end ()
+ "Test `get-pos-property' at the end of a narrowed region.
+Regression test for bug#58706."
+ (with-temp-buffer
+ (insert (make-string 11000 ?x))
+ (narrow-to-region 9998 10000)
+ (let ((overlay (make-overlay 10000 10000 nil t nil)))
+ (overlay-put overlay 'forty-two 42))
+ (should (equal nil (get-pos-property 9999 'forty-two)))))
+
+;; FIXME: add more `get-pos-property' tests
+
;; +==========================================================================+
;; | get-char-property(-and-overlay)
;; +==========================================================================+
@@ -1339,6 +1443,14 @@ with parameters from the *Messages* buffer modification."
(overlay-put ov 'value i)))
(should (eq 9 (get-char-property 1 'value)))))
+(ert-deftest buffer-tests--overlay-bug58479 ()
+ (with-temp-buffer
+ (insert "ab")
+ (let* ((pos (+ (point-min) 1))
+ (ol (make-overlay pos pos)))
+ (overlay-put ol 'my-prop 'set)
+ (should (null (get-char-property pos 'my-prop))))))
+
;; +==========================================================================+
;; | Other
@@ -1507,6 +1619,6559 @@ with parameters from the *Messages* buffer
modification."
(ovshould nonempty-eob-end 4 5)
(ovshould empty-eob 5 5)))))
+(ert-deftest test-overlay-randomly ()
+ "Exercise overlay code, but perform few assertions.
+
+This test works best when Emacs is configured with
+--enable-checking=yes. This is a little bit like fuzz testing,
+except this test has no way to reduce to a minimal failng test
+case. Regardless, by exercising many corner cases bugs can be
+found using Emacs' internal consistency assertions."
+ (let* (
+ ;; The size and slack for the test buffer size.
+ (buffer-size-target 1000)
+ (buffer-size-slack 200)
+
+ ;; Use up to 100 overlays. We need not use more to observe
+ ;; reasonable variation in the overlay data structures.
+ (overlay-count-limit 100)
+
+ ;; This test maintains a vector of overlays. Each iteration
+ ;; may append or erase one overlay.
+ (overlays (make-vector overlay-count-limit nil))
+ (overlay-count 0)
+
+ ;; The test is either slowly growing or shrinking the overlay
+ ;; count. Deletions still occur while growing, and additions
+ ;; still occur while shrinking. The GROWING variable only
+ ;; controls the relative probability of doing one or the
+ ;; other.
+ (growing t)
+
+ ;; Loop up to 1M times.
+ (iteration-count 0)
+ (iteration-target 100000))
+ (with-temp-buffer
+ (while (< (buffer-size) buffer-size-target)
+ (insert "Sed ut perspiciatis, unde omnis iste natus error sit
voluptatem
+accusantium doloremque laudantium, totam rem aperiam eaque ipsa,
+quae ab illo inventore veritatis et quasi architecto beatae vitae
+dicta sunt, explicabo. "))
+
+ (while (< iteration-count iteration-target)
+ (cl-incf iteration-count)
+
+ ;; Toggle GROWING if we've reached a size boundary. The idea
+ ;; is to initially steadily increase the overlay count, then
+ ;; steadily decrease it, then repeat.
+ (when (and growing (= overlay-count overlay-count-limit))
+ (setq growing nil))
+ (when (and (not growing) (= overlay-count 0))
+ (setq growing t))
+
+ ;; Create or delete a random overlay according to a
+ ;; probability chosen by GROWING.
+ (let ((create-overlay (>= (random 100) (if growing 40 60))))
+ (cond
+ ;; Possibly create a new overlay in a random place in the
+ ;; buffer. We have two easy choices. We can choose the
+ ;; overlay BEGIN randomly, then choose its END among the
+ ;; valid remaining buffer posiitions. Or we could choose
+ ;; the overlay width randomly, then choose a valid BEGIN.
+ ;; We take the former approach, because the overlay data
+ ;; structure is ordered primarily by BEGIN.
+ ((and create-overlay (< overlay-count overlay-count-limit))
+ (let* ((begin (random (buffer-size)))
+ (end (+ begin (random (- (buffer-size) begin))))
+ (ov (make-overlay begin end nil
+ (= 0 (random 2)) (= 0 (random 2)))))
+ (aset overlays overlay-count ov)
+ (cl-incf overlay-count)))
+ ((and (not create-overlay) (> overlay-count 0))
+
+ ;; Possibly delete a random overlay.
+ (let* ((last-index (1- overlay-count))
+ (index (random overlay-count))
+ (ov (aref overlays index)))
+ (when (< index last-index)
+ (aset overlays index (aref overlays last-index)))
+ (aset overlays last-index nil)
+ (cl-decf overlay-count)
+ (delete-overlay ov)))))
+
+ ;; Modify the buffer on occasion, which exercises the
+ ;; insert/remove gap logic in the overlay implementation.
+ (when (and (< (buffer-size) (+ buffer-size-target buffer-size-slack))
+ (zerop (random 10)))
+ (goto-char (1+ (random (buffer-size))))
+ (insert (+ ?a (random 26))))
+ (when (and (> (buffer-size) (- buffer-size-target buffer-size-slack))
+ (zerop (random 10)))
+ (goto-char (1+ (random (buffer-size))))
+ (delete-char 1))))))
+
+
+
+;;
+===================================================================================+
+;; | Autogenerated insert/delete/narrow tests
+;;
+===================================================================================+
+
+(when nil ;; Let's comment these out for now.
+
+;; (defun test-overlay-generate-test (name)
+;; (interactive)
+;; (with-temp-buffer
+;; (let ((forms nil)
+;; (buffer-size 64)
+;; (noverlays 16)
+;; (nforms 32)
+;; (dist '(0.5 0.4 0.1)))
+;; (cl-labels ((brand ()
+;; (+ (point-min)
+;; (random (1+ (- (point-max) (point-min)))))))
+;; (cl-macrolet ((push-eval (form)
+;; `(cl-destructuring-bind (&rest args)
+;; (list ,@(cdr form))
+;; (push (cons ',(car form) args) forms)
+;; (apply #',(car form) args))))
+;; (push-eval (insert (make-string buffer-size ?.)))
+;; (dotimes (_ noverlays)
+;; (push-eval (make-overlay (brand) (brand)
+;; nil
+;; (= 0 (random 2))
+;; (= 0 (random 2)))))
+;; (dotimes (_ nforms)
+;; (push-eval (goto-char (brand)))
+;; (pcase (/ (random 100) 100.0)
+;; ((and x (guard (< x (nth 0 dist))))
+;; (push-eval (insert (make-string (random 16) ?.))))
+;; ((and x (guard (< x (+ (nth 0 dist) (nth 1 dist)))))
+;; (push-eval (delete-char (random (1+ (- (point-max)
(point)))))))
+;; (_
+;; (push-eval (widen))
+;; (push-eval (narrow-to-region (brand) (brand))))))
+;; `(ert-deftest ,name ()
+;; (with-temp-buffer
+;; ,@(nreverse forms)
+;; (should (equal (test-overlay-regions)
+;; ',(test-overlay-regions))))))))))
+
+;; (defun test-overlay-generate-tests (n)
+;; (let ((namefmt "overlay-autogenerated-test-%d")
+;; (standard-output (current-buffer))
+;; (print-length nil)
+;; (print-level nil)
+;; (print-quoted t))
+;; (dotimes (i n)
+;; (pp (test-overlay-generate-test (intern (format namefmt i))))
+;; (terpri))))
+
+;; (progn (random "4711") (test-overlay-generate-tests 64))
+
+(ert-deftest overlay-autogenerated-test-0 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 63 7 nil t t)
+ (make-overlay 47 9 nil nil nil)
+ (make-overlay 50 43 nil nil nil)
+ (make-overlay 20 53 nil nil t)
+ (make-overlay 62 4 nil nil t)
+ (make-overlay 40 27 nil t t)
+ (make-overlay 58 44 nil t t)
+ (make-overlay 46 38 nil nil nil)
+ (make-overlay 51 28 nil t nil)
+ (make-overlay 12 53 nil t t)
+ (make-overlay 52 60 nil nil nil)
+ (make-overlay 13 47 nil nil nil)
+ (make-overlay 16 31 nil nil nil)
+ (make-overlay 9 48 nil t t)
+ (make-overlay 43 29 nil nil t)
+ (make-overlay 48 13 nil t nil)
+ (goto-char 44)
+ (delete-char 15)
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 20 8)
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 16)
+ (insert "..............")
+ (goto-char 12)
+ (delete-char 15)
+ (goto-char 12)
+ (delete-char 4)
+ (goto-char 12)
+ (delete-char 0)
+ (goto-char 12)
+ (insert "......")
+ (goto-char 13)
+ (delete-char 5)
+ (goto-char 8)
+ (insert "...")
+ (goto-char 10)
+ (insert ".............")
+ (goto-char 14)
+ (insert ".......")
+ (goto-char 25)
+ (delete-char 4)
+ (goto-char 26)
+ (insert "...............")
+ (goto-char 27)
+ (insert "...")
+ (goto-char 29)
+ (delete-char 7)
+ (goto-char 24)
+ (insert "...")
+ (goto-char 30)
+ (insert "..........")
+ (goto-char 29)
+ (widen)
+ (narrow-to-region 34 41)
+ (goto-char 40)
+ (delete-char 0)
+ (goto-char 35)
+ (delete-char 4)
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 80 66)
+ (goto-char 74)
+ (delete-char 5)
+ (goto-char 69)
+ (delete-char 5)
+ (goto-char 70)
+ (widen)
+ (narrow-to-region 50 71)
+ (goto-char 66)
+ (insert "...............")
+ (goto-char 54)
+ (insert "...............")
+ (goto-char 84)
+ (insert "....")
+ (goto-char 72)
+ (insert "...........")
+ (goto-char 84)
+ (insert "..........")
+ (goto-char 102)
+ (insert "")
+ (goto-char 80)
+ (delete-char 25)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 99)
+ (7 . 100)
+ (48 . 99)
+ (48 . 99)
+ (48 . 99)
+ (49 . 99)
+ (49 . 99)
+ (51 . 80)
+ (51 . 99)
+ (80 . 99)
+ (80 . 99)
+ (80 . 99)
+ (99 . 99)
+ (99 . 99)
+ (99 . 99)
+ (99 . 99))))))
+
+(ert-deftest overlay-autogenerated-test-1 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 17 27 nil nil nil)
+ (make-overlay 13 28 nil nil t)
+ (make-overlay 8 56 nil nil nil)
+ (make-overlay 34 64 nil nil nil)
+ (make-overlay 51 4 nil t t)
+ (make-overlay 1 19 nil nil nil)
+ (make-overlay 53 59 nil nil t)
+ (make-overlay 25 13 nil nil nil)
+ (make-overlay 19 28 nil t nil)
+ (make-overlay 33 23 nil t nil)
+ (make-overlay 10 46 nil t t)
+ (make-overlay 18 39 nil nil nil)
+ (make-overlay 1 49 nil t nil)
+ (make-overlay 57 21 nil t t)
+ (make-overlay 10 58 nil t t)
+ (make-overlay 39 49 nil nil t)
+ (goto-char 37)
+ (delete-char 9)
+ (goto-char 3)
+ (insert "......")
+ (goto-char 38)
+ (delete-char 14)
+ (goto-char 18)
+ (insert "..........")
+ (goto-char 53)
+ (insert "....")
+ (goto-char 49)
+ (delete-char 10)
+ (goto-char 11)
+ (delete-char 12)
+ (goto-char 17)
+ (delete-char 22)
+ (goto-char 8)
+ (insert ".")
+ (goto-char 16)
+ (insert "........")
+ (goto-char 16)
+ (delete-char 5)
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 22)
+ (insert ".......")
+ (goto-char 18)
+ (delete-char 11)
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 9)
+ (insert "...........")
+ (goto-char 7)
+ (insert "...............")
+ (goto-char 2)
+ (insert ".......")
+ (goto-char 21)
+ (delete-char 11)
+ (goto-char 13)
+ (insert "..............")
+ (goto-char 17)
+ (delete-char 3)
+ (goto-char 21)
+ (insert "......")
+ (goto-char 15)
+ (delete-char 32)
+ (goto-char 10)
+ (insert "........")
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 15 20)
+ (goto-char 17)
+ (insert ".............")
+ (goto-char 22)
+ (insert "............")
+ (goto-char 21)
+ (delete-char 8)
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 32)
+ (delete-char 2)
+ (goto-char 21)
+ (insert ".....")
+ (goto-char 31)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 58)
+ (1 . 58))))))
+
+(ert-deftest overlay-autogenerated-test-2 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 15 59 nil t t)
+ (make-overlay 56 16 nil nil nil)
+ (make-overlay 65 51 nil t nil)
+ (make-overlay 14 24 nil t nil)
+ (make-overlay 28 9 nil t nil)
+ (make-overlay 58 50 nil t t)
+ (make-overlay 13 32 nil t t)
+ (make-overlay 12 21 nil t nil)
+ (make-overlay 60 23 nil t nil)
+ (make-overlay 39 38 nil nil t)
+ (make-overlay 15 64 nil t nil)
+ (make-overlay 17 21 nil nil t)
+ (make-overlay 46 23 nil t t)
+ (make-overlay 19 40 nil t nil)
+ (make-overlay 13 48 nil nil t)
+ (make-overlay 35 11 nil t nil)
+ (goto-char 41)
+ (delete-char 19)
+ (goto-char 45)
+ (insert "......")
+ (goto-char 3)
+ (delete-char 32)
+ (goto-char 19)
+ (insert "")
+ (goto-char 16)
+ (insert "...............")
+ (goto-char 2)
+ (insert "")
+ (goto-char 30)
+ (delete-char 0)
+ (goto-char 18)
+ (delete-char 17)
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 12)
+ (insert "...")
+ (goto-char 2)
+ (insert ".............")
+ (goto-char 16)
+ (insert ".......")
+ (goto-char 15)
+ (insert ".......")
+ (goto-char 43)
+ (insert "......")
+ (goto-char 22)
+ (insert ".........")
+ (goto-char 25)
+ (delete-char 1)
+ (goto-char 38)
+ (insert "...............")
+ (goto-char 76)
+ (delete-char 3)
+ (goto-char 12)
+ (delete-char 5)
+ (goto-char 70)
+ (delete-char 9)
+ (goto-char 36)
+ (delete-char 4)
+ (goto-char 18)
+ (insert "...............")
+ (goto-char 52)
+ (delete-char 14)
+ (goto-char 23)
+ (insert "..........")
+ (goto-char 64)
+ (insert "...........")
+ (goto-char 68)
+ (delete-char 21)
+ (goto-char 71)
+ (insert "........")
+ (goto-char 28)
+ (delete-char 43)
+ (goto-char 25)
+ (insert "....")
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 40)
+ (insert "....")
+ (goto-char 56)
+ (delete-char 2)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 58))))))
+
+(ert-deftest overlay-autogenerated-test-3 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 53 38 nil t nil)
+ (make-overlay 17 40 nil t t)
+ (make-overlay 64 26 nil t t)
+ (make-overlay 48 24 nil t nil)
+ (make-overlay 21 18 nil nil nil)
+ (make-overlay 2 20 nil nil t)
+ (make-overlay 43 26 nil t t)
+ (make-overlay 56 28 nil t nil)
+ (make-overlay 19 51 nil nil nil)
+ (make-overlay 39 61 nil t nil)
+ (make-overlay 59 12 nil t nil)
+ (make-overlay 65 7 nil t nil)
+ (make-overlay 41 7 nil t nil)
+ (make-overlay 62 50 nil t nil)
+ (make-overlay 7 10 nil t t)
+ (make-overlay 45 28 nil t nil)
+ (goto-char 13)
+ (insert "...")
+ (goto-char 37)
+ (widen)
+ (narrow-to-region 2 10)
+ (goto-char 8)
+ (delete-char 1)
+ (goto-char 3)
+ (delete-char 6)
+ (goto-char 2)
+ (insert "...........")
+ (goto-char 5)
+ (widen)
+ (narrow-to-region 55 70)
+ (goto-char 55)
+ (insert "......")
+ (goto-char 64)
+ (delete-char 12)
+ (goto-char 61)
+ (insert ".....")
+ (goto-char 64)
+ (insert "..............")
+ (goto-char 72)
+ (delete-char 6)
+ (goto-char 63)
+ (delete-char 12)
+ (goto-char 63)
+ (delete-char 2)
+ (goto-char 57)
+ (insert "..............")
+ (goto-char 68)
+ (insert "........")
+ (goto-char 77)
+ (delete-char 6)
+ (goto-char 77)
+ (insert ".............")
+ (goto-char 67)
+ (delete-char 0)
+ (goto-char 84)
+ (insert "........")
+ (goto-char 74)
+ (delete-char 12)
+ (goto-char 78)
+ (insert "...")
+ (goto-char 80)
+ (insert "............")
+ (goto-char 69)
+ (insert "......")
+ (goto-char 89)
+ (insert ".")
+ (goto-char 56)
+ (insert "....")
+ (goto-char 100)
+ (insert ".............")
+ (goto-char 114)
+ (delete-char 0)
+ (goto-char 61)
+ (widen)
+ (narrow-to-region 94 50)
+ (goto-char 55)
+ (insert "............")
+ (goto-char 53)
+ (insert ".............")
+ (goto-char 116)
+ (delete-char 3)
+ (goto-char 81)
+ (insert "...............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((14 . 166)
+ (16 . 164)
+ (26 . 164)
+ (31 . 68)
+ (33 . 165)
+ (35 . 52)
+ (35 . 164)
+ (45 . 164)
+ (46 . 164))))))
+
+(ert-deftest overlay-autogenerated-test-4 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 25 15 nil nil t)
+ (make-overlay 8 13 nil nil nil)
+ (make-overlay 45 49 nil t t)
+ (make-overlay 22 13 nil t t)
+ (make-overlay 34 17 nil nil t)
+ (make-overlay 42 15 nil nil t)
+ (make-overlay 43 28 nil t t)
+ (make-overlay 3 28 nil t nil)
+ (make-overlay 32 61 nil nil t)
+ (make-overlay 30 64 nil t t)
+ (make-overlay 21 39 nil nil t)
+ (make-overlay 32 62 nil t nil)
+ (make-overlay 25 29 nil t nil)
+ (make-overlay 34 43 nil t nil)
+ (make-overlay 9 11 nil t nil)
+ (make-overlay 21 65 nil nil t)
+ (goto-char 21)
+ (delete-char 4)
+ (goto-char 25)
+ (insert "..")
+ (goto-char 53)
+ (insert "..")
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 42)
+ (delete-char 36)
+ (goto-char 23)
+ (delete-char 12)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 30 32)
+ (goto-char 30)
+ (delete-char 0)
+ (goto-char 31)
+ (delete-char 1)
+ (goto-char 31)
+ (widen)
+ (narrow-to-region 28 27)
+ (goto-char 27)
+ (delete-char 1)
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 27)
+ (insert ".")
+ (goto-char 28)
+ (insert "......")
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 27)
+ (delete-char 5)
+ (goto-char 27)
+ (delete-char 1)
+ (goto-char 27)
+ (insert ".............")
+ (goto-char 30)
+ (insert "..............")
+ (goto-char 37)
+ (delete-char 15)
+ (goto-char 32)
+ (delete-char 2)
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 34)
+ (delete-char 1)
+ (goto-char 32)
+ (widen)
+ (narrow-to-region 24 19)
+ (goto-char 21)
+ (delete-char 1)
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 11 38)
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 20 22)
+ (goto-char 20)
+ (delete-char 1)
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 36 4)
+ (goto-char 26)
+ (delete-char 9)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((18 . 25)
+ (21 . 21)
+ (21 . 21)
+ (21 . 22)
+ (21 . 22)
+ (21 . 27)
+ (21 . 27)
+ (22 . 25)
+ (22 . 27)
+ (22 . 28)
+ (26 . 27))))))
+
+(ert-deftest overlay-autogenerated-test-5 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 64 1 nil nil nil)
+ (make-overlay 38 43 nil nil nil)
+ (make-overlay 42 19 nil t nil)
+ (make-overlay 22 12 nil nil nil)
+ (make-overlay 12 30 nil t t)
+ (make-overlay 38 46 nil nil nil)
+ (make-overlay 18 23 nil nil nil)
+ (make-overlay 58 65 nil nil t)
+ (make-overlay 52 41 nil nil nil)
+ (make-overlay 12 26 nil nil nil)
+ (make-overlay 39 4 nil nil nil)
+ (make-overlay 20 1 nil nil t)
+ (make-overlay 36 60 nil nil nil)
+ (make-overlay 24 18 nil t nil)
+ (make-overlay 9 50 nil nil nil)
+ (make-overlay 19 17 nil t nil)
+ (goto-char 40)
+ (insert "")
+ (goto-char 64)
+ (insert ".............")
+ (goto-char 32)
+ (delete-char 40)
+ (goto-char 25)
+ (insert "...")
+ (goto-char 31)
+ (delete-char 1)
+ (goto-char 8)
+ (delete-char 14)
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 20)
+ (insert "...........")
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 17)
+ (widen)
+ (narrow-to-region 11 21)
+ (goto-char 14)
+ (widen)
+ (narrow-to-region 9 24)
+ (goto-char 24)
+ (insert ".............")
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 47 45)
+ (goto-char 47)
+ (insert ".")
+ (goto-char 46)
+ (widen)
+ (narrow-to-region 30 42)
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 34)
+ (insert ".......")
+ (goto-char 42)
+ (delete-char 4)
+ (goto-char 39)
+ (delete-char 6)
+ (goto-char 31)
+ (delete-char 6)
+ (goto-char 31)
+ (insert "............")
+ (goto-char 30)
+ (insert "......")
+ (goto-char 50)
+ (delete-char 0)
+ (goto-char 30)
+ (insert "....")
+ (goto-char 53)
+ (insert "............")
+ (goto-char 41)
+ (delete-char 12)
+ (goto-char 52)
+ (insert ".......")
+ (goto-char 56)
+ (insert "...........")
+ (goto-char 68)
+ (insert ".......")
+ (goto-char 52)
+ (insert "......")
+ (goto-char 71)
+ (delete-char 10)
+ (goto-char 47)
+ (insert "")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((20 . 89))))))
+
+(ert-deftest overlay-autogenerated-test-6 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 28 59 nil nil nil)
+ (make-overlay 36 21 nil t t)
+ (make-overlay 60 19 nil t nil)
+ (make-overlay 26 30 nil t nil)
+ (make-overlay 47 27 nil nil t)
+ (make-overlay 8 25 nil t t)
+ (make-overlay 57 43 nil t t)
+ (make-overlay 28 61 nil nil t)
+ (make-overlay 42 31 nil nil t)
+ (make-overlay 15 44 nil t nil)
+ (make-overlay 56 38 nil nil nil)
+ (make-overlay 39 44 nil nil t)
+ (make-overlay 50 6 nil t nil)
+ (make-overlay 6 19 nil t nil)
+ (make-overlay 50 44 nil t t)
+ (make-overlay 34 60 nil nil t)
+ (goto-char 27)
+ (insert "...............")
+ (goto-char 23)
+ (insert "..............")
+ (goto-char 50)
+ (widen)
+ (narrow-to-region 53 67)
+ (goto-char 60)
+ (delete-char 0)
+ (goto-char 54)
+ (insert "......")
+ (goto-char 64)
+ (delete-char 1)
+ (goto-char 66)
+ (delete-char 3)
+ (goto-char 58)
+ (insert ".............")
+ (goto-char 58)
+ (insert ".........")
+ (goto-char 76)
+ (insert "...........")
+ (goto-char 57)
+ (insert "....")
+ (goto-char 106)
+ (widen)
+ (narrow-to-region 5 45)
+ (goto-char 31)
+ (delete-char 8)
+ (goto-char 36)
+ (insert "...")
+ (goto-char 6)
+ (insert "........")
+ (goto-char 33)
+ (insert ".............")
+ (goto-char 38)
+ (delete-char 3)
+ (goto-char 28)
+ (delete-char 6)
+ (goto-char 42)
+ (widen)
+ (narrow-to-region 17 25)
+ (goto-char 19)
+ (insert "..............")
+ (goto-char 37)
+ (delete-char 1)
+ (goto-char 22)
+ (delete-char 9)
+ (goto-char 28)
+ (insert "..............")
+ (goto-char 37)
+ (delete-char 3)
+ (goto-char 18)
+ (insert "...............")
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 68 25)
+ (goto-char 38)
+ (delete-char 22)
+ (goto-char 43)
+ (widen)
+ (narrow-to-region 47 96)
+ (goto-char 86)
+ (insert ".")
+ (goto-char 63)
+ (insert "......")
+ (goto-char 78)
+ (widen)
+ (narrow-to-region 61 27)
+ (goto-char 43)
+ (delete-char 8)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((14 . 38)
+ (14 . 132)
+ (16 . 43)
+ (38 . 118)
+ (38 . 126)
+ (38 . 142)
+ (44 . 115)
+ (45 . 129))))))
+
+(ert-deftest overlay-autogenerated-test-7 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 13 50 nil t nil)
+ (make-overlay 28 44 nil nil t)
+ (make-overlay 56 27 nil t nil)
+ (make-overlay 8 34 nil nil nil)
+ (make-overlay 22 8 nil nil t)
+ (make-overlay 8 28 nil t nil)
+ (make-overlay 65 31 nil nil t)
+ (make-overlay 44 8 nil nil nil)
+ (make-overlay 52 64 nil nil t)
+ (make-overlay 52 27 nil t t)
+ (make-overlay 47 32 nil nil nil)
+ (make-overlay 18 62 nil nil nil)
+ (make-overlay 18 24 nil t t)
+ (make-overlay 33 46 nil nil t)
+ (make-overlay 20 8 nil t nil)
+ (make-overlay 51 51 nil t nil)
+ (goto-char 2)
+ (delete-char 46)
+ (goto-char 12)
+ (delete-char 5)
+ (goto-char 2)
+ (delete-char 12)
+ (goto-char 2)
+ (insert "..")
+ (goto-char 2)
+ (widen)
+ (narrow-to-region 2 4)
+ (goto-char 4)
+ (insert "......")
+ (goto-char 4)
+ (widen)
+ (narrow-to-region 4 6)
+ (goto-char 5)
+ (insert "")
+ (goto-char 6)
+ (insert "...............")
+ (goto-char 9)
+ (insert "...")
+ (goto-char 7)
+ (delete-char 13)
+ (goto-char 8)
+ (delete-char 1)
+ (goto-char 9)
+ (insert "...............")
+ (goto-char 24)
+ (delete-char 1)
+ (goto-char 15)
+ (insert "...............")
+ (goto-char 16)
+ (insert "............")
+ (goto-char 17)
+ (delete-char 8)
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 47 38)
+ (goto-char 43)
+ (delete-char 0)
+ (goto-char 46)
+ (delete-char 0)
+ (goto-char 40)
+ (delete-char 4)
+ (goto-char 39)
+ (insert ".......")
+ (goto-char 50)
+ (delete-char 0)
+ (goto-char 47)
+ (insert "...........")
+ (goto-char 45)
+ (insert ".....")
+ (goto-char 38)
+ (delete-char 3)
+ (goto-char 59)
+ (delete-char 1)
+ (goto-char 42)
+ (insert "...............")
+ (goto-char 65)
+ (insert "...........")
+ (goto-char 73)
+ (delete-char 13)
+ (goto-char 72)
+ (insert "....")
+ (goto-char 47)
+ (insert "..")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 81)
+ (2 . 81)
+ (2 . 81)
+ (2 . 81)
+ (2 . 81)
+ (81 . 81)
+ (81 . 81))))))
+
+(ert-deftest overlay-autogenerated-test-8 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 20 6 nil t nil)
+ (make-overlay 48 13 nil t nil)
+ (make-overlay 58 65 nil nil t)
+ (make-overlay 63 65 nil nil nil)
+ (make-overlay 42 40 nil t t)
+ (make-overlay 40 6 nil nil t)
+ (make-overlay 37 46 nil t nil)
+ (make-overlay 4 14 nil nil nil)
+ (make-overlay 58 44 nil t t)
+ (make-overlay 14 16 nil nil t)
+ (make-overlay 31 61 nil t nil)
+ (make-overlay 34 3 nil nil nil)
+ (make-overlay 11 16 nil t nil)
+ (make-overlay 19 42 nil nil t)
+ (make-overlay 30 9 nil nil t)
+ (make-overlay 63 52 nil t t)
+ (goto-char 57)
+ (delete-char 2)
+ (goto-char 8)
+ (insert "........")
+ (goto-char 30)
+ (insert "...........")
+ (goto-char 35)
+ (insert "...........")
+ (goto-char 66)
+ (insert "...............")
+ (goto-char 53)
+ (delete-char 15)
+ (goto-char 75)
+ (delete-char 10)
+ (goto-char 62)
+ (delete-char 21)
+ (goto-char 52)
+ (delete-char 10)
+ (goto-char 10)
+ (insert "............")
+ (goto-char 42)
+ (insert "...........")
+ (goto-char 68)
+ (insert ".............")
+ (goto-char 12)
+ (insert "........")
+ (goto-char 1)
+ (insert "...............")
+ (goto-char 89)
+ (insert "")
+ (goto-char 94)
+ (insert ".............")
+ (goto-char 57)
+ (insert "...........")
+ (goto-char 130)
+ (insert "...")
+ (goto-char 69)
+ (insert "..")
+ (goto-char 101)
+ (insert "......")
+ (goto-char 128)
+ (delete-char 13)
+ (goto-char 19)
+ (delete-char 100)
+ (goto-char 22)
+ (insert "..")
+ (goto-char 13)
+ (widen)
+ (narrow-to-region 30 16)
+ (goto-char 19)
+ (insert "..........")
+ (goto-char 22)
+ (delete-char 3)
+ (goto-char 19)
+ (insert ".........")
+ (goto-char 17)
+ (insert "..")
+ (goto-char 16)
+ (insert "............")
+ (goto-char 47)
+ (insert ".")
+ (goto-char 50)
+ (insert "..........")
+ (goto-char 70)
+ (delete-char 1)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((32 . 75)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 60)
+ (33 . 75)
+ (33 . 75)
+ (33 . 75)
+ (60 . 75))))))
+
+(ert-deftest overlay-autogenerated-test-9 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 13 nil nil nil)
+ (make-overlay 29 4 nil nil t)
+ (make-overlay 3 53 nil nil nil)
+ (make-overlay 31 9 nil t t)
+ (make-overlay 48 30 nil nil nil)
+ (make-overlay 43 50 nil nil nil)
+ (make-overlay 7 27 nil nil t)
+ (make-overlay 30 59 nil nil nil)
+ (make-overlay 42 25 nil nil t)
+ (make-overlay 15 13 nil t t)
+ (make-overlay 39 11 nil t t)
+ (make-overlay 21 62 nil t t)
+ (make-overlay 35 2 nil t nil)
+ (make-overlay 60 53 nil nil t)
+ (make-overlay 64 8 nil nil t)
+ (make-overlay 58 59 nil t t)
+ (goto-char 28)
+ (insert ".............")
+ (goto-char 28)
+ (insert "...............")
+ (goto-char 71)
+ (insert ".......")
+ (goto-char 65)
+ (insert "......")
+ (goto-char 3)
+ (delete-char 12)
+ (goto-char 79)
+ (delete-char 11)
+ (goto-char 65)
+ (widen)
+ (narrow-to-region 12 53)
+ (goto-char 38)
+ (insert ".......")
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 27)
+ (insert "...........")
+ (goto-char 75)
+ (insert "........")
+ (goto-char 85)
+ (insert "............")
+ (goto-char 52)
+ (insert "..........")
+ (goto-char 16)
+ (delete-char 8)
+ (goto-char 15)
+ (insert "...............")
+ (goto-char 112)
+ (insert "")
+ (goto-char 61)
+ (insert "..")
+ (goto-char 29)
+ (delete-char 34)
+ (goto-char 52)
+ (delete-char 32)
+ (goto-char 43)
+ (insert "........")
+ (goto-char 45)
+ (insert "..")
+ (goto-char 35)
+ (insert "...........")
+ (goto-char 29)
+ (insert ".......")
+ (goto-char 75)
+ (widen)
+ (narrow-to-region 69 55)
+ (goto-char 67)
+ (delete-char 2)
+ (goto-char 66)
+ (delete-char 0)
+ (goto-char 62)
+ (delete-char 1)
+ (goto-char 61)
+ (delete-char 3)
+ (goto-char 63)
+ (insert ".")
+ (goto-char 56)
+ (insert ".....")
+ (goto-char 67)
+ (insert ".............")
+ (goto-char 76)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 90)
+ (3 . 90)
+ (3 . 90)
+ (3 . 99)
+ (3 . 117)
+ (3 . 117)
+ (3 . 120)
+ (9 . 118)
+ (13 . 102))))))
+
+(ert-deftest overlay-autogenerated-test-10 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 16 60 nil nil nil)
+ (make-overlay 36 53 nil nil nil)
+ (make-overlay 44 39 nil t t)
+ (make-overlay 61 47 nil t t)
+ (make-overlay 58 39 nil nil t)
+ (make-overlay 23 54 nil nil t)
+ (make-overlay 65 59 nil t t)
+ (make-overlay 13 57 nil nil t)
+ (make-overlay 22 64 nil nil t)
+ (make-overlay 16 19 nil nil nil)
+ (make-overlay 16 1 nil nil t)
+ (make-overlay 28 21 nil t t)
+ (make-overlay 10 62 nil nil nil)
+ (make-overlay 12 18 nil nil t)
+ (make-overlay 15 5 nil nil t)
+ (make-overlay 36 31 nil nil t)
+ (goto-char 42)
+ (insert "...")
+ (goto-char 25)
+ (delete-char 28)
+ (goto-char 30)
+ (delete-char 10)
+ (goto-char 8)
+ (delete-char 9)
+ (goto-char 5)
+ (insert "........")
+ (goto-char 6)
+ (delete-char 2)
+ (goto-char 4)
+ (insert "")
+ (goto-char 21)
+ (insert ".............")
+ (goto-char 6)
+ (delete-char 33)
+ (goto-char 1)
+ (delete-char 1)
+ (goto-char 6)
+ (insert "..........")
+ (goto-char 8)
+ (insert "...........")
+ (goto-char 21)
+ (insert "........")
+ (goto-char 16)
+ (delete-char 18)
+ (goto-char 5)
+ (insert "...")
+ (goto-char 5)
+ (delete-char 8)
+ (goto-char 11)
+ (insert ".")
+ (goto-char 1)
+ (insert ".......")
+ (goto-char 9)
+ (delete-char 9)
+ (goto-char 5)
+ (insert "")
+ (goto-char 8)
+ (delete-char 0)
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 12)
+ (insert "")
+ (goto-char 11)
+ (delete-char 8)
+ (goto-char 7)
+ (delete-char 3)
+ (goto-char 5)
+ (delete-char 3)
+ (goto-char 1)
+ (delete-char 8)
+ (goto-char 1)
+ (insert "....")
+ (goto-char 1)
+ (insert "..")
+ (goto-char 7)
+ (insert "...")
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 9 11)
+ (goto-char 11)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 10)
+ (1 . 10)
+ (1 . 10)
+ (1 . 10)
+ (1 . 10)
+ (1 . 12)
+ (1 . 12)
+ (1 . 12)
+ (10 . 10)
+ (10 . 10)
+ (10 . 12))))))
+
+(ert-deftest overlay-autogenerated-test-11 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 33 18 nil nil nil)
+ (make-overlay 56 38 nil t nil)
+ (make-overlay 2 45 nil nil t)
+ (make-overlay 19 55 nil nil t)
+ (make-overlay 28 42 nil t t)
+ (make-overlay 50 29 nil t nil)
+ (make-overlay 40 63 nil nil nil)
+ (make-overlay 13 2 nil nil t)
+ (make-overlay 26 7 nil t t)
+ (make-overlay 22 25 nil nil nil)
+ (make-overlay 14 14 nil t nil)
+ (make-overlay 15 39 nil t t)
+ (make-overlay 51 22 nil t t)
+ (make-overlay 58 5 nil t nil)
+ (make-overlay 16 10 nil nil nil)
+ (make-overlay 32 33 nil t nil)
+ (goto-char 40)
+ (delete-char 20)
+ (goto-char 45)
+ (delete-char 0)
+ (goto-char 6)
+ (insert "..")
+ (goto-char 45)
+ (insert "...")
+ (goto-char 26)
+ (insert "...............")
+ (goto-char 27)
+ (insert "...........")
+ (goto-char 38)
+ (insert "......")
+ (goto-char 62)
+ (insert "...............")
+ (goto-char 18)
+ (insert "...........")
+ (goto-char 99)
+ (widen)
+ (narrow-to-region 37 17)
+ (goto-char 29)
+ (delete-char 2)
+ (goto-char 28)
+ (delete-char 2)
+ (goto-char 17)
+ (insert ".....")
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 34 96)
+ (goto-char 44)
+ (delete-char 22)
+ (goto-char 39)
+ (insert "..")
+ (goto-char 53)
+ (insert "...............")
+ (goto-char 58)
+ (insert ".............")
+ (goto-char 93)
+ (insert ".........")
+ (goto-char 78)
+ (widen)
+ (narrow-to-region 27 104)
+ (goto-char 93)
+ (delete-char 11)
+ (goto-char 59)
+ (insert "....")
+ (goto-char 59)
+ (insert "..............")
+ (goto-char 74)
+ (delete-char 5)
+ (goto-char 70)
+ (insert ".")
+ (goto-char 37)
+ (insert "...........")
+ (goto-char 34)
+ (delete-char 46)
+ (goto-char 49)
+ (insert "......")
+ (goto-char 55)
+ (insert "...")
+ (goto-char 42)
+ (insert "...")
+ (goto-char 70)
+ (delete-char 8)
+ (goto-char 48)
+ (delete-char 28)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 62)
+ (5 . 62)
+ (9 . 34)
+ (22 . 61)
+ (33 . 55)
+ (33 . 62)
+ (34 . 34)
+ (34 . 62))))))
+
+(ert-deftest overlay-autogenerated-test-12 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 18 50 nil nil nil)
+ (make-overlay 63 3 nil nil t)
+ (make-overlay 44 20 nil t t)
+ (make-overlay 58 38 nil nil t)
+ (make-overlay 3 17 nil t nil)
+ (make-overlay 31 62 nil t nil)
+ (make-overlay 12 17 nil t nil)
+ (make-overlay 17 52 nil nil nil)
+ (make-overlay 9 35 nil nil nil)
+ (make-overlay 17 38 nil nil nil)
+ (make-overlay 53 54 nil nil t)
+ (make-overlay 65 34 nil t nil)
+ (make-overlay 12 33 nil t nil)
+ (make-overlay 54 58 nil nil nil)
+ (make-overlay 42 26 nil t nil)
+ (make-overlay 2 4 nil t nil)
+ (goto-char 4)
+ (delete-char 26)
+ (goto-char 39)
+ (insert ".")
+ (goto-char 2)
+ (delete-char 14)
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 19 1)
+ (goto-char 7)
+ (delete-char 9)
+ (goto-char 6)
+ (insert ".........")
+ (goto-char 6)
+ (insert "..........")
+ (goto-char 16)
+ (insert ".............")
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 4)
+ (insert "..........")
+ (goto-char 49)
+ (delete-char 2)
+ (goto-char 16)
+ (insert "............")
+ (goto-char 52)
+ (widen)
+ (narrow-to-region 36 38)
+ (goto-char 37)
+ (delete-char 1)
+ (goto-char 37)
+ (insert ".............")
+ (goto-char 46)
+ (insert ".")
+ (goto-char 40)
+ (delete-char 5)
+ (goto-char 45)
+ (delete-char 0)
+ (goto-char 46)
+ (delete-char 0)
+ (goto-char 40)
+ (insert "..........")
+ (goto-char 39)
+ (delete-char 4)
+ (goto-char 39)
+ (delete-char 3)
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 8 9)
+ (goto-char 8)
+ (delete-char 1)
+ (goto-char 8)
+ (delete-char 0)
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 45 15)
+ (goto-char 40)
+ (insert "...............")
+ (goto-char 29)
+ (delete-char 7)
+ (goto-char 30)
+ (delete-char 6)
+ (goto-char 21)
+ (delete-char 9)
+ (goto-char 22)
+ (insert "...............")
+ (goto-char 51)
+ (insert "..............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 92)
+ (2 . 92)
+ (2 . 93)
+ (2 . 96)
+ (2 . 97)
+ (2 . 99))))))
+
+(ert-deftest overlay-autogenerated-test-13 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 18 30 nil t t)
+ (make-overlay 54 37 nil nil t)
+ (make-overlay 16 61 nil nil t)
+ (make-overlay 58 7 nil nil t)
+ (make-overlay 27 39 nil nil t)
+ (make-overlay 39 31 nil nil t)
+ (make-overlay 11 47 nil nil nil)
+ (make-overlay 47 40 nil t t)
+ (make-overlay 27 18 nil nil nil)
+ (make-overlay 33 26 nil nil t)
+ (make-overlay 55 4 nil t t)
+ (make-overlay 62 50 nil t t)
+ (make-overlay 47 65 nil t t)
+ (make-overlay 17 23 nil nil t)
+ (make-overlay 30 31 nil t nil)
+ (make-overlay 10 37 nil t nil)
+ (goto-char 8)
+ (delete-char 6)
+ (goto-char 56)
+ (delete-char 0)
+ (goto-char 28)
+ (insert ".........")
+ (goto-char 19)
+ (insert "..............")
+ (goto-char 4)
+ (delete-char 28)
+ (goto-char 49)
+ (delete-char 4)
+ (goto-char 2)
+ (insert "............")
+ (goto-char 10)
+ (delete-char 37)
+ (goto-char 19)
+ (delete-char 2)
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 16)
+ (insert "..")
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 12 3)
+ (goto-char 10)
+ (delete-char 2)
+ (goto-char 9)
+ (insert "..")
+ (goto-char 12)
+ (insert "...............")
+ (goto-char 25)
+ (insert ".....")
+ (goto-char 10)
+ (widen)
+ (narrow-to-region 42 18)
+ (goto-char 20)
+ (insert ".......")
+ (goto-char 18)
+ (insert ".........")
+ (goto-char 55)
+ (delete-char 3)
+ (goto-char 48)
+ (insert ".......")
+ (goto-char 52)
+ (delete-char 6)
+ (goto-char 45)
+ (delete-char 11)
+ (goto-char 27)
+ (delete-char 13)
+ (goto-char 22)
+ (insert "...........")
+ (goto-char 19)
+ (delete-char 15)
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 12 25)
+ (goto-char 16)
+ (insert "..........")
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 2 38)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 31)
+ (insert "...............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((12 . 12)
+ (12 . 12)
+ (12 . 12)
+ (12 . 12)
+ (12 . 53)
+ (12 . 53)
+ (12 . 53)
+ (12 . 53)
+ (12 . 53)
+ (12 . 53)
+ (12 . 55))))))
+
+(ert-deftest overlay-autogenerated-test-14 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 29 37 nil t nil)
+ (make-overlay 15 44 nil nil nil)
+ (make-overlay 31 34 nil nil t)
+ (make-overlay 35 33 nil t t)
+ (make-overlay 4 27 nil t t)
+ (make-overlay 37 5 nil nil t)
+ (make-overlay 58 19 nil nil t)
+ (make-overlay 57 47 nil nil t)
+ (make-overlay 49 5 nil t t)
+ (make-overlay 21 59 nil t t)
+ (make-overlay 42 33 nil t nil)
+ (make-overlay 22 16 nil t t)
+ (make-overlay 9 51 nil t nil)
+ (make-overlay 20 24 nil nil t)
+ (make-overlay 21 7 nil t t)
+ (make-overlay 58 52 nil t t)
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 55 54)
+ (goto-char 54)
+ (insert ".............")
+ (goto-char 55)
+ (insert "............")
+ (goto-char 66)
+ (delete-char 10)
+ (goto-char 62)
+ (insert "...............")
+ (goto-char 82)
+ (delete-char 2)
+ (goto-char 82)
+ (delete-char 0)
+ (goto-char 76)
+ (insert "..............")
+ (goto-char 60)
+ (insert ".............")
+ (goto-char 71)
+ (insert "...............")
+ (goto-char 122)
+ (delete-char 0)
+ (goto-char 93)
+ (delete-char 3)
+ (goto-char 108)
+ (delete-char 1)
+ (goto-char 121)
+ (insert "........")
+ (goto-char 92)
+ (insert "")
+ (goto-char 103)
+ (insert "..........")
+ (goto-char 85)
+ (delete-char 13)
+ (goto-char 116)
+ (delete-char 7)
+ (goto-char 103)
+ (widen)
+ (narrow-to-region 60 27)
+ (goto-char 28)
+ (delete-char 16)
+ (goto-char 35)
+ (insert ".......")
+ (goto-char 47)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 1)
+ (goto-char 43)
+ (insert "..........")
+ (goto-char 59)
+ (insert "........")
+ (goto-char 57)
+ (insert "........")
+ (goto-char 36)
+ (insert "...........")
+ (goto-char 82)
+ (delete-char 11)
+ (goto-char 67)
+ (insert "..........")
+ (goto-char 46)
+ (delete-char 1)
+ (goto-char 47)
+ (insert "......")
+ (goto-char 69)
+ (delete-char 7)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((5 . 28)
+ (5 . 33)
+ (9 . 35)
+ (15 . 28)
+ (19 . 154)
+ (21 . 155)
+ (28 . 28)
+ (28 . 28)
+ (28 . 28)
+ (28 . 28)
+ (31 . 153)
+ (58 . 154))))))
+
+(ert-deftest overlay-autogenerated-test-15 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 3 19 nil t t)
+ (make-overlay 11 18 nil t nil)
+ (make-overlay 28 51 nil nil t)
+ (make-overlay 29 15 nil t t)
+ (make-overlay 46 57 nil t t)
+ (make-overlay 26 24 nil nil nil)
+ (make-overlay 29 43 nil nil nil)
+ (make-overlay 54 29 nil nil nil)
+ (make-overlay 34 52 nil t nil)
+ (make-overlay 10 32 nil nil nil)
+ (make-overlay 28 34 nil nil t)
+ (make-overlay 11 43 nil nil nil)
+ (make-overlay 18 50 nil t t)
+ (make-overlay 28 39 nil nil nil)
+ (make-overlay 62 62 nil t t)
+ (make-overlay 30 62 nil t nil)
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 6 22)
+ (goto-char 9)
+ (insert "..")
+ (goto-char 12)
+ (insert ".............")
+ (goto-char 29)
+ (insert "..............")
+ (goto-char 47)
+ (insert "........")
+ (goto-char 46)
+ (insert ".............")
+ (goto-char 55)
+ (insert "..........")
+ (goto-char 62)
+ (insert "...............")
+ (goto-char 47)
+ (delete-char 49)
+ (goto-char 11)
+ (insert "...........")
+ (goto-char 40)
+ (delete-char 1)
+ (goto-char 27)
+ (insert "..............")
+ (goto-char 51)
+ (insert "......")
+ (goto-char 60)
+ (delete-char 10)
+ (goto-char 37)
+ (insert ".........")
+ (goto-char 69)
+ (insert ".")
+ (goto-char 36)
+ (insert "............")
+ (goto-char 75)
+ (insert ".............")
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 44 21)
+ (goto-char 37)
+ (insert ".............")
+ (goto-char 55)
+ (widen)
+ (narrow-to-region 84 28)
+ (goto-char 58)
+ (widen)
+ (narrow-to-region 96 49)
+ (goto-char 62)
+ (delete-char 0)
+ (goto-char 72)
+ (delete-char 24)
+ (goto-char 61)
+ (widen)
+ (narrow-to-region 105 83)
+ (goto-char 96)
+ (widen)
+ (narrow-to-region 109 46)
+ (goto-char 95)
+ (delete-char 4)
+ (goto-char 81)
+ (insert ".")
+ (goto-char 51)
+ (delete-char 8)
+ (goto-char 52)
+ (insert ".")
+ (goto-char 60)
+ (delete-char 10)
+ (goto-char 50)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 81)
+ (23 . 88)
+ (66 . 99)
+ (69 . 81)
+ (78 . 85)
+ (81 . 106)
+ (84 . 85)
+ (85 . 90)
+ (85 . 95)
+ (85 . 99)
+ (85 . 107)
+ (85 . 110)
+ (86 . 118)
+ (90 . 108))))))
+
+(ert-deftest overlay-autogenerated-test-16 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 3 55 nil t nil)
+ (make-overlay 45 47 nil nil nil)
+ (make-overlay 23 57 nil t t)
+ (make-overlay 64 55 nil nil nil)
+ (make-overlay 37 26 nil t t)
+ (make-overlay 29 38 nil nil t)
+ (make-overlay 33 3 nil t t)
+ (make-overlay 49 16 nil t nil)
+ (make-overlay 35 56 nil t t)
+ (make-overlay 9 39 nil nil nil)
+ (make-overlay 2 61 nil nil nil)
+ (make-overlay 59 26 nil nil t)
+ (make-overlay 5 50 nil t t)
+ (make-overlay 19 19 nil nil t)
+ (make-overlay 64 21 nil t nil)
+ (make-overlay 21 8 nil nil t)
+ (goto-char 17)
+ (insert ".....")
+ (goto-char 29)
+ (insert "............")
+ (goto-char 42)
+ (delete-char 38)
+ (goto-char 24)
+ (insert "")
+ (goto-char 9)
+ (delete-char 2)
+ (goto-char 20)
+ (insert "..")
+ (goto-char 27)
+ (delete-char 8)
+ (goto-char 25)
+ (delete-char 6)
+ (goto-char 8)
+ (delete-char 21)
+ (goto-char 9)
+ (insert "..............")
+ (goto-char 3)
+ (insert "....")
+ (goto-char 8)
+ (delete-char 18)
+ (goto-char 6)
+ (widen)
+ (narrow-to-region 5 8)
+ (goto-char 5)
+ (delete-char 3)
+ (goto-char 5)
+ (insert "...")
+ (goto-char 8)
+ (insert "..........")
+ (goto-char 5)
+ (insert "")
+ (goto-char 7)
+ (delete-char 8)
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 2 2)
+ (goto-char 2)
+ (delete-char 0)
+ (goto-char 2)
+ (delete-char 0)
+ (goto-char 2)
+ (delete-char 0)
+ (goto-char 2)
+ (delete-char 0)
+ (goto-char 2)
+ (widen)
+ (narrow-to-region 10 3)
+ (goto-char 8)
+ (delete-char 2)
+ (goto-char 7)
+ (insert ".......")
+ (goto-char 8)
+ (delete-char 3)
+ (goto-char 12)
+ (insert "..")
+ (goto-char 9)
+ (delete-char 2)
+ (goto-char 7)
+ (insert "......")
+ (goto-char 15)
+ (insert "..........")
+ (goto-char 4)
+ (insert "........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 36)
+ (13 . 36)
+ (13 . 36)
+ (13 . 36))))))
+
+(ert-deftest overlay-autogenerated-test-17 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 15 37 nil t nil)
+ (make-overlay 40 3 nil t t)
+ (make-overlay 61 19 nil t t)
+ (make-overlay 46 9 nil nil t)
+ (make-overlay 64 39 nil nil t)
+ (make-overlay 50 58 nil nil t)
+ (make-overlay 21 30 nil t nil)
+ (make-overlay 44 54 nil t nil)
+ (make-overlay 32 2 nil t nil)
+ (make-overlay 14 9 nil t t)
+ (make-overlay 41 40 nil t nil)
+ (make-overlay 17 26 nil t nil)
+ (make-overlay 57 50 nil t t)
+ (make-overlay 16 65 nil nil t)
+ (make-overlay 13 61 nil t t)
+ (make-overlay 39 64 nil nil t)
+ (goto-char 37)
+ (widen)
+ (narrow-to-region 12 1)
+ (goto-char 12)
+ (insert "......")
+ (goto-char 8)
+ (delete-char 4)
+ (goto-char 11)
+ (delete-char 3)
+ (goto-char 6)
+ (insert ".....")
+ (goto-char 6)
+ (widen)
+ (narrow-to-region 53 48)
+ (goto-char 48)
+ (delete-char 5)
+ (goto-char 48)
+ (widen)
+ (narrow-to-region 59 58)
+ (goto-char 59)
+ (delete-char 0)
+ (goto-char 58)
+ (insert "...")
+ (goto-char 60)
+ (insert "...............")
+ (goto-char 58)
+ (insert ".............")
+ (goto-char 67)
+ (insert ".....")
+ (goto-char 73)
+ (insert "")
+ (goto-char 68)
+ (insert ".....")
+ (goto-char 64)
+ (insert "....")
+ (goto-char 62)
+ (insert "..")
+ (goto-char 91)
+ (insert "..........")
+ (goto-char 80)
+ (insert "............")
+ (goto-char 100)
+ (delete-char 21)
+ (goto-char 74)
+ (insert "...")
+ (goto-char 60)
+ (delete-char 30)
+ (goto-char 64)
+ (widen)
+ (narrow-to-region 71 23)
+ (goto-char 53)
+ (delete-char 11)
+ (goto-char 23)
+ (delete-char 21)
+ (goto-char 39)
+ (delete-char 0)
+ (goto-char 35)
+ (insert "")
+ (goto-char 35)
+ (insert ".........")
+ (goto-char 30)
+ (insert "...........")
+ (goto-char 35)
+ (insert "..")
+ (goto-char 37)
+ (delete-char 1)
+ (goto-char 28)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((13 . 27)
+ (17 . 67)
+ (20 . 71)
+ (23 . 23)
+ (23 . 24)
+ (23 . 67)
+ (23 . 70)
+ (23 . 70)
+ (27 . 41)
+ (28 . 41)
+ (28 . 41))))))
+
+(ert-deftest overlay-autogenerated-test-18 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 43 52 nil nil t)
+ (make-overlay 27 29 nil nil t)
+ (make-overlay 24 18 nil nil nil)
+ (make-overlay 39 52 nil nil nil)
+ (make-overlay 33 62 nil t t)
+ (make-overlay 16 7 nil t nil)
+ (make-overlay 47 39 nil nil t)
+ (make-overlay 59 41 nil nil nil)
+ (make-overlay 22 55 nil nil t)
+ (make-overlay 60 16 nil t t)
+ (make-overlay 55 20 nil nil t)
+ (make-overlay 25 12 nil nil t)
+ (make-overlay 26 2 nil nil t)
+ (make-overlay 17 35 nil nil t)
+ (make-overlay 46 41 nil t nil)
+ (make-overlay 57 53 nil t t)
+ (goto-char 52)
+ (insert "")
+ (goto-char 4)
+ (delete-char 21)
+ (goto-char 17)
+ (insert "")
+ (goto-char 35)
+ (insert "...............")
+ (goto-char 8)
+ (insert "...............")
+ (goto-char 9)
+ (insert "........")
+ (goto-char 73)
+ (delete-char 9)
+ (goto-char 62)
+ (insert "...............")
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 34 84)
+ (goto-char 81)
+ (insert "...........")
+ (goto-char 48)
+ (insert "...")
+ (goto-char 74)
+ (insert ".......")
+ (goto-char 41)
+ (widen)
+ (narrow-to-region 37 105)
+ (goto-char 75)
+ (insert "...............")
+ (goto-char 47)
+ (insert "..........")
+ (goto-char 99)
+ (delete-char 13)
+ (goto-char 105)
+ (delete-char 4)
+ (goto-char 94)
+ (delete-char 5)
+ (goto-char 96)
+ (insert "..............")
+ (goto-char 74)
+ (insert "")
+ (goto-char 121)
+ (insert "...")
+ (goto-char 102)
+ (insert "...")
+ (goto-char 64)
+ (insert "......")
+ (goto-char 67)
+ (insert "...")
+ (goto-char 95)
+ (delete-char 19)
+ (goto-char 37)
+ (insert "..........")
+ (goto-char 50)
+ (widen)
+ (narrow-to-region 67 96)
+ (goto-char 88)
+ (insert "..........")
+ (goto-char 91)
+ (insert ".............")
+ (goto-char 70)
+ (delete-char 8)
+ (goto-char 111)
+ (widen)
+ (narrow-to-region 72 103)
+ (goto-char 101)
+ (insert "...............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 119)
+ (4 . 119)
+ (4 . 162)
+ (35 . 162)
+ (51 . 78)
+ (53 . 162)
+ (55 . 78)
+ (79 . 162))))))
+
+(ert-deftest overlay-autogenerated-test-19 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 19 31 nil t t)
+ (make-overlay 40 5 nil nil nil)
+ (make-overlay 13 41 nil t t)
+ (make-overlay 41 43 nil nil t)
+ (make-overlay 7 60 nil t nil)
+ (make-overlay 40 23 nil t nil)
+ (make-overlay 32 15 nil t t)
+ (make-overlay 12 45 nil nil nil)
+ (make-overlay 18 1 nil nil nil)
+ (make-overlay 58 32 nil t t)
+ (make-overlay 30 3 nil t t)
+ (make-overlay 43 61 nil t nil)
+ (make-overlay 54 57 nil nil t)
+ (make-overlay 34 14 nil t t)
+ (make-overlay 26 49 nil nil t)
+ (make-overlay 54 49 nil nil t)
+ (goto-char 28)
+ (insert "........")
+ (goto-char 32)
+ (insert "...........")
+ (goto-char 78)
+ (delete-char 6)
+ (goto-char 37)
+ (delete-char 0)
+ (goto-char 49)
+ (insert ".........")
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 8 30)
+ (goto-char 20)
+ (delete-char 4)
+ (goto-char 23)
+ (delete-char 1)
+ (goto-char 10)
+ (insert ".")
+ (goto-char 22)
+ (delete-char 2)
+ (goto-char 22)
+ (insert "......")
+ (goto-char 17)
+ (insert "..........")
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 21)
+ (insert "............")
+ (goto-char 45)
+ (delete-char 7)
+ (goto-char 39)
+ (insert "...............")
+ (goto-char 29)
+ (insert "........")
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 63)
+ (delete-char 1)
+ (goto-char 33)
+ (insert "........")
+ (goto-char 16)
+ (delete-char 36)
+ (goto-char 20)
+ (delete-char 2)
+ (goto-char 28)
+ (delete-char 0)
+ (goto-char 24)
+ (insert "...........")
+ (goto-char 43)
+ (insert "..........")
+ (goto-char 30)
+ (delete-char 1)
+ (goto-char 40)
+ (delete-char 13)
+ (goto-char 22)
+ (delete-char 19)
+ (goto-char 10)
+ (delete-char 8)
+ (goto-char 14)
+ (delete-char 0)
+ (goto-char 12)
+ (delete-char 2)
+ (goto-char 11)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 12)
+ (3 . 40)
+ (5 . 50)
+ (7 . 69)
+ (10 . 42)
+ (10 . 44)
+ (10 . 51)
+ (10 . 55))))))
+
+(ert-deftest overlay-autogenerated-test-20 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 44 42 nil t t)
+ (make-overlay 47 1 nil nil nil)
+ (make-overlay 24 48 nil nil nil)
+ (make-overlay 62 50 nil nil t)
+ (make-overlay 54 38 nil nil nil)
+ (make-overlay 3 9 nil nil nil)
+ (make-overlay 61 28 nil t nil)
+ (make-overlay 33 33 nil nil t)
+ (make-overlay 37 37 nil t nil)
+ (make-overlay 20 13 nil nil t)
+ (make-overlay 54 36 nil t nil)
+ (make-overlay 18 58 nil nil t)
+ (make-overlay 55 3 nil nil t)
+ (make-overlay 23 21 nil t t)
+ (make-overlay 47 55 nil t t)
+ (make-overlay 50 12 nil nil nil)
+ (goto-char 11)
+ (delete-char 46)
+ (goto-char 7)
+ (delete-char 3)
+ (goto-char 14)
+ (delete-char 1)
+ (goto-char 14)
+ (insert "......")
+ (goto-char 14)
+ (delete-char 4)
+ (goto-char 12)
+ (widen)
+ (narrow-to-region 11 12)
+ (goto-char 11)
+ (insert "...")
+ (goto-char 13)
+ (delete-char 1)
+ (goto-char 14)
+ (insert ".")
+ (goto-char 13)
+ (delete-char 2)
+ (goto-char 11)
+ (delete-char 2)
+ (goto-char 11)
+ (insert "")
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 11)
+ (insert ".")
+ (goto-char 11)
+ (insert ".")
+ (goto-char 12)
+ (insert "......")
+ (goto-char 14)
+ (delete-char 2)
+ (goto-char 11)
+ (delete-char 2)
+ (goto-char 14)
+ (insert "............")
+ (goto-char 19)
+ (insert "..............")
+ (goto-char 29)
+ (insert ".....")
+ (goto-char 42)
+ (delete-char 1)
+ (goto-char 22)
+ (insert ".....")
+ (goto-char 19)
+ (insert "..............")
+ (goto-char 42)
+ (insert ".....")
+ (goto-char 63)
+ (widen)
+ (narrow-to-region 26 42)
+ (goto-char 36)
+ (insert "..........")
+ (goto-char 40)
+ (delete-char 11)
+ (goto-char 26)
+ (delete-char 13)
+ (goto-char 28)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((8 . 56))))))
+
+(ert-deftest overlay-autogenerated-test-21 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 65 15 nil nil nil)
+ (make-overlay 52 31 nil nil nil)
+ (make-overlay 12 51 nil t t)
+ (make-overlay 42 20 nil nil t)
+ (make-overlay 51 48 nil nil nil)
+ (make-overlay 59 28 nil t t)
+ (make-overlay 51 53 nil t nil)
+ (make-overlay 50 59 nil nil t)
+ (make-overlay 24 40 nil t nil)
+ (make-overlay 51 61 nil nil nil)
+ (make-overlay 12 58 nil nil t)
+ (make-overlay 64 17 nil t t)
+ (make-overlay 26 38 nil t t)
+ (make-overlay 23 36 nil nil nil)
+ (make-overlay 57 50 nil nil nil)
+ (make-overlay 42 15 nil nil t)
+ (goto-char 14)
+ (insert "............")
+ (goto-char 37)
+ (insert ".")
+ (goto-char 73)
+ (insert "..........")
+ (goto-char 17)
+ (delete-char 31)
+ (goto-char 21)
+ (delete-char 35)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 7)
+ (delete-char 2)
+ (goto-char 1)
+ (insert "")
+ (goto-char 5)
+ (insert ".......")
+ (goto-char 8)
+ (insert "....")
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 10)
+ (insert ".............")
+ (goto-char 24)
+ (delete-char 16)
+ (goto-char 14)
+ (insert ".............")
+ (goto-char 25)
+ (delete-char 11)
+ (goto-char 3)
+ (insert "........")
+ (goto-char 38)
+ (insert "............")
+ (goto-char 41)
+ (insert "..............")
+ (goto-char 56)
+ (delete-char 3)
+ (goto-char 15)
+ (widen)
+ (narrow-to-region 16 53)
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 18 33)
+ (goto-char 32)
+ (insert "......")
+ (goto-char 38)
+ (delete-char 1)
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 11 11)
+ (goto-char 11)
+ (insert ".........")
+ (goto-char 11)
+ (insert ".........")
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 22 69)
+ (goto-char 49)
+ (insert ".........")
+ (goto-char 54)
+ (delete-char 22)
+ (goto-char 44)
+ (insert "........")
+ (goto-char 40)
+ (delete-char 7)
+ (goto-char 29)
+ (delete-char 22)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33))))))
+
+(ert-deftest overlay-autogenerated-test-22 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 12 14 nil nil t)
+ (make-overlay 54 7 nil nil t)
+ (make-overlay 8 3 nil nil nil)
+ (make-overlay 42 32 nil nil nil)
+ (make-overlay 10 27 nil t t)
+ (make-overlay 50 28 nil t t)
+ (make-overlay 39 35 nil nil nil)
+ (make-overlay 12 4 nil t t)
+ (make-overlay 29 54 nil nil nil)
+ (make-overlay 14 52 nil t t)
+ (make-overlay 9 15 nil t nil)
+ (make-overlay 44 11 nil nil nil)
+ (make-overlay 46 29 nil t t)
+ (make-overlay 40 58 nil t t)
+ (make-overlay 40 61 nil t nil)
+ (make-overlay 13 59 nil nil t)
+ (goto-char 32)
+ (insert ".............")
+ (goto-char 25)
+ (delete-char 10)
+ (goto-char 3)
+ (insert ".............")
+ (goto-char 33)
+ (delete-char 32)
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 41 46)
+ (goto-char 43)
+ (delete-char 2)
+ (goto-char 42)
+ (delete-char 2)
+ (goto-char 42)
+ (insert "...")
+ (goto-char 43)
+ (delete-char 1)
+ (goto-char 42)
+ (widen)
+ (narrow-to-region 8 46)
+ (goto-char 25)
+ (delete-char 7)
+ (goto-char 12)
+ (delete-char 10)
+ (goto-char 23)
+ (insert "...............")
+ (goto-char 41)
+ (delete-char 3)
+ (goto-char 17)
+ (insert ".........")
+ (goto-char 37)
+ (insert "...............")
+ (goto-char 53)
+ (delete-char 7)
+ (goto-char 53)
+ (delete-char 0)
+ (goto-char 42)
+ (widen)
+ (narrow-to-region 20 54)
+ (goto-char 20)
+ (delete-char 28)
+ (goto-char 23)
+ (insert "..........")
+ (goto-char 30)
+ (insert "......")
+ (goto-char 26)
+ (delete-char 1)
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 40 37)
+ (goto-char 37)
+ (insert ".....")
+ (goto-char 41)
+ (widen)
+ (narrow-to-region 13 37)
+ (goto-char 29)
+ (insert "...........")
+ (goto-char 33)
+ (delete-char 7)
+ (goto-char 33)
+ (delete-char 8)
+ (goto-char 20)
+ (insert "")
+ (goto-char 23)
+ (delete-char 7)
+ (goto-char 14)
+ (widen)
+ (narrow-to-region 33 33)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((15 . 39)
+ (16 . 38)
+ (16 . 39))))))
+
+(ert-deftest overlay-autogenerated-test-23 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 51 32 nil t t)
+ (make-overlay 13 61 nil t nil)
+ (make-overlay 47 19 nil nil t)
+ (make-overlay 11 30 nil nil nil)
+ (make-overlay 50 26 nil t t)
+ (make-overlay 64 13 nil t t)
+ (make-overlay 29 8 nil t t)
+ (make-overlay 25 42 nil t t)
+ (make-overlay 33 28 nil t t)
+ (make-overlay 54 7 nil nil nil)
+ (make-overlay 30 59 nil nil nil)
+ (make-overlay 65 50 nil t t)
+ (make-overlay 64 15 nil t nil)
+ (make-overlay 16 35 nil nil nil)
+ (make-overlay 40 36 nil nil t)
+ (make-overlay 31 35 nil t nil)
+ (goto-char 61)
+ (insert "......")
+ (goto-char 55)
+ (delete-char 2)
+ (goto-char 20)
+ (insert "..............")
+ (goto-char 56)
+ (insert "............")
+ (goto-char 48)
+ (delete-char 6)
+ (goto-char 9)
+ (delete-char 54)
+ (goto-char 20)
+ (delete-char 2)
+ (goto-char 16)
+ (delete-char 12)
+ (goto-char 18)
+ (insert ".............")
+ (goto-char 24)
+ (delete-char 7)
+ (goto-char 5)
+ (delete-char 2)
+ (goto-char 1)
+ (insert ".......")
+ (goto-char 1)
+ (insert ".......")
+ (goto-char 33)
+ (insert "")
+ (goto-char 4)
+ (insert "..")
+ (goto-char 5)
+ (widen)
+ (narrow-to-region 17 4)
+ (goto-char 13)
+ (insert ".")
+ (goto-char 8)
+ (insert "............")
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 4)
+ (widen)
+ (narrow-to-region 32 32)
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 32)
+ (insert "...............")
+ (goto-char 43)
+ (delete-char 4)
+ (goto-char 32)
+ (delete-char 1)
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 33 19)
+ (goto-char 27)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 2)
+ (goto-char 26)
+ (insert "")
+ (goto-char 33)
+ (delete-char 1)
+ (goto-char 27)
+ (insert ".")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((38 . 56))))))
+
+(ert-deftest overlay-autogenerated-test-24 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 63 8 nil t t)
+ (make-overlay 10 13 nil nil t)
+ (make-overlay 40 38 nil nil nil)
+ (make-overlay 21 34 nil t t)
+ (make-overlay 55 29 nil nil nil)
+ (make-overlay 36 65 nil t t)
+ (make-overlay 29 12 nil t nil)
+ (make-overlay 41 3 nil nil t)
+ (make-overlay 20 9 nil t t)
+ (make-overlay 52 42 nil t t)
+ (make-overlay 21 56 nil nil t)
+ (make-overlay 25 65 nil nil nil)
+ (make-overlay 38 4 nil t t)
+ (make-overlay 48 23 nil t t)
+ (make-overlay 52 9 nil nil t)
+ (make-overlay 48 19 nil nil nil)
+ (goto-char 43)
+ (delete-char 8)
+ (goto-char 30)
+ (delete-char 16)
+ (goto-char 7)
+ (insert "...")
+ (goto-char 14)
+ (delete-char 5)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 9)
+ (insert "...............")
+ (goto-char 13)
+ (delete-char 17)
+ (goto-char 16)
+ (delete-char 2)
+ (goto-char 9)
+ (insert "")
+ (goto-char 11)
+ (delete-char 5)
+ (goto-char 18)
+ (insert "........")
+ (goto-char 15)
+ (insert "....")
+ (goto-char 16)
+ (delete-char 14)
+ (goto-char 20)
+ (insert ".")
+ (goto-char 25)
+ (delete-char 1)
+ (goto-char 14)
+ (delete-char 14)
+ (goto-char 3)
+ (delete-char 7)
+ (goto-char 3)
+ (delete-char 4)
+ (goto-char 1)
+ (insert "...........")
+ (goto-char 9)
+ (insert ".......")
+ (goto-char 5)
+ (delete-char 7)
+ (goto-char 12)
+ (insert ".........")
+ (goto-char 2)
+ (delete-char 4)
+ (goto-char 3)
+ (widen)
+ (narrow-to-region 14 6)
+ (goto-char 9)
+ (insert "..........")
+ (goto-char 13)
+ (delete-char 8)
+ (goto-char 7)
+ (delete-char 7)
+ (goto-char 7)
+ (insert "..")
+ (goto-char 9)
+ (insert ".............")
+ (goto-char 9)
+ (insert "..........")
+ (goto-char 21)
+ (insert "...............")
+ (goto-char 42)
+ (insert ".........")
+ (should
+ (equal
+ (test-overlay-regions)
+ 'nil))))
+
+(ert-deftest overlay-autogenerated-test-25 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 24 8 nil nil t)
+ (make-overlay 41 16 nil t nil)
+ (make-overlay 3 16 nil nil nil)
+ (make-overlay 26 42 nil nil nil)
+ (make-overlay 32 45 nil nil t)
+ (make-overlay 34 19 nil nil nil)
+ (make-overlay 37 54 nil nil t)
+ (make-overlay 44 34 nil t nil)
+ (make-overlay 49 40 nil t t)
+ (make-overlay 29 34 nil t nil)
+ (make-overlay 54 16 nil t t)
+ (make-overlay 29 4 nil t nil)
+ (make-overlay 44 57 nil nil nil)
+ (make-overlay 5 32 nil nil nil)
+ (make-overlay 12 33 nil nil t)
+ (make-overlay 38 29 nil t nil)
+ (goto-char 12)
+ (delete-char 53)
+ (goto-char 1)
+ (delete-char 6)
+ (goto-char 5)
+ (widen)
+ (narrow-to-region 6 1)
+ (goto-char 6)
+ (insert "......")
+ (goto-char 10)
+ (insert "...............")
+ (goto-char 17)
+ (delete-char 5)
+ (goto-char 7)
+ (insert ".....")
+ (goto-char 8)
+ (insert "...............")
+ (goto-char 4)
+ (insert ".....")
+ (goto-char 44)
+ (widen)
+ (narrow-to-region 18 11)
+ (goto-char 15)
+ (delete-char 1)
+ (goto-char 17)
+ (delete-char 0)
+ (goto-char 13)
+ (delete-char 3)
+ (goto-char 14)
+ (insert "..")
+ (goto-char 16)
+ (insert "..")
+ (goto-char 15)
+ (delete-char 3)
+ (goto-char 13)
+ (delete-char 0)
+ (goto-char 14)
+ (insert "..........")
+ (goto-char 19)
+ (insert ".")
+ (goto-char 23)
+ (delete-char 1)
+ (goto-char 12)
+ (widen)
+ (narrow-to-region 23 40)
+ (goto-char 35)
+ (insert "....")
+ (goto-char 33)
+ (insert "..........")
+ (goto-char 37)
+ (delete-char 16)
+ (goto-char 37)
+ (delete-char 0)
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 30 8)
+ (goto-char 29)
+ (delete-char 0)
+ (goto-char 15)
+ (delete-char 15)
+ (goto-char 9)
+ (insert "...........")
+ (goto-char 9)
+ (delete-char 1)
+ (goto-char 22)
+ (delete-char 3)
+ (goto-char 10)
+ (insert ".........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 30)
+ (1 . 30)
+ (1 . 30)
+ (2 . 53)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 53)
+ (30 . 53)
+ (30 . 53))))))
+
+(ert-deftest overlay-autogenerated-test-26 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 60 59 nil t nil)
+ (make-overlay 18 11 nil nil t)
+ (make-overlay 4 44 nil nil nil)
+ (make-overlay 7 22 nil nil nil)
+ (make-overlay 54 50 nil t nil)
+ (make-overlay 59 28 nil nil nil)
+ (make-overlay 49 23 nil nil t)
+ (make-overlay 21 5 nil t nil)
+ (make-overlay 17 39 nil t nil)
+ (make-overlay 16 14 nil nil nil)
+ (make-overlay 50 26 nil nil nil)
+ (make-overlay 37 14 nil nil nil)
+ (make-overlay 6 59 nil nil t)
+ (make-overlay 30 17 nil nil t)
+ (make-overlay 17 34 nil nil t)
+ (make-overlay 7 22 nil t nil)
+ (goto-char 35)
+ (delete-char 25)
+ (goto-char 30)
+ (delete-char 7)
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 3 19)
+ (goto-char 6)
+ (insert ".........")
+ (goto-char 21)
+ (insert "...............")
+ (goto-char 12)
+ (insert ".............")
+ (goto-char 34)
+ (widen)
+ (narrow-to-region 64 37)
+ (goto-char 62)
+ (insert ".............")
+ (goto-char 50)
+ (widen)
+ (narrow-to-region 72 38)
+ (goto-char 66)
+ (insert "")
+ (goto-char 54)
+ (insert "...")
+ (goto-char 70)
+ (delete-char 4)
+ (goto-char 49)
+ (delete-char 13)
+ (goto-char 38)
+ (insert "....")
+ (goto-char 46)
+ (insert ".")
+ (goto-char 43)
+ (widen)
+ (narrow-to-region 74 53)
+ (goto-char 60)
+ (delete-char 10)
+ (goto-char 53)
+ (insert "..............")
+ (goto-char 72)
+ (insert "............")
+ (goto-char 87)
+ (delete-char 2)
+ (goto-char 73)
+ (insert "............")
+ (goto-char 81)
+ (insert "........")
+ (goto-char 106)
+ (insert "...")
+ (goto-char 95)
+ (widen)
+ (narrow-to-region 77 39)
+ (goto-char 43)
+ (insert "..........")
+ (goto-char 40)
+ (insert "...............")
+ (goto-char 101)
+ (insert "")
+ (goto-char 53)
+ (insert "....")
+ (goto-char 79)
+ (delete-char 21)
+ (goto-char 85)
+ (insert "........")
+ (goto-char 52)
+ (delete-char 41)
+ (goto-char 43)
+ (insert ".....")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 90)
+ (5 . 57)
+ (6 . 90)
+ (29 . 57)
+ (29 . 57)
+ (33 . 57))))))
+
+(ert-deftest overlay-autogenerated-test-27 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 20 12 nil t nil)
+ (make-overlay 3 10 nil t t)
+ (make-overlay 11 53 nil t nil)
+ (make-overlay 59 3 nil t nil)
+ (make-overlay 28 19 nil t t)
+ (make-overlay 16 30 nil t t)
+ (make-overlay 39 19 nil t t)
+ (make-overlay 33 50 nil t nil)
+ (make-overlay 36 54 nil nil nil)
+ (make-overlay 42 59 nil nil nil)
+ (make-overlay 30 48 nil t nil)
+ (make-overlay 20 13 nil nil t)
+ (make-overlay 63 48 nil t nil)
+ (make-overlay 48 12 nil t t)
+ (make-overlay 64 50 nil nil nil)
+ (make-overlay 7 7 nil nil nil)
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 21 54)
+ (goto-char 40)
+ (insert "..........")
+ (goto-char 21)
+ (delete-char 2)
+ (goto-char 35)
+ (widen)
+ (narrow-to-region 70 11)
+ (goto-char 45)
+ (insert "...............")
+ (goto-char 74)
+ (insert ".")
+ (goto-char 28)
+ (widen)
+ (narrow-to-region 77 67)
+ (goto-char 72)
+ (insert "..........")
+ (goto-char 85)
+ (delete-char 1)
+ (goto-char 82)
+ (widen)
+ (narrow-to-region 83 86)
+ (goto-char 83)
+ (delete-char 0)
+ (goto-char 86)
+ (delete-char 0)
+ (goto-char 86)
+ (insert "...........")
+ (goto-char 97)
+ (insert ".......")
+ (goto-char 103)
+ (widen)
+ (narrow-to-region 44 68)
+ (goto-char 49)
+ (insert "..")
+ (goto-char 65)
+ (insert ".............")
+ (goto-char 59)
+ (delete-char 0)
+ (goto-char 57)
+ (insert "........")
+ (goto-char 55)
+ (delete-char 30)
+ (goto-char 45)
+ (insert "...............")
+ (goto-char 44)
+ (insert "")
+ (goto-char 62)
+ (insert "............")
+ (goto-char 63)
+ (widen)
+ (narrow-to-region 12 5)
+ (goto-char 8)
+ (delete-char 4)
+ (goto-char 6)
+ (delete-char 0)
+ (goto-char 7)
+ (insert "..........")
+ (goto-char 15)
+ (delete-char 0)
+ (goto-char 16)
+ (insert "............")
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 13)
+ (insert "..")
+ (goto-char 32)
+ (insert "..............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 55)
+ (3 . 173)
+ (7 . 7))))))
+
+(ert-deftest overlay-autogenerated-test-28 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 59 48 nil t nil)
+ (make-overlay 59 4 nil nil t)
+ (make-overlay 45 35 nil t nil)
+ (make-overlay 13 18 nil t t)
+ (make-overlay 10 7 nil t t)
+ (make-overlay 9 8 nil nil nil)
+ (make-overlay 33 47 nil nil t)
+ (make-overlay 1 57 nil t nil)
+ (make-overlay 16 59 nil nil t)
+ (make-overlay 43 58 nil nil t)
+ (make-overlay 6 11 nil nil nil)
+ (make-overlay 59 7 nil t nil)
+ (make-overlay 3 57 nil t t)
+ (make-overlay 61 35 nil nil nil)
+ (make-overlay 57 8 nil nil nil)
+ (make-overlay 5 32 nil t nil)
+ (goto-char 18)
+ (insert "............")
+ (goto-char 43)
+ (delete-char 2)
+ (goto-char 38)
+ (delete-char 26)
+ (goto-char 42)
+ (insert ".....")
+ (goto-char 52)
+ (insert "..........")
+ (goto-char 45)
+ (delete-char 11)
+ (goto-char 33)
+ (insert "....")
+ (goto-char 23)
+ (delete-char 14)
+ (goto-char 33)
+ (widen)
+ (narrow-to-region 30 33)
+ (goto-char 30)
+ (delete-char 0)
+ (goto-char 30)
+ (insert "...........")
+ (goto-char 30)
+ (delete-char 7)
+ (goto-char 30)
+ (insert ".")
+ (goto-char 32)
+ (delete-char 4)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 32)
+ (insert "...............")
+ (goto-char 46)
+ (insert ".........")
+ (goto-char 45)
+ (delete-char 3)
+ (goto-char 49)
+ (delete-char 2)
+ (goto-char 42)
+ (delete-char 2)
+ (goto-char 32)
+ (insert "..........")
+ (goto-char 47)
+ (insert "....")
+ (goto-char 59)
+ (insert ".......")
+ (goto-char 35)
+ (insert ".")
+ (goto-char 45)
+ (insert "..............")
+ (goto-char 37)
+ (insert "..")
+ (goto-char 80)
+ (insert ".....")
+ (goto-char 30)
+ (insert ".............")
+ (goto-char 102)
+ (insert "............")
+ (goto-char 113)
+ (insert "")
+ (goto-char 66)
+ (widen)
+ (narrow-to-region 47 38)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 45)
+ (3 . 117)
+ (4 . 121)
+ (7 . 121)
+ (8 . 45)
+ (16 . 121)
+ (28 . 121)
+ (28 . 121)
+ (28 . 121))))))
+
+(ert-deftest overlay-autogenerated-test-29 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 5 63 nil nil t)
+ (make-overlay 20 28 nil t t)
+ (make-overlay 58 53 nil t nil)
+ (make-overlay 4 57 nil t t)
+ (make-overlay 4 16 nil nil nil)
+ (make-overlay 33 26 nil t nil)
+ (make-overlay 9 32 nil t t)
+ (make-overlay 11 8 nil nil nil)
+ (make-overlay 59 35 nil nil t)
+ (make-overlay 15 25 nil t t)
+ (make-overlay 36 16 nil nil nil)
+ (make-overlay 8 37 nil nil nil)
+ (make-overlay 65 63 nil nil t)
+ (make-overlay 3 20 nil nil t)
+ (make-overlay 44 55 nil t t)
+ (make-overlay 45 25 nil t nil)
+ (goto-char 39)
+ (insert "...")
+ (goto-char 22)
+ (insert "........")
+ (goto-char 60)
+ (insert ".........")
+ (goto-char 17)
+ (insert "............")
+ (goto-char 13)
+ (widen)
+ (narrow-to-region 79 16)
+ (goto-char 19)
+ (delete-char 11)
+ (goto-char 25)
+ (insert "........")
+ (goto-char 61)
+ (insert "....")
+ (goto-char 45)
+ (widen)
+ (narrow-to-region 73 66)
+ (goto-char 71)
+ (insert "............")
+ (goto-char 81)
+ (delete-char 2)
+ (goto-char 73)
+ (insert "..........")
+ (goto-char 74)
+ (insert "............")
+ (goto-char 82)
+ (delete-char 7)
+ (goto-char 78)
+ (delete-char 18)
+ (goto-char 75)
+ (insert ".........")
+ (goto-char 66)
+ (insert ".........")
+ (goto-char 86)
+ (delete-char 12)
+ (goto-char 77)
+ (widen)
+ (narrow-to-region 23 55)
+ (goto-char 43)
+ (insert ".")
+ (goto-char 50)
+ (insert "..")
+ (goto-char 25)
+ (delete-char 18)
+ (goto-char 33)
+ (delete-char 7)
+ (goto-char 26)
+ (insert "........")
+ (goto-char 29)
+ (insert "...........")
+ (goto-char 33)
+ (insert "...")
+ (goto-char 40)
+ (insert "..........")
+ (goto-char 26)
+ (insert "")
+ (goto-char 35)
+ (insert ".")
+ (goto-char 59)
+ (insert ".")
+ (goto-char 51)
+ (insert "..")
+ (goto-char 59)
+ (insert ".............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 130)
+ (5 . 136)
+ (8 . 82)
+ (9 . 82)
+ (15 . 25)
+ (16 . 82)
+ (21 . 77)
+ (25 . 105)
+ (75 . 82))))))
+
+(ert-deftest overlay-autogenerated-test-30 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 27 65 nil t t)
+ (make-overlay 39 51 nil t t)
+ (make-overlay 53 2 nil nil nil)
+ (make-overlay 3 17 nil nil t)
+ (make-overlay 35 4 nil nil t)
+ (make-overlay 65 53 nil t nil)
+ (make-overlay 8 21 nil t t)
+ (make-overlay 18 62 nil t t)
+ (make-overlay 42 59 nil nil t)
+ (make-overlay 12 37 nil t t)
+ (make-overlay 64 31 nil t nil)
+ (make-overlay 39 54 nil nil t)
+ (make-overlay 41 24 nil t nil)
+ (make-overlay 10 21 nil nil t)
+ (make-overlay 49 15 nil t nil)
+ (make-overlay 49 63 nil nil t)
+ (goto-char 43)
+ (insert "..........")
+ (goto-char 44)
+ (delete-char 29)
+ (goto-char 32)
+ (insert "..")
+ (goto-char 13)
+ (insert ".")
+ (goto-char 42)
+ (insert ".........")
+ (goto-char 39)
+ (insert "..........")
+ (goto-char 15)
+ (insert "............")
+ (goto-char 58)
+ (delete-char 9)
+ (goto-char 63)
+ (insert ".........")
+ (goto-char 49)
+ (insert ".")
+ (goto-char 28)
+ (delete-char 51)
+ (goto-char 12)
+ (delete-char 6)
+ (goto-char 20)
+ (delete-char 2)
+ (goto-char 7)
+ (widen)
+ (narrow-to-region 2 9)
+ (goto-char 5)
+ (insert "...............")
+ (goto-char 18)
+ (delete-char 1)
+ (goto-char 4)
+ (insert ".............")
+ (goto-char 13)
+ (delete-char 22)
+ (goto-char 12)
+ (insert "")
+ (goto-char 3)
+ (insert ".............")
+ (goto-char 22)
+ (insert "...............")
+ (goto-char 9)
+ (insert "....")
+ (goto-char 8)
+ (insert "...........")
+ (goto-char 6)
+ (delete-char 34)
+ (goto-char 21)
+ (insert "....")
+ (goto-char 14)
+ (insert ".....")
+ (goto-char 20)
+ (insert ".......")
+ (goto-char 34)
+ (widen)
+ (narrow-to-region 3 2)
+ (goto-char 3)
+ (delete-char 0)
+ (goto-char 2)
+ (insert "..............")
+ (goto-char 15)
+ (delete-char 2)
+ (goto-char 11)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 68))))))
+
+(ert-deftest overlay-autogenerated-test-31 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 54 64 nil nil nil)
+ (make-overlay 49 12 nil nil t)
+ (make-overlay 40 12 nil t nil)
+ (make-overlay 17 38 nil nil nil)
+ (make-overlay 21 36 nil t t)
+ (make-overlay 8 38 nil t nil)
+ (make-overlay 50 22 nil t nil)
+ (make-overlay 65 15 nil nil t)
+ (make-overlay 57 60 nil t t)
+ (make-overlay 35 11 nil nil t)
+ (make-overlay 49 44 nil nil t)
+ (make-overlay 45 31 nil nil t)
+ (make-overlay 51 24 nil t t)
+ (make-overlay 20 14 nil nil nil)
+ (make-overlay 6 18 nil t t)
+ (make-overlay 25 3 nil nil nil)
+ (goto-char 18)
+ (delete-char 10)
+ (goto-char 36)
+ (delete-char 13)
+ (goto-char 8)
+ (delete-char 4)
+ (goto-char 2)
+ (delete-char 8)
+ (goto-char 12)
+ (delete-char 10)
+ (goto-char 15)
+ (delete-char 4)
+ (goto-char 16)
+ (insert ".........")
+ (goto-char 17)
+ (insert "...............")
+ (goto-char 33)
+ (delete-char 0)
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 11)
+ (insert "...........")
+ (goto-char 8)
+ (delete-char 14)
+ (goto-char 32)
+ (insert "........")
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 14 6)
+ (goto-char 10)
+ (delete-char 1)
+ (goto-char 7)
+ (widen)
+ (narrow-to-region 18 39)
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 34)
+ (widen)
+ (narrow-to-region 39 14)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 25 21)
+ (goto-char 23)
+ (delete-char 2)
+ (goto-char 23)
+ (delete-char 0)
+ (goto-char 23)
+ (insert ".........")
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 31)
+ (insert ".........")
+ (goto-char 32)
+ (insert "...")
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 10 56)
+ (goto-char 10)
+ (insert ".........")
+ (goto-char 38)
+ (insert ".........")
+ (goto-char 19)
+ (insert "..")
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 66)
+ (insert "...............")
+ (goto-char 13)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 41)
+ (3 . 117)
+ (6 . 41)
+ (8 . 41)
+ (9 . 41)
+ (10 . 42)
+ (41 . 42))))))
+
+(ert-deftest overlay-autogenerated-test-32 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 35 60 nil nil t)
+ (make-overlay 45 46 nil nil nil)
+ (make-overlay 47 11 nil nil t)
+ (make-overlay 12 51 nil t nil)
+ (make-overlay 61 17 nil t nil)
+ (make-overlay 7 24 nil t nil)
+ (make-overlay 36 37 nil nil t)
+ (make-overlay 5 39 nil t t)
+ (make-overlay 5 40 nil nil t)
+ (make-overlay 38 40 nil t t)
+ (make-overlay 47 45 nil t nil)
+ (make-overlay 61 48 nil nil nil)
+ (make-overlay 23 39 nil t t)
+ (make-overlay 11 52 nil nil nil)
+ (make-overlay 37 35 nil nil nil)
+ (make-overlay 19 20 nil t nil)
+ (goto-char 43)
+ (insert "........")
+ (goto-char 7)
+ (insert "")
+ (goto-char 28)
+ (delete-char 41)
+ (goto-char 3)
+ (delete-char 17)
+ (goto-char 2)
+ (insert ".")
+ (goto-char 7)
+ (insert ".........")
+ (goto-char 21)
+ (delete-char 4)
+ (goto-char 13)
+ (delete-char 1)
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 7)
+ (insert "")
+ (goto-char 14)
+ (insert ".....")
+ (goto-char 16)
+ (insert ".")
+ (goto-char 10)
+ (insert "..............")
+ (goto-char 16)
+ (delete-char 18)
+ (goto-char 1)
+ (delete-char 36)
+ (goto-char 1)
+ (delete-char 0)
+ (goto-char 1)
+ (delete-char 0)
+ (goto-char 1)
+ (insert ".............")
+ (goto-char 9)
+ (insert ".")
+ (goto-char 14)
+ (insert ".....")
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 15)
+ (delete-char 0)
+ (goto-char 6)
+ (delete-char 4)
+ (goto-char 11)
+ (delete-char 5)
+ (goto-char 5)
+ (insert "....")
+ (goto-char 5)
+ (insert ".....")
+ (goto-char 12)
+ (insert "")
+ (goto-char 13)
+ (insert ".......")
+ (goto-char 14)
+ (insert "......")
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 17)
+ (delete-char 0)
+ (goto-char 7)
+ (delete-char 12)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 18)
+ (1 . 18)
+ (1 . 18)
+ (1 . 18)
+ (18 . 18)
+ (18 . 18)
+ (18 . 18))))))
+
+(ert-deftest overlay-autogenerated-test-33 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 65 33 nil t nil)
+ (make-overlay 45 54 nil t t)
+ (make-overlay 17 38 nil t nil)
+ (make-overlay 58 46 nil nil t)
+ (make-overlay 21 36 nil t t)
+ (make-overlay 31 63 nil nil t)
+ (make-overlay 37 64 nil t t)
+ (make-overlay 42 19 nil nil nil)
+ (make-overlay 51 60 nil t nil)
+ (make-overlay 47 15 nil t t)
+ (make-overlay 57 47 nil nil nil)
+ (make-overlay 40 45 nil nil nil)
+ (make-overlay 44 47 nil t nil)
+ (make-overlay 42 35 nil t nil)
+ (make-overlay 1 65 nil nil t)
+ (make-overlay 29 63 nil t nil)
+ (goto-char 33)
+ (insert "...........")
+ (goto-char 56)
+ (insert ".........")
+ (goto-char 67)
+ (insert "....")
+ (goto-char 28)
+ (delete-char 35)
+ (goto-char 9)
+ (insert "......")
+ (goto-char 43)
+ (delete-char 17)
+ (goto-char 29)
+ (insert ".......")
+ (goto-char 20)
+ (insert "....")
+ (goto-char 53)
+ (insert ".......")
+ (goto-char 14)
+ (widen)
+ (narrow-to-region 38 57)
+ (goto-char 51)
+ (insert "")
+ (goto-char 57)
+ (insert ".......")
+ (goto-char 64)
+ (insert ".....")
+ (goto-char 59)
+ (delete-char 3)
+ (goto-char 45)
+ (delete-char 12)
+ (goto-char 43)
+ (insert "......")
+ (goto-char 48)
+ (insert "......")
+ (goto-char 52)
+ (insert "........")
+ (goto-char 57)
+ (delete-char 16)
+ (goto-char 43)
+ (delete-char 9)
+ (goto-char 40)
+ (insert "")
+ (goto-char 39)
+ (insert "..........")
+ (goto-char 50)
+ (widen)
+ (narrow-to-region 31 27)
+ (goto-char 27)
+ (insert "..........")
+ (goto-char 33)
+ (delete-char 0)
+ (goto-char 37)
+ (insert "..")
+ (goto-char 38)
+ (delete-char 4)
+ (goto-char 38)
+ (insert "..........")
+ (goto-char 45)
+ (insert ".....")
+ (goto-char 53)
+ (insert "...")
+ (goto-char 51)
+ (insert ".")
+ (goto-char 28)
+ (insert "...")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 93)
+ (25 . 92)
+ (41 . 88)
+ (60 . 88))))))
+
+(ert-deftest overlay-autogenerated-test-34 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 2 63 nil nil t)
+ (make-overlay 54 30 nil t nil)
+ (make-overlay 21 57 nil t nil)
+ (make-overlay 61 19 nil nil nil)
+ (make-overlay 55 8 nil nil t)
+ (make-overlay 14 51 nil nil nil)
+ (make-overlay 33 13 nil t t)
+ (make-overlay 36 25 nil t t)
+ (make-overlay 22 21 nil nil t)
+ (make-overlay 21 48 nil nil t)
+ (make-overlay 36 7 nil nil t)
+ (make-overlay 2 40 nil nil nil)
+ (make-overlay 21 27 nil nil t)
+ (make-overlay 26 2 nil nil nil)
+ (make-overlay 60 43 nil nil nil)
+ (make-overlay 12 50 nil t t)
+ (goto-char 44)
+ (delete-char 6)
+ (goto-char 5)
+ (insert "..")
+ (goto-char 17)
+ (insert "........")
+ (goto-char 48)
+ (insert "..")
+ (goto-char 27)
+ (delete-char 29)
+ (goto-char 10)
+ (delete-char 2)
+ (goto-char 35)
+ (insert ".............")
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 6)
+ (insert ".")
+ (goto-char 9)
+ (delete-char 6)
+ (goto-char 38)
+ (insert ".........")
+ (goto-char 5)
+ (insert ".........")
+ (goto-char 10)
+ (delete-char 20)
+ (goto-char 6)
+ (delete-char 6)
+ (goto-char 14)
+ (insert ".............")
+ (goto-char 31)
+ (delete-char 10)
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 27 39)
+ (goto-char 34)
+ (delete-char 5)
+ (goto-char 32)
+ (delete-char 1)
+ (goto-char 27)
+ (insert "..")
+ (goto-char 28)
+ (insert "........")
+ (goto-char 39)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 7)
+ (goto-char 44)
+ (delete-char 0)
+ (goto-char 30)
+ (insert "...............")
+ (goto-char 43)
+ (insert "............")
+ (goto-char 56)
+ (delete-char 1)
+ (goto-char 65)
+ (delete-char 3)
+ (goto-char 36)
+ (insert ".........")
+ (goto-char 74)
+ (insert ".....")
+ (goto-char 67)
+ (delete-char 5)
+ (goto-char 38)
+ (insert "..")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 80)
+ (6 . 78))))))
+
+(ert-deftest overlay-autogenerated-test-35 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 38 16 nil nil nil)
+ (make-overlay 19 22 nil t nil)
+ (make-overlay 16 43 nil nil t)
+ (make-overlay 27 5 nil nil nil)
+ (make-overlay 43 34 nil t nil)
+ (make-overlay 47 4 nil nil t)
+ (make-overlay 1 47 nil nil t)
+ (make-overlay 27 35 nil t nil)
+ (make-overlay 41 41 nil nil t)
+ (make-overlay 21 19 nil nil nil)
+ (make-overlay 16 38 nil nil t)
+ (make-overlay 33 39 nil t nil)
+ (make-overlay 34 51 nil nil t)
+ (make-overlay 45 36 nil t nil)
+ (make-overlay 42 18 nil t t)
+ (make-overlay 12 30 nil nil nil)
+ (goto-char 18)
+ (insert "")
+ (goto-char 58)
+ (delete-char 3)
+ (goto-char 58)
+ (delete-char 0)
+ (goto-char 1)
+ (insert ".......")
+ (goto-char 48)
+ (delete-char 17)
+ (goto-char 39)
+ (delete-char 6)
+ (goto-char 33)
+ (widen)
+ (narrow-to-region 45 46)
+ (goto-char 46)
+ (insert "")
+ (goto-char 46)
+ (delete-char 0)
+ (goto-char 46)
+ (insert ".....")
+ (goto-char 51)
+ (widen)
+ (narrow-to-region 17 26)
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 50 41)
+ (goto-char 45)
+ (insert "..............")
+ (goto-char 59)
+ (insert "...........")
+ (goto-char 47)
+ (delete-char 9)
+ (goto-char 59)
+ (insert "")
+ (goto-char 46)
+ (insert "")
+ (goto-char 54)
+ (delete-char 5)
+ (goto-char 57)
+ (widen)
+ (narrow-to-region 57 31)
+ (goto-char 42)
+ (delete-char 2)
+ (goto-char 52)
+ (insert "....")
+ (goto-char 44)
+ (insert "..")
+ (goto-char 44)
+ (insert "...............")
+ (goto-char 72)
+ (delete-char 1)
+ (goto-char 66)
+ (delete-char 6)
+ (goto-char 64)
+ (delete-char 5)
+ (goto-char 49)
+ (delete-char 12)
+ (goto-char 32)
+ (insert "......")
+ (goto-char 44)
+ (delete-char 2)
+ (goto-char 39)
+ (delete-char 12)
+ (goto-char 42)
+ (insert "......")
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 14 47)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 39)
+ (11 . 39)
+ (12 . 39)
+ (19 . 39)
+ (23 . 39)
+ (23 . 39)
+ (23 . 39)
+ (25 . 39)
+ (26 . 28)
+ (26 . 29)
+ (39 . 39)
+ (39 . 39)
+ (39 . 39)
+ (39 . 39)
+ (39 . 39)
+ (39 . 39))))))
+
+(ert-deftest overlay-autogenerated-test-36 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 1 38 nil t t)
+ (make-overlay 58 34 nil t nil)
+ (make-overlay 6 33 nil nil t)
+ (make-overlay 63 54 nil nil t)
+ (make-overlay 54 54 nil t t)
+ (make-overlay 21 61 nil nil nil)
+ (make-overlay 64 55 nil nil t)
+ (make-overlay 28 65 nil nil t)
+ (make-overlay 32 51 nil t nil)
+ (make-overlay 36 38 nil nil nil)
+ (make-overlay 35 21 nil nil nil)
+ (make-overlay 65 48 nil nil nil)
+ (make-overlay 32 27 nil nil t)
+ (make-overlay 27 55 nil t t)
+ (make-overlay 30 22 nil t nil)
+ (make-overlay 14 58 nil t nil)
+ (goto-char 40)
+ (delete-char 7)
+ (goto-char 42)
+ (insert "......")
+ (goto-char 11)
+ (widen)
+ (narrow-to-region 64 9)
+ (goto-char 21)
+ (delete-char 23)
+ (goto-char 24)
+ (insert "...")
+ (goto-char 13)
+ (insert "..........")
+ (goto-char 12)
+ (delete-char 5)
+ (goto-char 10)
+ (delete-char 0)
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 9 5)
+ (goto-char 6)
+ (delete-char 0)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 7)
+ (insert "............")
+ (goto-char 9)
+ (insert "...")
+ (goto-char 18)
+ (insert ".")
+ (goto-char 23)
+ (delete-char 1)
+ (goto-char 9)
+ (insert "....")
+ (goto-char 6)
+ (insert ".....")
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 28 1)
+ (goto-char 6)
+ (insert "...........")
+ (goto-char 30)
+ (delete-char 8)
+ (goto-char 2)
+ (insert ".")
+ (goto-char 18)
+ (insert "......")
+ (goto-char 5)
+ (delete-char 9)
+ (goto-char 5)
+ (delete-char 20)
+ (goto-char 4)
+ (delete-char 3)
+ (goto-char 3)
+ (delete-char 2)
+ (goto-char 3)
+ (delete-char 0)
+ (goto-char 1)
+ (insert "......")
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 39 2)
+ (goto-char 13)
+ (delete-char 12)
+ (goto-char 24)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((7 . 20)
+ (9 . 20)
+ (13 . 36)
+ (20 . 20)
+ (20 . 20)
+ (20 . 20)
+ (20 . 20)
+ (20 . 29)
+ (20 . 33)
+ (20 . 36)
+ (20 . 39)
+ (20 . 43)
+ (20 . 43))))))
+
+(ert-deftest overlay-autogenerated-test-37 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 26 30 nil nil nil)
+ (make-overlay 55 50 nil nil t)
+ (make-overlay 43 54 nil nil t)
+ (make-overlay 53 48 nil nil nil)
+ (make-overlay 37 51 nil nil t)
+ (make-overlay 15 30 nil nil nil)
+ (make-overlay 2 24 nil t t)
+ (make-overlay 56 61 nil t nil)
+ (make-overlay 65 46 nil t nil)
+ (make-overlay 28 47 nil t nil)
+ (make-overlay 21 24 nil t t)
+ (make-overlay 17 13 nil t t)
+ (make-overlay 7 44 nil t nil)
+ (make-overlay 28 63 nil nil nil)
+ (make-overlay 22 16 nil t t)
+ (make-overlay 26 44 nil t t)
+ (goto-char 57)
+ (delete-char 6)
+ (goto-char 42)
+ (insert ".....")
+ (goto-char 63)
+ (insert ".............")
+ (goto-char 17)
+ (insert "")
+ (goto-char 57)
+ (insert "...........")
+ (goto-char 3)
+ (delete-char 47)
+ (goto-char 15)
+ (insert ".............")
+ (goto-char 28)
+ (insert "")
+ (goto-char 17)
+ (delete-char 31)
+ (goto-char 7)
+ (delete-char 16)
+ (goto-char 2)
+ (insert "...........")
+ (goto-char 2)
+ (insert "..")
+ (goto-char 18)
+ (widen)
+ (narrow-to-region 20 8)
+ (goto-char 13)
+ (widen)
+ (narrow-to-region 12 10)
+ (goto-char 10)
+ (delete-char 1)
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 10)
+ (insert "...")
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 13)
+ (insert "..")
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 10)
+ (delete-char 2)
+ (goto-char 11)
+ (insert ".....")
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 6 13)
+ (goto-char 10)
+ (insert "..")
+ (goto-char 6)
+ (delete-char 6)
+ (goto-char 8)
+ (insert "...............")
+ (goto-char 21)
+ (delete-char 0)
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 36 11)
+ (goto-char 12)
+ (insert "...............")
+ (goto-char 19)
+ (insert ".......")
+ (goto-char 56)
+ (delete-char 2)
+ (goto-char 42)
+ (delete-char 11)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((44 . 45))))))
+
+(ert-deftest overlay-autogenerated-test-38 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 29 13 nil t t)
+ (make-overlay 19 28 nil nil t)
+ (make-overlay 47 33 nil nil nil)
+ (make-overlay 8 44 nil t nil)
+ (make-overlay 48 4 nil t nil)
+ (make-overlay 8 20 nil t t)
+ (make-overlay 38 31 nil nil t)
+ (make-overlay 17 65 nil nil t)
+ (make-overlay 49 31 nil nil nil)
+ (make-overlay 39 19 nil nil t)
+ (make-overlay 40 49 nil t t)
+ (make-overlay 24 16 nil t t)
+ (make-overlay 4 41 nil t nil)
+ (make-overlay 61 42 nil t nil)
+ (make-overlay 46 11 nil nil nil)
+ (make-overlay 1 43 nil nil t)
+ (goto-char 62)
+ (delete-char 2)
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 30 38)
+ (goto-char 37)
+ (delete-char 1)
+ (goto-char 37)
+ (insert "...........")
+ (goto-char 41)
+ (delete-char 3)
+ (goto-char 39)
+ (delete-char 5)
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 31 9)
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 9)
+ (widen)
+ (narrow-to-region 62 30)
+ (goto-char 32)
+ (widen)
+ (narrow-to-region 17 48)
+ (goto-char 39)
+ (delete-char 7)
+ (goto-char 24)
+ (delete-char 8)
+ (goto-char 19)
+ (insert "")
+ (goto-char 25)
+ (delete-char 5)
+ (goto-char 28)
+ (delete-char 0)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 52 35)
+ (goto-char 49)
+ (delete-char 0)
+ (goto-char 49)
+ (delete-char 3)
+ (goto-char 48)
+ (insert "...........")
+ (goto-char 37)
+ (delete-char 23)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 35)
+ (insert "....")
+ (goto-char 35)
+ (insert "..")
+ (goto-char 39)
+ (delete-char 4)
+ (goto-char 39)
+ (delete-char 0)
+ (goto-char 36)
+ (delete-char 3)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 36)
+ (insert ".....")
+ (goto-char 38)
+ (delete-char 1)
+ (goto-char 35)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 37)
+ (24 . 44)
+ (25 . 37))))))
+
+(ert-deftest overlay-autogenerated-test-39 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 15 49 nil t t)
+ (make-overlay 27 20 nil t nil)
+ (make-overlay 55 50 nil t nil)
+ (make-overlay 17 5 nil t t)
+ (make-overlay 26 56 nil nil t)
+ (make-overlay 42 11 nil t t)
+ (make-overlay 24 35 nil nil t)
+ (make-overlay 47 45 nil t t)
+ (make-overlay 37 12 nil nil t)
+ (make-overlay 17 25 nil t nil)
+ (make-overlay 32 53 nil nil nil)
+ (make-overlay 20 34 nil nil t)
+ (make-overlay 56 58 nil nil t)
+ (make-overlay 42 31 nil nil t)
+ (make-overlay 22 55 nil t t)
+ (make-overlay 55 11 nil t nil)
+ (goto-char 16)
+ (insert ".............")
+ (goto-char 30)
+ (insert ".")
+ (goto-char 12)
+ (delete-char 56)
+ (goto-char 9)
+ (insert ".............")
+ (goto-char 6)
+ (insert "....")
+ (goto-char 19)
+ (delete-char 19)
+ (goto-char 19)
+ (insert "...............")
+ (goto-char 13)
+ (delete-char 21)
+ (goto-char 7)
+ (delete-char 0)
+ (goto-char 14)
+ (widen)
+ (narrow-to-region 5 6)
+ (goto-char 5)
+ (delete-char 0)
+ (goto-char 6)
+ (insert "......")
+ (goto-char 10)
+ (delete-char 0)
+ (goto-char 7)
+ (widen)
+ (narrow-to-region 2 6)
+ (goto-char 2)
+ (insert "..........")
+ (goto-char 2)
+ (delete-char 9)
+ (goto-char 7)
+ (insert "...")
+ (goto-char 9)
+ (insert "...")
+ (goto-char 10)
+ (insert "......")
+ (goto-char 4)
+ (delete-char 14)
+ (goto-char 4)
+ (insert ".")
+ (goto-char 5)
+ (insert "..............")
+ (goto-char 13)
+ (insert "......")
+ (goto-char 10)
+ (insert "......")
+ (goto-char 20)
+ (insert "............")
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 3 32)
+ (goto-char 18)
+ (insert "..")
+ (goto-char 6)
+ (insert "......")
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 31)
+ (insert "............")
+ (goto-char 28)
+ (insert "")
+ (goto-char 9)
+ (delete-char 23)
+ (should
+ (equal
+ (test-overlay-regions)
+ 'nil))))
+
+(ert-deftest overlay-autogenerated-test-40 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 52 3 nil t nil)
+ (make-overlay 35 41 nil t t)
+ (make-overlay 4 2 nil t nil)
+ (make-overlay 51 48 nil nil t)
+ (make-overlay 44 57 nil t t)
+ (make-overlay 13 32 nil nil nil)
+ (make-overlay 46 29 nil t nil)
+ (make-overlay 28 13 nil t nil)
+ (make-overlay 10 65 nil t t)
+ (make-overlay 41 48 nil nil t)
+ (make-overlay 36 44 nil nil t)
+ (make-overlay 29 61 nil t nil)
+ (make-overlay 25 24 nil nil t)
+ (make-overlay 22 45 nil nil t)
+ (make-overlay 37 55 nil nil t)
+ (make-overlay 36 39 nil nil nil)
+ (goto-char 16)
+ (delete-char 48)
+ (goto-char 17)
+ (delete-char 0)
+ (goto-char 7)
+ (insert "..............")
+ (goto-char 30)
+ (insert "........")
+ (goto-char 11)
+ (insert "..........")
+ (goto-char 5)
+ (delete-char 14)
+ (goto-char 19)
+ (insert ".")
+ (goto-char 27)
+ (insert "..")
+ (goto-char 35)
+ (delete-char 1)
+ (goto-char 29)
+ (delete-char 0)
+ (goto-char 33)
+ (delete-char 2)
+ (goto-char 33)
+ (insert "..")
+ (goto-char 28)
+ (insert ".........")
+ (goto-char 30)
+ (delete-char 4)
+ (goto-char 40)
+ (delete-char 1)
+ (goto-char 15)
+ (widen)
+ (narrow-to-region 40 8)
+ (goto-char 10)
+ (delete-char 13)
+ (goto-char 11)
+ (delete-char 5)
+ (goto-char 15)
+ (insert "........")
+ (goto-char 26)
+ (delete-char 4)
+ (goto-char 11)
+ (delete-char 1)
+ (goto-char 14)
+ (insert "............")
+ (goto-char 33)
+ (insert ".")
+ (goto-char 10)
+ (insert "...")
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 28 9)
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 27)
+ (delete-char 1)
+ (goto-char 26)
+ (insert "..")
+ (goto-char 27)
+ (insert "..")
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 12)
+ (widen)
+ (narrow-to-region 40 30)
+ (goto-char 37)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((13 . 37)
+ (14 . 37)
+ (14 . 37)
+ (14 . 37)
+ (14 . 37)
+ (14 . 37)
+ (14 . 37)
+ (37 . 37)
+ (37 . 37))))))
+
+(ert-deftest overlay-autogenerated-test-41 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 28 48 nil nil t)
+ (make-overlay 30 11 nil nil t)
+ (make-overlay 7 12 nil t nil)
+ (make-overlay 65 35 nil t nil)
+ (make-overlay 22 61 nil t nil)
+ (make-overlay 37 42 nil nil nil)
+ (make-overlay 33 38 nil nil t)
+ (make-overlay 48 45 nil t t)
+ (make-overlay 45 62 nil t nil)
+ (make-overlay 63 7 nil nil t)
+ (make-overlay 23 42 nil t nil)
+ (make-overlay 21 4 nil t nil)
+ (make-overlay 64 41 nil t nil)
+ (make-overlay 20 33 nil t t)
+ (make-overlay 41 26 nil t nil)
+ (make-overlay 43 31 nil t t)
+ (goto-char 55)
+ (delete-char 3)
+ (goto-char 12)
+ (insert "..")
+ (goto-char 62)
+ (insert "")
+ (goto-char 24)
+ (delete-char 2)
+ (goto-char 41)
+ (insert "............")
+ (goto-char 2)
+ (insert ".")
+ (goto-char 55)
+ (insert "........")
+ (goto-char 67)
+ (delete-char 6)
+ (goto-char 58)
+ (delete-char 10)
+ (goto-char 29)
+ (insert "")
+ (goto-char 6)
+ (widen)
+ (narrow-to-region 44 45)
+ (goto-char 44)
+ (delete-char 1)
+ (goto-char 44)
+ (widen)
+ (narrow-to-region 24 37)
+ (goto-char 30)
+ (delete-char 7)
+ (goto-char 27)
+ (insert "......")
+ (goto-char 35)
+ (delete-char 0)
+ (goto-char 32)
+ (insert "...............")
+ (goto-char 37)
+ (delete-char 9)
+ (goto-char 40)
+ (insert "..........")
+ (goto-char 35)
+ (insert "......")
+ (goto-char 25)
+ (delete-char 7)
+ (goto-char 40)
+ (delete-char 4)
+ (goto-char 25)
+ (delete-char 14)
+ (goto-char 28)
+ (insert "")
+ (goto-char 28)
+ (widen)
+ (narrow-to-region 17 43)
+ (goto-char 20)
+ (insert "..........")
+ (goto-char 22)
+ (delete-char 2)
+ (goto-char 48)
+ (insert "............")
+ (goto-char 47)
+ (insert ".........")
+ (goto-char 69)
+ (widen)
+ (narrow-to-region 52 25)
+ (goto-char 26)
+ (insert "......")
+ (goto-char 53)
+ (insert "..")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((5 . 38)
+ (8 . 97)
+ (12 . 47)
+ (37 . 47)
+ (39 . 52)
+ (39 . 87)
+ (39 . 95)
+ (46 . 90)
+ (47 . 49)
+ (47 . 90)
+ (47 . 99)
+ (48 . 87))))))
+
+(ert-deftest overlay-autogenerated-test-42 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 20 23 nil nil nil)
+ (make-overlay 45 51 nil t nil)
+ (make-overlay 34 58 nil t nil)
+ (make-overlay 27 11 nil nil nil)
+ (make-overlay 14 8 nil t t)
+ (make-overlay 64 43 nil t nil)
+ (make-overlay 61 56 nil nil t)
+ (make-overlay 28 14 nil t nil)
+ (make-overlay 21 46 nil t t)
+ (make-overlay 30 34 nil t t)
+ (make-overlay 47 40 nil nil nil)
+ (make-overlay 5 44 nil t t)
+ (make-overlay 11 45 nil nil nil)
+ (make-overlay 65 8 nil nil t)
+ (make-overlay 47 54 nil t t)
+ (make-overlay 37 57 nil t nil)
+ (goto-char 11)
+ (insert "....")
+ (goto-char 65)
+ (delete-char 0)
+ (goto-char 56)
+ (delete-char 4)
+ (goto-char 11)
+ (delete-char 2)
+ (goto-char 23)
+ (insert ".............")
+ (goto-char 2)
+ (insert "............")
+ (goto-char 84)
+ (delete-char 1)
+ (goto-char 10)
+ (insert "..............")
+ (goto-char 19)
+ (insert "............")
+ (goto-char 69)
+ (delete-char 6)
+ (goto-char 15)
+ (insert "........")
+ (goto-char 104)
+ (insert "")
+ (goto-char 94)
+ (delete-char 11)
+ (goto-char 66)
+ (insert ".....")
+ (goto-char 67)
+ (insert "")
+ (goto-char 53)
+ (delete-char 22)
+ (goto-char 42)
+ (insert ".")
+ (goto-char 38)
+ (delete-char 13)
+ (goto-char 27)
+ (insert "......")
+ (goto-char 16)
+ (insert "............")
+ (goto-char 71)
+ (widen)
+ (narrow-to-region 59 15)
+ (goto-char 46)
+ (insert "..")
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 95 93)
+ (goto-char 94)
+ (insert ".............")
+ (goto-char 103)
+ (widen)
+ (narrow-to-region 97 7)
+ (goto-char 93)
+ (insert "....")
+ (goto-char 85)
+ (insert "...........")
+ (goto-char 69)
+ (delete-char 24)
+ (goto-char 87)
+ (insert ".............")
+ (goto-char 7)
+ (delete-char 28)
+ (goto-char 65)
+ (delete-char 8)
+ (goto-char 48)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((31 . 44)
+ (33 . 33)
+ (33 . 41)
+ (33 . 41)
+ (33 . 41)
+ (33 . 41)
+ (33 . 82)
+ (40 . 44)
+ (41 . 41)
+ (41 . 41)
+ (41 . 47)
+ (41 . 48)
+ (44 . 45)
+ (44 . 46)
+ (44 . 63)
+ (46 . 57))))))
+
+(ert-deftest overlay-autogenerated-test-43 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 8 53 nil t nil)
+ (make-overlay 11 50 nil t nil)
+ (make-overlay 1 30 nil nil nil)
+ (make-overlay 54 15 nil t t)
+ (make-overlay 22 30 nil nil nil)
+ (make-overlay 1 33 nil nil nil)
+ (make-overlay 18 15 nil t nil)
+ (make-overlay 43 39 nil nil t)
+ (make-overlay 43 17 nil t nil)
+ (make-overlay 2 29 nil t nil)
+ (make-overlay 57 42 nil t nil)
+ (make-overlay 40 1 nil nil nil)
+ (make-overlay 8 64 nil nil nil)
+ (make-overlay 64 15 nil nil nil)
+ (make-overlay 9 11 nil nil t)
+ (make-overlay 40 21 nil t nil)
+ (goto-char 5)
+ (delete-char 37)
+ (goto-char 25)
+ (delete-char 2)
+ (goto-char 17)
+ (insert "...........")
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 20 20)
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 20)
+ (insert "..........")
+ (goto-char 24)
+ (delete-char 5)
+ (goto-char 24)
+ (insert "...")
+ (goto-char 28)
+ (widen)
+ (narrow-to-region 20 36)
+ (goto-char 26)
+ (delete-char 2)
+ (goto-char 31)
+ (insert ".............")
+ (goto-char 22)
+ (insert ".....")
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 31)
+ (delete-char 4)
+ (goto-char 27)
+ (insert "...")
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 37 20)
+ (goto-char 22)
+ (insert ".............")
+ (goto-char 33)
+ (insert "......")
+ (goto-char 43)
+ (insert "............")
+ (goto-char 59)
+ (insert ".......")
+ (goto-char 25)
+ (delete-char 26)
+ (goto-char 49)
+ (insert ".........")
+ (goto-char 50)
+ (insert ".......")
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 54 86)
+ (goto-char 64)
+ (insert "...............")
+ (goto-char 83)
+ (insert "............")
+ (goto-char 70)
+ (insert "........")
+ (goto-char 58)
+ (insert "..............")
+ (goto-char 83)
+ (insert "............")
+ (goto-char 83)
+ (insert "..........")
+ (goto-char 69)
+ (delete-char 75)
+ (goto-char 75)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((5 . 75)
+ (5 . 75)
+ (5 . 80)
+ (5 . 80))))))
+
+(ert-deftest overlay-autogenerated-test-44 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 8 48 nil nil t)
+ (make-overlay 52 38 nil nil nil)
+ (make-overlay 3 63 nil nil nil)
+ (make-overlay 44 15 nil nil t)
+ (make-overlay 27 44 nil nil t)
+ (make-overlay 43 9 nil nil t)
+ (make-overlay 11 27 nil t nil)
+ (make-overlay 36 41 nil nil t)
+ (make-overlay 23 25 nil t t)
+ (make-overlay 19 60 nil t t)
+ (make-overlay 11 55 nil t nil)
+ (make-overlay 59 2 nil t nil)
+ (make-overlay 32 64 nil t nil)
+ (make-overlay 15 8 nil nil nil)
+ (make-overlay 61 15 nil nil nil)
+ (make-overlay 64 30 nil t t)
+ (goto-char 42)
+ (delete-char 20)
+ (goto-char 44)
+ (delete-char 1)
+ (goto-char 43)
+ (insert "...........")
+ (goto-char 43)
+ (delete-char 1)
+ (goto-char 28)
+ (delete-char 8)
+ (goto-char 37)
+ (delete-char 9)
+ (goto-char 4)
+ (delete-char 30)
+ (goto-char 6)
+ (delete-char 0)
+ (goto-char 7)
+ (delete-char 0)
+ (goto-char 2)
+ (delete-char 2)
+ (goto-char 5)
+ (delete-char 0)
+ (goto-char 5)
+ (delete-char 0)
+ (goto-char 2)
+ (insert ".....")
+ (goto-char 10)
+ (insert "...........")
+ (goto-char 21)
+ (insert "...")
+ (goto-char 10)
+ (delete-char 13)
+ (goto-char 9)
+ (insert "..........")
+ (goto-char 16)
+ (delete-char 1)
+ (goto-char 16)
+ (delete-char 4)
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 14)
+ (delete-char 1)
+ (goto-char 3)
+ (widen)
+ (narrow-to-region 2 9)
+ (goto-char 2)
+ (insert "")
+ (goto-char 2)
+ (insert ".............")
+ (goto-char 17)
+ (insert "....")
+ (goto-char 12)
+ (insert "........")
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 32 23)
+ (goto-char 29)
+ (insert ".....")
+ (goto-char 35)
+ (delete-char 2)
+ (goto-char 27)
+ (delete-char 7)
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 4 14)
+ (goto-char 8)
+ (insert "...............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 43)
+ (2 . 43)
+ (2 . 43)
+ (2 . 43)
+ (2 . 43)
+ (2 . 44))))))
+
+(ert-deftest overlay-autogenerated-test-45 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 15 48 nil nil nil)
+ (make-overlay 1 47 nil t nil)
+ (make-overlay 43 4 nil t t)
+ (make-overlay 9 45 nil t t)
+ (make-overlay 1 25 nil t t)
+ (make-overlay 5 46 nil t t)
+ (make-overlay 7 14 nil t nil)
+ (make-overlay 1 53 nil nil t)
+ (make-overlay 13 41 nil t nil)
+ (make-overlay 5 31 nil t t)
+ (make-overlay 26 10 nil nil nil)
+ (make-overlay 56 37 nil nil nil)
+ (make-overlay 23 15 nil t nil)
+ (make-overlay 62 30 nil t t)
+ (make-overlay 2 35 nil t t)
+ (make-overlay 46 41 nil nil nil)
+ (goto-char 65)
+ (delete-char 0)
+ (goto-char 55)
+ (insert "...........")
+ (goto-char 22)
+ (insert "")
+ (goto-char 73)
+ (delete-char 3)
+ (goto-char 43)
+ (widen)
+ (narrow-to-region 54 63)
+ (goto-char 56)
+ (insert "......")
+ (goto-char 61)
+ (delete-char 3)
+ (goto-char 65)
+ (insert "......")
+ (goto-char 66)
+ (insert ".....")
+ (goto-char 62)
+ (insert ".")
+ (goto-char 74)
+ (insert ".........")
+ (goto-char 76)
+ (delete-char 4)
+ (goto-char 56)
+ (widen)
+ (narrow-to-region 2 46)
+ (goto-char 43)
+ (insert "...........")
+ (goto-char 20)
+ (delete-char 4)
+ (goto-char 38)
+ (delete-char 7)
+ (goto-char 25)
+ (delete-char 21)
+ (goto-char 12)
+ (insert ".........")
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 72 61)
+ (goto-char 63)
+ (insert "")
+ (goto-char 65)
+ (delete-char 4)
+ (goto-char 61)
+ (delete-char 5)
+ (goto-char 63)
+ (delete-char 0)
+ (goto-char 63)
+ (delete-char 0)
+ (goto-char 62)
+ (delete-char 0)
+ (goto-char 61)
+ (insert "............")
+ (goto-char 72)
+ (insert "..............")
+ (goto-char 62)
+ (delete-char 7)
+ (goto-char 71)
+ (delete-char 5)
+ (goto-char 75)
+ (widen)
+ (narrow-to-region 29 8)
+ (goto-char 17)
+ (delete-char 2)
+ (goto-char 27)
+ (insert "........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 36)
+ (1 . 41)
+ (1 . 47)
+ (2 . 40)
+ (4 . 40)
+ (5 . 40)
+ (5 . 40)
+ (7 . 21)
+ (9 . 40)
+ (10 . 37)
+ (20 . 40)
+ (22 . 27)
+ (22 . 42))))))
+
+(ert-deftest overlay-autogenerated-test-46 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 2 43 nil nil t)
+ (make-overlay 44 40 nil nil t)
+ (make-overlay 49 14 nil nil t)
+ (make-overlay 6 55 nil nil nil)
+ (make-overlay 13 52 nil t t)
+ (make-overlay 40 54 nil t nil)
+ (make-overlay 51 41 nil nil t)
+ (make-overlay 7 28 nil nil t)
+ (make-overlay 10 47 nil nil t)
+ (make-overlay 63 21 nil t nil)
+ (make-overlay 4 55 nil nil nil)
+ (make-overlay 52 58 nil t nil)
+ (make-overlay 62 11 nil t t)
+ (make-overlay 22 49 nil t nil)
+ (make-overlay 23 65 nil nil nil)
+ (make-overlay 50 33 nil nil t)
+ (goto-char 22)
+ (insert "..............")
+ (goto-char 12)
+ (insert "....")
+ (goto-char 25)
+ (delete-char 16)
+ (goto-char 14)
+ (delete-char 53)
+ (goto-char 2)
+ (insert "............")
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 11)
+ (delete-char 7)
+ (goto-char 9)
+ (widen)
+ (narrow-to-region 11 7)
+ (goto-char 8)
+ (insert "...............")
+ (goto-char 12)
+ (delete-char 4)
+ (goto-char 21)
+ (insert "...")
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 7)
+ (delete-char 3)
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 12)
+ (delete-char 1)
+ (goto-char 15)
+ (delete-char 0)
+ (goto-char 7)
+ (insert "..............")
+ (goto-char 17)
+ (insert "...........")
+ (goto-char 15)
+ (insert "............")
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 7)
+ (insert "....")
+ (goto-char 37)
+ (delete-char 7)
+ (goto-char 8)
+ (insert "..........")
+ (goto-char 47)
+ (insert ".............")
+ (goto-char 65)
+ (insert ".......")
+ (goto-char 39)
+ (delete-char 26)
+ (goto-char 14)
+ (delete-char 2)
+ (goto-char 27)
+ (insert ".............")
+ (goto-char 17)
+ (widen)
+ (narrow-to-region 54 32)
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 10 3)
+ (goto-char 7)
+ (insert "........")
+ (goto-char 13)
+ (insert "..............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 85))))))
+
+(ert-deftest overlay-autogenerated-test-47 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 62 nil t nil)
+ (make-overlay 14 38 nil nil nil)
+ (make-overlay 63 44 nil t t)
+ (make-overlay 41 41 nil nil t)
+ (make-overlay 19 39 nil nil nil)
+ (make-overlay 10 49 nil t t)
+ (make-overlay 56 38 nil t t)
+ (make-overlay 23 38 nil nil t)
+ (make-overlay 1 64 nil nil t)
+ (make-overlay 21 3 nil t nil)
+ (make-overlay 1 1 nil nil t)
+ (make-overlay 27 61 nil nil nil)
+ (make-overlay 29 59 nil nil nil)
+ (make-overlay 37 30 nil t nil)
+ (make-overlay 47 21 nil nil t)
+ (make-overlay 34 26 nil t nil)
+ (goto-char 6)
+ (delete-char 44)
+ (goto-char 8)
+ (delete-char 0)
+ (goto-char 8)
+ (insert "....")
+ (goto-char 17)
+ (delete-char 2)
+ (goto-char 12)
+ (insert "...")
+ (goto-char 20)
+ (insert "")
+ (goto-char 2)
+ (delete-char 20)
+ (goto-char 1)
+ (insert ".........")
+ (goto-char 7)
+ (insert ".............")
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 15)
+ (insert "..........")
+ (goto-char 36)
+ (insert "..............")
+ (goto-char 26)
+ (insert "..............")
+ (goto-char 63)
+ (insert "...........")
+ (goto-char 9)
+ (insert "............")
+ (goto-char 71)
+ (delete-char 17)
+ (goto-char 36)
+ (insert "....")
+ (goto-char 45)
+ (delete-char 31)
+ (goto-char 28)
+ (delete-char 8)
+ (goto-char 10)
+ (delete-char 16)
+ (goto-char 14)
+ (delete-char 4)
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 15)
+ (insert "")
+ (goto-char 14)
+ (delete-char 1)
+ (goto-char 10)
+ (delete-char 2)
+ (goto-char 6)
+ (delete-char 0)
+ (goto-char 1)
+ (insert ".........")
+ (goto-char 23)
+ (insert "......")
+ (goto-char 25)
+ (insert "..........")
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 10 30)
+ (goto-char 21)
+ (delete-char 1)
+ (goto-char 17)
+ (insert "..........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 48)
+ (1 . 48)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 48)
+ (32 . 48)
+ (32 . 48))))))
+
+(ert-deftest overlay-autogenerated-test-48 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 1 11 nil nil nil)
+ (make-overlay 35 29 nil t t)
+ (make-overlay 24 46 nil nil t)
+ (make-overlay 15 43 nil nil t)
+ (make-overlay 51 49 nil t t)
+ (make-overlay 25 43 nil t nil)
+ (make-overlay 23 59 nil nil nil)
+ (make-overlay 10 4 nil t nil)
+ (make-overlay 40 45 nil nil nil)
+ (make-overlay 42 43 nil nil t)
+ (make-overlay 20 38 nil t nil)
+ (make-overlay 17 49 nil nil nil)
+ (make-overlay 9 25 nil nil t)
+ (make-overlay 13 19 nil nil nil)
+ (make-overlay 44 31 nil t nil)
+ (make-overlay 12 65 nil nil t)
+ (goto-char 59)
+ (widen)
+ (narrow-to-region 28 14)
+ (goto-char 26)
+ (insert "...")
+ (goto-char 30)
+ (delete-char 1)
+ (goto-char 23)
+ (insert "...")
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 45 67)
+ (goto-char 50)
+ (insert "...............")
+ (goto-char 59)
+ (insert "..............")
+ (goto-char 55)
+ (insert ".............")
+ (goto-char 106)
+ (delete-char 0)
+ (goto-char 97)
+ (delete-char 10)
+ (goto-char 67)
+ (delete-char 16)
+ (goto-char 76)
+ (insert "..............")
+ (goto-char 71)
+ (insert ".............")
+ (goto-char 110)
+ (delete-char 0)
+ (goto-char 56)
+ (delete-char 38)
+ (goto-char 61)
+ (delete-char 10)
+ (goto-char 56)
+ (delete-char 5)
+ (goto-char 49)
+ (insert ".......")
+ (goto-char 62)
+ (insert "...")
+ (goto-char 54)
+ (insert "..........")
+ (goto-char 47)
+ (delete-char 10)
+ (goto-char 47)
+ (delete-char 20)
+ (goto-char 46)
+ (insert ".............")
+ (goto-char 56)
+ (insert "...........")
+ (goto-char 70)
+ (delete-char 1)
+ (goto-char 62)
+ (widen)
+ (narrow-to-region 50 64)
+ (goto-char 60)
+ (insert "..")
+ (goto-char 55)
+ (delete-char 6)
+ (goto-char 60)
+ (insert ".............")
+ (goto-char 61)
+ (delete-char 9)
+ (goto-char 64)
+ (delete-char 0)
+ (goto-char 53)
+ (widen)
+ (narrow-to-region 15 62)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((9 . 28)
+ (12 . 73)
+ (13 . 19)
+ (15 . 70)
+ (17 . 70)
+ (20 . 43)
+ (23 . 70)
+ (27 . 70)
+ (28 . 70)
+ (34 . 40)
+ (36 . 70)
+ (45 . 70))))))
+
+(ert-deftest overlay-autogenerated-test-49 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 24 10 nil nil t)
+ (make-overlay 53 23 nil t nil)
+ (make-overlay 53 9 nil nil t)
+ (make-overlay 65 64 nil t t)
+ (make-overlay 48 2 nil nil t)
+ (make-overlay 12 58 nil nil t)
+ (make-overlay 64 64 nil nil nil)
+ (make-overlay 26 13 nil t t)
+ (make-overlay 46 26 nil nil t)
+ (make-overlay 28 59 nil t t)
+ (make-overlay 33 52 nil nil nil)
+ (make-overlay 39 8 nil t t)
+ (make-overlay 9 59 nil t t)
+ (make-overlay 50 45 nil nil t)
+ (make-overlay 41 53 nil nil t)
+ (make-overlay 51 51 nil t nil)
+ (goto-char 61)
+ (insert "..............")
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 10 65)
+ (goto-char 65)
+ (delete-char 0)
+ (goto-char 11)
+ (insert "...............")
+ (goto-char 77)
+ (delete-char 0)
+ (goto-char 51)
+ (insert "...")
+ (goto-char 75)
+ (insert ".....")
+ (goto-char 77)
+ (delete-char 11)
+ (goto-char 45)
+ (delete-char 0)
+ (goto-char 24)
+ (widen)
+ (narrow-to-region 33 52)
+ (goto-char 46)
+ (insert "..............")
+ (goto-char 46)
+ (insert "..........")
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 46 77)
+ (goto-char 77)
+ (insert "..............")
+ (goto-char 54)
+ (insert ".......")
+ (goto-char 87)
+ (insert ".")
+ (goto-char 70)
+ (delete-char 16)
+ (goto-char 79)
+ (delete-char 0)
+ (goto-char 73)
+ (widen)
+ (narrow-to-region 74 100)
+ (goto-char 91)
+ (insert ".............")
+ (goto-char 80)
+ (delete-char 11)
+ (goto-char 82)
+ (insert "......")
+ (goto-char 108)
+ (delete-char 0)
+ (goto-char 104)
+ (insert ".....")
+ (goto-char 100)
+ (delete-char 1)
+ (goto-char 90)
+ (insert ".............")
+ (goto-char 99)
+ (insert ".............")
+ (goto-char 124)
+ (insert "..............")
+ (goto-char 114)
+ (insert "....")
+ (goto-char 134)
+ (delete-char 0)
+ (goto-char 89)
+ (delete-char 65)
+ (goto-char 75)
+ (delete-char 16)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 75)
+ (8 . 75)
+ (9 . 76)
+ (9 . 82)
+ (27 . 82)
+ (38 . 76)
+ (41 . 75)
+ (43 . 82)
+ (70 . 75))))))
+
+(ert-deftest overlay-autogenerated-test-50 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 29 53 nil t t)
+ (make-overlay 65 64 nil nil nil)
+ (make-overlay 3 31 nil nil t)
+ (make-overlay 45 59 nil t nil)
+ (make-overlay 60 37 nil t t)
+ (make-overlay 7 5 nil t t)
+ (make-overlay 37 24 nil nil nil)
+ (make-overlay 45 20 nil nil nil)
+ (make-overlay 33 42 nil nil t)
+ (make-overlay 47 57 nil t nil)
+ (make-overlay 14 49 nil t t)
+ (make-overlay 14 30 nil t nil)
+ (make-overlay 21 40 nil t t)
+ (make-overlay 5 45 nil t t)
+ (make-overlay 59 40 nil t t)
+ (make-overlay 37 52 nil nil nil)
+ (goto-char 48)
+ (insert "")
+ (goto-char 7)
+ (insert ".........")
+ (goto-char 31)
+ (insert "...........")
+ (goto-char 41)
+ (delete-char 7)
+ (goto-char 21)
+ (delete-char 11)
+ (goto-char 41)
+ (widen)
+ (narrow-to-region 51 53)
+ (goto-char 52)
+ (insert ".....")
+ (goto-char 55)
+ (widen)
+ (narrow-to-region 18 24)
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 39 38)
+ (goto-char 38)
+ (insert ".............")
+ (goto-char 41)
+ (insert "......")
+ (goto-char 38)
+ (insert "..............")
+ (goto-char 52)
+ (insert "...............")
+ (goto-char 78)
+ (delete-char 5)
+ (goto-char 50)
+ (insert "..........")
+ (goto-char 50)
+ (delete-char 3)
+ (goto-char 85)
+ (widen)
+ (narrow-to-region 86 1)
+ (goto-char 5)
+ (insert "....")
+ (goto-char 69)
+ (insert "...........")
+ (goto-char 94)
+ (insert "......")
+ (goto-char 98)
+ (delete-char 7)
+ (goto-char 46)
+ (insert "...............")
+ (goto-char 79)
+ (insert "............")
+ (goto-char 89)
+ (insert "")
+ (goto-char 14)
+ (delete-char 63)
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 34)
+ (insert "...")
+ (goto-char 53)
+ (delete-char 14)
+ (goto-char 6)
+ (widen)
+ (narrow-to-region 6 52)
+ (goto-char 42)
+ (insert "...........")
+ (goto-char 40)
+ (insert ".......")
+ (goto-char 46)
+ (widen)
+ (narrow-to-region 1 68)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 14)
+ (9 . 14)
+ (9 . 91)
+ (14 . 14)
+ (14 . 83)
+ (14 . 86)
+ (14 . 88)
+ (14 . 91)
+ (14 . 95)
+ (14 . 104))))))
+
+(ert-deftest overlay-autogenerated-test-51 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 14 5 nil t nil)
+ (make-overlay 62 34 nil nil t)
+ (make-overlay 7 62 nil nil t)
+ (make-overlay 23 12 nil t t)
+ (make-overlay 16 4 nil nil nil)
+ (make-overlay 24 15 nil nil nil)
+ (make-overlay 6 6 nil t t)
+ (make-overlay 25 64 nil t t)
+ (make-overlay 23 6 nil t t)
+ (make-overlay 55 64 nil nil nil)
+ (make-overlay 8 62 nil nil t)
+ (make-overlay 65 65 nil nil nil)
+ (make-overlay 57 51 nil t t)
+ (make-overlay 35 8 nil t nil)
+ (make-overlay 55 13 nil nil t)
+ (make-overlay 60 62 nil nil t)
+ (goto-char 12)
+ (insert "..")
+ (goto-char 66)
+ (insert "............")
+ (goto-char 32)
+ (insert "..")
+ (goto-char 27)
+ (insert ".........")
+ (goto-char 8)
+ (insert ".............")
+ (goto-char 79)
+ (insert ".")
+ (goto-char 47)
+ (insert "....")
+ (goto-char 49)
+ (insert "...")
+ (goto-char 81)
+ (insert "....")
+ (goto-char 112)
+ (delete-char 0)
+ (goto-char 97)
+ (insert ".....")
+ (goto-char 109)
+ (delete-char 5)
+ (goto-char 20)
+ (insert ".....")
+ (goto-char 59)
+ (delete-char 33)
+ (goto-char 87)
+ (insert ".............")
+ (goto-char 98)
+ (insert "....")
+ (goto-char 22)
+ (delete-char 36)
+ (goto-char 45)
+ (insert "..............")
+ (goto-char 42)
+ (delete-char 29)
+ (goto-char 51)
+ (widen)
+ (narrow-to-region 39 41)
+ (goto-char 39)
+ (delete-char 2)
+ (goto-char 39)
+ (insert ".............")
+ (goto-char 51)
+ (insert "......")
+ (goto-char 52)
+ (insert "...............")
+ (goto-char 56)
+ (widen)
+ (narrow-to-region 59 20)
+ (goto-char 56)
+ (insert "............")
+ (goto-char 57)
+ (insert ".")
+ (goto-char 37)
+ (delete-char 12)
+ (goto-char 39)
+ (delete-char 11)
+ (goto-char 38)
+ (delete-char 8)
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 65 26)
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 27 55)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((7 . 55)
+ (8 . 55)
+ (22 . 29)
+ (23 . 55)
+ (23 . 56)
+ (24 . 31)
+ (29 . 56)
+ (37 . 55))))))
+
+(ert-deftest overlay-autogenerated-test-52 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 32 nil nil nil)
+ (make-overlay 44 54 nil nil t)
+ (make-overlay 27 50 nil nil nil)
+ (make-overlay 55 35 nil nil t)
+ (make-overlay 40 46 nil nil t)
+ (make-overlay 56 63 nil t nil)
+ (make-overlay 29 48 nil nil nil)
+ (make-overlay 45 24 nil t nil)
+ (make-overlay 60 25 nil t nil)
+ (make-overlay 55 41 nil t nil)
+ (make-overlay 55 1 nil nil t)
+ (make-overlay 30 45 nil t t)
+ (make-overlay 26 19 nil nil t)
+ (make-overlay 61 5 nil nil nil)
+ (make-overlay 33 5 nil nil nil)
+ (make-overlay 42 18 nil t nil)
+ (goto-char 55)
+ (insert ".")
+ (goto-char 49)
+ (delete-char 12)
+ (goto-char 41)
+ (insert "..........")
+ (goto-char 27)
+ (insert ".....")
+ (goto-char 58)
+ (insert "...........")
+ (goto-char 24)
+ (delete-char 23)
+ (goto-char 47)
+ (delete-char 9)
+ (goto-char 4)
+ (insert "...")
+ (goto-char 10)
+ (delete-char 32)
+ (goto-char 4)
+ (insert "..............")
+ (goto-char 29)
+ (insert "....")
+ (goto-char 28)
+ (delete-char 2)
+ (goto-char 34)
+ (insert "...........")
+ (goto-char 9)
+ (insert "......")
+ (goto-char 5)
+ (insert "")
+ (goto-char 45)
+ (delete-char 1)
+ (goto-char 18)
+ (insert ".........")
+ (goto-char 36)
+ (delete-char 5)
+ (goto-char 15)
+ (delete-char 27)
+ (goto-char 15)
+ (delete-char 10)
+ (goto-char 16)
+ (delete-char 2)
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 10 2)
+ (goto-char 9)
+ (delete-char 1)
+ (goto-char 3)
+ (delete-char 2)
+ (goto-char 2)
+ (widen)
+ (narrow-to-region 9 10)
+ (goto-char 9)
+ (insert "...........")
+ (goto-char 19)
+ (delete-char 0)
+ (goto-char 14)
+ (delete-char 3)
+ (goto-char 11)
+ (delete-char 2)
+ (goto-char 9)
+ (delete-char 6)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 10)
+ (insert "....")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 17))))))
+
+(ert-deftest overlay-autogenerated-test-53 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 10 30 nil nil nil)
+ (make-overlay 11 57 nil t nil)
+ (make-overlay 59 56 nil nil t)
+ (make-overlay 20 37 nil nil t)
+ (make-overlay 41 29 nil nil nil)
+ (make-overlay 31 10 nil nil t)
+ (make-overlay 6 36 nil nil nil)
+ (make-overlay 12 54 nil nil nil)
+ (make-overlay 25 26 nil t t)
+ (make-overlay 21 19 nil nil t)
+ (make-overlay 1 21 nil nil t)
+ (make-overlay 48 51 nil nil nil)
+ (make-overlay 54 55 nil t nil)
+ (make-overlay 64 48 nil t t)
+ (make-overlay 56 25 nil nil t)
+ (make-overlay 12 60 nil t nil)
+ (goto-char 41)
+ (delete-char 1)
+ (goto-char 63)
+ (insert "")
+ (goto-char 14)
+ (delete-char 5)
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 41)
+ (widen)
+ (narrow-to-region 12 1)
+ (goto-char 1)
+ (delete-char 3)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 5)
+ (insert "..............")
+ (goto-char 1)
+ (insert "..........")
+ (goto-char 29)
+ (insert "...............")
+ (goto-char 4)
+ (insert "..")
+ (goto-char 31)
+ (delete-char 15)
+ (goto-char 31)
+ (insert "")
+ (goto-char 27)
+ (insert "......")
+ (goto-char 6)
+ (insert "...")
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 23 47)
+ (goto-char 37)
+ (delete-char 2)
+ (goto-char 35)
+ (delete-char 5)
+ (goto-char 38)
+ (delete-char 2)
+ (goto-char 30)
+ (insert ".......")
+ (goto-char 45)
+ (widen)
+ (narrow-to-region 13 2)
+ (goto-char 9)
+ (delete-char 1)
+ (goto-char 3)
+ (insert ".....")
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 16)
+ (delete-char 5)
+ (goto-char 20)
+ (insert ".....")
+ (goto-char 26)
+ (delete-char 0)
+ (goto-char 26)
+ (widen)
+ (narrow-to-region 76 98)
+ (goto-char 88)
+ (insert ".........")
+ (goto-char 92)
+ (insert ".")
+ (goto-char 108)
+ (delete-char 0)
+ (goto-char 103)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 79)
+ (37 . 103)
+ (61 . 88)
+ (61 . 99)
+ (74 . 121)
+ (75 . 118)
+ (75 . 124)
+ (77 . 79)
+ (78 . 103)
+ (83 . 84)
+ (83 . 120)
+ (87 . 106))))))
+
+(ert-deftest overlay-autogenerated-test-54 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 36 nil t t)
+ (make-overlay 55 49 nil nil t)
+ (make-overlay 12 25 nil nil t)
+ (make-overlay 16 37 nil t t)
+ (make-overlay 42 25 nil t t)
+ (make-overlay 8 41 nil t t)
+ (make-overlay 13 27 nil nil t)
+ (make-overlay 52 22 nil t nil)
+ (make-overlay 36 17 nil t nil)
+ (make-overlay 1 52 nil t nil)
+ (make-overlay 55 5 nil nil t)
+ (make-overlay 50 50 nil t nil)
+ (make-overlay 32 15 nil t nil)
+ (make-overlay 39 26 nil t nil)
+ (make-overlay 26 4 nil nil nil)
+ (make-overlay 38 47 nil t t)
+ (goto-char 23)
+ (insert ".")
+ (goto-char 57)
+ (delete-char 6)
+ (goto-char 54)
+ (insert "..............")
+ (goto-char 46)
+ (insert "...............")
+ (goto-char 29)
+ (insert ".......")
+ (goto-char 58)
+ (delete-char 21)
+ (goto-char 45)
+ (delete-char 4)
+ (goto-char 50)
+ (delete-char 4)
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 16)
+ (insert "......")
+ (goto-char 17)
+ (insert ".....")
+ (goto-char 63)
+ (insert "........")
+ (goto-char 83)
+ (insert "....")
+ (goto-char 73)
+ (delete-char 8)
+ (goto-char 69)
+ (insert "...........")
+ (goto-char 48)
+ (widen)
+ (narrow-to-region 19 31)
+ (goto-char 22)
+ (delete-char 3)
+ (goto-char 23)
+ (delete-char 5)
+ (goto-char 20)
+ (insert "............")
+ (goto-char 23)
+ (delete-char 11)
+ (goto-char 19)
+ (insert "..........")
+ (goto-char 23)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 1)
+ (goto-char 33)
+ (delete-char 5)
+ (goto-char 27)
+ (insert "..........")
+ (goto-char 35)
+ (delete-char 8)
+ (goto-char 35)
+ (insert ".")
+ (goto-char 20)
+ (insert "......")
+ (goto-char 22)
+ (delete-char 22)
+ (goto-char 23)
+ (delete-char 0)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 1 41)
+ (goto-char 13)
+ (insert ".......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 83)
+ (4 . 46)
+ (5 . 97)
+ (8 . 83)
+ (12 . 45)
+ (13 . 47)
+ (22 . 59)
+ (30 . 82)
+ (30 . 83)
+ (41 . 83)
+ (45 . 83)
+ (46 . 83))))))
+
+(ert-deftest overlay-autogenerated-test-55 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 20 nil nil nil)
+ (make-overlay 60 33 nil t nil)
+ (make-overlay 6 27 nil nil nil)
+ (make-overlay 53 31 nil nil t)
+ (make-overlay 30 55 nil t t)
+ (make-overlay 4 64 nil t t)
+ (make-overlay 51 31 nil nil t)
+ (make-overlay 4 65 nil t t)
+ (make-overlay 57 62 nil t t)
+ (make-overlay 28 7 nil nil t)
+ (make-overlay 61 48 nil t nil)
+ (make-overlay 23 54 nil nil t)
+ (make-overlay 47 49 nil nil nil)
+ (make-overlay 12 52 nil t nil)
+ (make-overlay 39 57 nil t t)
+ (make-overlay 28 61 nil nil t)
+ (goto-char 8)
+ (insert "..............")
+ (goto-char 63)
+ (delete-char 3)
+ (goto-char 67)
+ (delete-char 6)
+ (goto-char 3)
+ (widen)
+ (narrow-to-region 10 67)
+ (goto-char 43)
+ (insert ".............")
+ (goto-char 20)
+ (insert "...............")
+ (goto-char 18)
+ (insert "..")
+ (goto-char 37)
+ (delete-char 47)
+ (goto-char 34)
+ (insert "..............")
+ (goto-char 31)
+ (delete-char 2)
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 29 36)
+ (goto-char 31)
+ (delete-char 2)
+ (goto-char 31)
+ (insert ".......")
+ (goto-char 40)
+ (delete-char 0)
+ (goto-char 32)
+ (widen)
+ (narrow-to-region 40 19)
+ (goto-char 40)
+ (insert "..")
+ (goto-char 37)
+ (delete-char 0)
+ (goto-char 40)
+ (delete-char 1)
+ (goto-char 34)
+ (delete-char 4)
+ (goto-char 33)
+ (insert "..............")
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 78 70)
+ (goto-char 77)
+ (insert ".........")
+ (goto-char 80)
+ (delete-char 1)
+ (goto-char 73)
+ (delete-char 3)
+ (goto-char 70)
+ (insert ".........")
+ (goto-char 75)
+ (delete-char 10)
+ (goto-char 74)
+ (delete-char 3)
+ (goto-char 73)
+ (insert "...............")
+ (goto-char 90)
+ (insert "......")
+ (goto-char 94)
+ (insert "..............")
+ (goto-char 101)
+ (insert "........")
+ (goto-char 111)
+ (insert "........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 132)
+ (4 . 133)
+ (65 . 89)
+ (65 . 89)
+ (65 . 89)
+ (65 . 89)
+ (65 . 129)
+ (65 . 130)
+ (65 . 130)
+ (65 . 130)
+ (65 . 130)
+ (89 . 89)
+ (89 . 130))))))
+
+(ert-deftest overlay-autogenerated-test-56 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 7 14 nil nil t)
+ (make-overlay 10 10 nil nil t)
+ (make-overlay 21 23 nil nil t)
+ (make-overlay 4 44 nil t nil)
+ (make-overlay 42 16 nil t t)
+ (make-overlay 1 57 nil t nil)
+ (make-overlay 15 27 nil nil nil)
+ (make-overlay 31 1 nil t nil)
+ (make-overlay 56 45 nil t t)
+ (make-overlay 46 19 nil t nil)
+ (make-overlay 15 6 nil nil nil)
+ (make-overlay 31 26 nil nil t)
+ (make-overlay 39 41 nil t t)
+ (make-overlay 52 48 nil nil t)
+ (make-overlay 44 2 nil t nil)
+ (make-overlay 60 7 nil nil t)
+ (goto-char 49)
+ (delete-char 11)
+ (goto-char 43)
+ (delete-char 9)
+ (goto-char 42)
+ (delete-char 2)
+ (goto-char 12)
+ (insert "...........")
+ (goto-char 36)
+ (insert ".........")
+ (goto-char 1)
+ (insert "......")
+ (goto-char 67)
+ (delete-char 0)
+ (goto-char 47)
+ (insert ".............")
+ (goto-char 57)
+ (insert "........")
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 75 33)
+ (goto-char 41)
+ (delete-char 28)
+ (goto-char 43)
+ (delete-char 0)
+ (goto-char 33)
+ (delete-char 5)
+ (goto-char 38)
+ (insert "..")
+ (goto-char 42)
+ (delete-char 0)
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 38)
+ (insert "............")
+ (goto-char 51)
+ (insert ".......")
+ (goto-char 48)
+ (insert "..")
+ (goto-char 55)
+ (insert ".")
+ (goto-char 33)
+ (delete-char 8)
+ (goto-char 42)
+ (insert "..")
+ (goto-char 45)
+ (insert "..")
+ (goto-char 59)
+ (insert ".............")
+ (goto-char 53)
+ (insert ".......")
+ (goto-char 81)
+ (delete-char 0)
+ (goto-char 44)
+ (delete-char 36)
+ (goto-char 38)
+ (delete-char 8)
+ (goto-char 33)
+ (insert ".............")
+ (goto-char 41)
+ (insert "..............")
+ (goto-char 65)
+ (insert "...............")
+ (goto-char 61)
+ (insert "...")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((7 . 86)
+ (7 . 97)
+ (8 . 97)
+ (10 . 97)
+ (13 . 97)
+ (32 . 68)
+ (33 . 60)
+ (60 . 97)
+ (60 . 97)
+ (68 . 86))))))
+
+(ert-deftest overlay-autogenerated-test-57 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 52 31 nil t nil)
+ (make-overlay 39 17 nil t nil)
+ (make-overlay 19 20 nil t t)
+ (make-overlay 18 3 nil nil t)
+ (make-overlay 19 47 nil nil t)
+ (make-overlay 38 54 nil nil nil)
+ (make-overlay 30 51 nil nil t)
+ (make-overlay 29 60 nil t t)
+ (make-overlay 57 38 nil nil nil)
+ (make-overlay 13 41 nil t nil)
+ (make-overlay 9 44 nil t nil)
+ (make-overlay 30 55 nil t nil)
+ (make-overlay 33 10 nil nil nil)
+ (make-overlay 14 35 nil nil t)
+ (make-overlay 53 50 nil t nil)
+ (make-overlay 25 28 nil nil t)
+ (goto-char 40)
+ (insert "..")
+ (goto-char 64)
+ (insert "........")
+ (goto-char 47)
+ (insert "............")
+ (goto-char 65)
+ (delete-char 0)
+ (goto-char 86)
+ (delete-char 1)
+ (goto-char 59)
+ (delete-char 11)
+ (goto-char 64)
+ (delete-char 8)
+ (goto-char 53)
+ (delete-char 0)
+ (goto-char 28)
+ (delete-char 8)
+ (goto-char 6)
+ (delete-char 33)
+ (goto-char 14)
+ (delete-char 2)
+ (goto-char 2)
+ (delete-char 10)
+ (goto-char 3)
+ (insert "..")
+ (goto-char 5)
+ (insert ".........")
+ (goto-char 1)
+ (insert "........")
+ (goto-char 10)
+ (delete-char 4)
+ (goto-char 26)
+ (insert "........")
+ (goto-char 23)
+ (insert "....")
+ (goto-char 1)
+ (widen)
+ (narrow-to-region 15 23)
+ (goto-char 19)
+ (insert "...")
+ (goto-char 24)
+ (delete-char 0)
+ (goto-char 19)
+ (insert ".......")
+ (goto-char 18)
+ (insert "..")
+ (goto-char 33)
+ (insert "...")
+ (goto-char 32)
+ (insert "...............")
+ (goto-char 29)
+ (delete-char 10)
+ (goto-char 29)
+ (insert "..........")
+ (goto-char 50)
+ (insert "")
+ (goto-char 16)
+ (insert ".........")
+ (goto-char 52)
+ (widen)
+ (narrow-to-region 59 15)
+ (goto-char 35)
+ (delete-char 4)
+ (goto-char 18)
+ (insert "....")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((10 . 57)
+ (10 . 57)
+ (10 . 57)
+ (10 . 60)
+ (10 . 60)
+ (10 . 61)
+ (10 . 68)
+ (57 . 57))))))
+
+(ert-deftest overlay-autogenerated-test-58 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 8 16 nil t nil)
+ (make-overlay 57 27 nil nil nil)
+ (make-overlay 15 62 nil nil nil)
+ (make-overlay 32 33 nil nil t)
+ (make-overlay 47 27 nil nil t)
+ (make-overlay 41 4 nil nil t)
+ (make-overlay 57 61 nil t nil)
+ (make-overlay 18 43 nil nil t)
+ (make-overlay 64 51 nil t t)
+ (make-overlay 44 26 nil nil nil)
+ (make-overlay 9 13 nil nil t)
+ (make-overlay 41 65 nil nil t)
+ (make-overlay 23 13 nil t t)
+ (make-overlay 26 59 nil t t)
+ (make-overlay 65 65 nil t t)
+ (make-overlay 15 7 nil nil nil)
+ (goto-char 41)
+ (insert "........")
+ (goto-char 35)
+ (delete-char 14)
+ (goto-char 32)
+ (widen)
+ (narrow-to-region 23 46)
+ (goto-char 41)
+ (delete-char 5)
+ (goto-char 29)
+ (delete-char 10)
+ (goto-char 31)
+ (insert ".")
+ (goto-char 29)
+ (insert "........")
+ (goto-char 27)
+ (delete-char 7)
+ (goto-char 29)
+ (insert "")
+ (goto-char 24)
+ (insert "............")
+ (goto-char 43)
+ (delete-char 1)
+ (goto-char 31)
+ (delete-char 9)
+ (goto-char 34)
+ (widen)
+ (narrow-to-region 20 14)
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 17)
+ (insert "...........")
+ (goto-char 31)
+ (delete-char 0)
+ (goto-char 16)
+ (insert "...........")
+ (goto-char 17)
+ (delete-char 8)
+ (goto-char 23)
+ (delete-char 5)
+ (goto-char 20)
+ (insert "..........")
+ (goto-char 33)
+ (widen)
+ (narrow-to-region 16 29)
+ (goto-char 24)
+ (insert "...............")
+ (goto-char 44)
+ (delete-char 0)
+ (goto-char 30)
+ (insert "....")
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 4 22)
+ (goto-char 10)
+ (insert "..............")
+ (goto-char 36)
+ (insert "..")
+ (goto-char 10)
+ (delete-char 21)
+ (goto-char 14)
+ (delete-char 1)
+ (goto-char 14)
+ (insert "...........")
+ (goto-char 12)
+ (insert "........")
+ (goto-char 32)
+ (insert "........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 92)
+ (7 . 10)
+ (8 . 10)
+ (9 . 10)
+ (10 . 82)
+ (10 . 104))))))
+
+(ert-deftest overlay-autogenerated-test-59 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 46 30 nil t t)
+ (make-overlay 3 26 nil nil nil)
+ (make-overlay 36 28 nil t t)
+ (make-overlay 49 49 nil t t)
+ (make-overlay 27 61 nil t nil)
+ (make-overlay 14 16 nil nil nil)
+ (make-overlay 50 61 nil t nil)
+ (make-overlay 59 63 nil nil nil)
+ (make-overlay 36 34 nil t nil)
+ (make-overlay 35 29 nil nil nil)
+ (make-overlay 5 65 nil nil nil)
+ (make-overlay 20 61 nil nil t)
+ (make-overlay 10 42 nil nil nil)
+ (make-overlay 47 49 nil nil t)
+ (make-overlay 12 4 nil nil nil)
+ (make-overlay 32 24 nil t t)
+ (goto-char 11)
+ (insert ".")
+ (goto-char 32)
+ (delete-char 2)
+ (goto-char 61)
+ (insert ".........")
+ (goto-char 36)
+ (insert "........")
+ (goto-char 55)
+ (widen)
+ (narrow-to-region 8 55)
+ (goto-char 21)
+ (insert "....")
+ (goto-char 32)
+ (delete-char 15)
+ (goto-char 30)
+ (delete-char 5)
+ (goto-char 31)
+ (insert "......")
+ (goto-char 18)
+ (insert "..")
+ (goto-char 14)
+ (insert ".............")
+ (goto-char 34)
+ (insert "............")
+ (goto-char 51)
+ (widen)
+ (narrow-to-region 58 31)
+ (goto-char 50)
+ (delete-char 5)
+ (goto-char 53)
+ (insert ".........")
+ (goto-char 56)
+ (insert "...............")
+ (goto-char 45)
+ (delete-char 1)
+ (goto-char 67)
+ (insert "............")
+ (goto-char 84)
+ (insert "")
+ (goto-char 39)
+ (delete-char 27)
+ (goto-char 39)
+ (delete-char 21)
+ (goto-char 32)
+ (insert "............")
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 7 37)
+ (goto-char 11)
+ (insert ".......")
+ (goto-char 21)
+ (delete-char 13)
+ (goto-char 15)
+ (insert "....")
+ (goto-char 9)
+ (insert ".............")
+ (goto-char 13)
+ (delete-char 21)
+ (goto-char 21)
+ (delete-char 6)
+ (goto-char 16)
+ (insert ".......")
+ (goto-char 22)
+ (insert "")
+ (goto-char 27)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 42)
+ (4 . 16)
+ (5 . 83)
+ (13 . 51)
+ (25 . 27))))))
+
+(ert-deftest overlay-autogenerated-test-60 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 38 32 nil t nil)
+ (make-overlay 32 42 nil t nil)
+ (make-overlay 29 11 nil nil t)
+ (make-overlay 52 22 nil t t)
+ (make-overlay 39 59 nil t nil)
+ (make-overlay 41 30 nil t t)
+ (make-overlay 29 61 nil nil t)
+ (make-overlay 11 45 nil nil nil)
+ (make-overlay 46 17 nil nil t)
+ (make-overlay 35 51 nil t t)
+ (make-overlay 22 13 nil nil t)
+ (make-overlay 52 34 nil nil t)
+ (make-overlay 59 4 nil nil t)
+ (make-overlay 8 22 nil nil nil)
+ (make-overlay 4 49 nil nil nil)
+ (make-overlay 52 45 nil t t)
+ (goto-char 48)
+ (delete-char 16)
+ (goto-char 37)
+ (delete-char 8)
+ (goto-char 14)
+ (insert "...............")
+ (goto-char 40)
+ (delete-char 16)
+ (goto-char 19)
+ (insert ".........")
+ (goto-char 16)
+ (insert "......")
+ (goto-char 10)
+ (insert "........")
+ (goto-char 11)
+ (insert "...............")
+ (goto-char 22)
+ (insert ".")
+ (goto-char 62)
+ (delete-char 16)
+ (goto-char 14)
+ (delete-char 11)
+ (goto-char 47)
+ (insert "....")
+ (goto-char 33)
+ (insert ".............")
+ (goto-char 49)
+ (delete-char 13)
+ (goto-char 28)
+ (insert "..")
+ (goto-char 35)
+ (delete-char 13)
+ (goto-char 44)
+ (insert "....")
+ (goto-char 34)
+ (delete-char 14)
+ (goto-char 23)
+ (insert ".....")
+ (goto-char 25)
+ (delete-char 4)
+ (goto-char 33)
+ (insert ".....")
+ (goto-char 27)
+ (delete-char 3)
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 36 37)
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 36)
+ (insert ".......")
+ (goto-char 37)
+ (widen)
+ (narrow-to-region 35 31)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 31)
+ (delete-char 2)
+ (goto-char 31)
+ (widen)
+ (narrow-to-region 24 3)
+ (goto-char 22)
+ (delete-char 2)
+ (goto-char 22)
+ (insert ".............")
+ (goto-char 4)
+ (insert ".")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 54)
+ (4 . 54)
+ (9 . 46))))))
+
+(ert-deftest overlay-autogenerated-test-61 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 45 56 nil t nil)
+ (make-overlay 60 45 nil nil nil)
+ (make-overlay 26 8 nil t t)
+ (make-overlay 63 39 nil nil nil)
+ (make-overlay 18 11 nil t nil)
+ (make-overlay 22 64 nil nil t)
+ (make-overlay 8 41 nil nil t)
+ (make-overlay 6 51 nil t t)
+ (make-overlay 38 26 nil t t)
+ (make-overlay 7 46 nil t nil)
+ (make-overlay 2 42 nil nil t)
+ (make-overlay 44 64 nil nil nil)
+ (make-overlay 7 62 nil t nil)
+ (make-overlay 8 40 nil nil t)
+ (make-overlay 62 36 nil t t)
+ (make-overlay 61 27 nil nil nil)
+ (goto-char 21)
+ (delete-char 0)
+ (goto-char 8)
+ (insert "")
+ (goto-char 55)
+ (insert "......")
+ (goto-char 38)
+ (delete-char 25)
+ (goto-char 37)
+ (delete-char 4)
+ (goto-char 12)
+ (delete-char 4)
+ (goto-char 3)
+ (delete-char 26)
+ (goto-char 10)
+ (insert ".......")
+ (goto-char 18)
+ (delete-char 0)
+ (goto-char 16)
+ (insert ".............")
+ (goto-char 18)
+ (delete-char 3)
+ (goto-char 7)
+ (insert "...")
+ (goto-char 20)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 1)
+ (delete-char 36)
+ (goto-char 3)
+ (delete-char 1)
+ (goto-char 2)
+ (insert "......")
+ (goto-char 4)
+ (insert ".......")
+ (goto-char 2)
+ (insert "...........")
+ (goto-char 27)
+ (insert ".....")
+ (goto-char 15)
+ (insert "...............")
+ (goto-char 2)
+ (insert "......")
+ (goto-char 17)
+ (delete-char 8)
+ (goto-char 15)
+ (delete-char 7)
+ (goto-char 33)
+ (delete-char 5)
+ (goto-char 13)
+ (insert "...........")
+ (goto-char 34)
+ (insert "...............")
+ (goto-char 33)
+ (insert "")
+ (goto-char 51)
+ (insert "....")
+ (goto-char 14)
+ (delete-char 36)
+ (goto-char 16)
+ (delete-char 1)
+ (goto-char 14)
+ (delete-char 8)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 18)
+ (1 . 18))))))
+
+(ert-deftest overlay-autogenerated-test-62 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 25 36 nil t nil)
+ (make-overlay 38 6 nil t nil)
+ (make-overlay 40 63 nil nil t)
+ (make-overlay 34 23 nil nil nil)
+ (make-overlay 48 46 nil nil nil)
+ (make-overlay 43 57 nil t t)
+ (make-overlay 6 53 nil t t)
+ (make-overlay 37 27 nil t t)
+ (make-overlay 8 39 nil t nil)
+ (make-overlay 62 6 nil nil nil)
+ (make-overlay 51 6 nil t t)
+ (make-overlay 58 11 nil nil t)
+ (make-overlay 19 25 nil t nil)
+ (make-overlay 13 8 nil nil nil)
+ (make-overlay 19 8 nil nil t)
+ (make-overlay 39 5 nil t t)
+ (goto-char 51)
+ (delete-char 5)
+ (goto-char 16)
+ (delete-char 9)
+ (goto-char 18)
+ (insert "")
+ (goto-char 47)
+ (delete-char 4)
+ (goto-char 24)
+ (insert ".........")
+ (goto-char 24)
+ (insert ".....")
+ (goto-char 18)
+ (insert "...........")
+ (goto-char 5)
+ (delete-char 6)
+ (goto-char 30)
+ (insert "...........")
+ (goto-char 8)
+ (insert ".............")
+ (goto-char 78)
+ (insert "............")
+ (goto-char 67)
+ (insert "")
+ (goto-char 58)
+ (insert "")
+ (goto-char 5)
+ (insert ".")
+ (goto-char 79)
+ (widen)
+ (narrow-to-region 51 55)
+ (goto-char 51)
+ (insert "....")
+ (goto-char 58)
+ (widen)
+ (narrow-to-region 36 37)
+ (goto-char 37)
+ (insert "....")
+ (goto-char 40)
+ (insert ".......")
+ (goto-char 47)
+ (delete-char 1)
+ (goto-char 43)
+ (delete-char 4)
+ (goto-char 37)
+ (insert "........")
+ (goto-char 49)
+ (insert "............")
+ (goto-char 42)
+ (widen)
+ (narrow-to-region 75 111)
+ (goto-char 104)
+ (widen)
+ (narrow-to-region 21 95)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 64 79)
+ (goto-char 64)
+ (delete-char 0)
+ (goto-char 68)
+ (insert "........")
+ (goto-char 82)
+ (insert "")
+ (goto-char 81)
+ (insert "........")
+ (goto-char 92)
+ (delete-char 2)
+ (goto-char 87)
+ (insert ".")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((5 . 145)
+ (5 . 148)
+ (6 . 118)
+ (6 . 119)
+ (6 . 119)
+ (6 . 143)
+ (6 . 143)
+ (24 . 114)
+ (24 . 116)
+ (63 . 117))))))
+
+(ert-deftest overlay-autogenerated-test-63 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 9 49 nil t nil)
+ (make-overlay 9 16 nil nil nil)
+ (make-overlay 64 2 nil t t)
+ (make-overlay 17 31 nil nil t)
+ (make-overlay 24 51 nil nil nil)
+ (make-overlay 27 56 nil t t)
+ (make-overlay 21 4 nil nil nil)
+ (make-overlay 24 29 nil t t)
+ (make-overlay 4 63 nil nil t)
+ (make-overlay 34 49 nil t nil)
+ (make-overlay 19 47 nil nil t)
+ (make-overlay 8 50 nil t nil)
+ (make-overlay 49 61 nil t nil)
+ (make-overlay 52 10 nil t t)
+ (make-overlay 64 30 nil t nil)
+ (make-overlay 5 13 nil t nil)
+ (goto-char 27)
+ (insert "........")
+ (goto-char 42)
+ (insert "......")
+ (goto-char 48)
+ (insert "....")
+ (goto-char 55)
+ (widen)
+ (narrow-to-region 10 5)
+ (goto-char 8)
+ (insert ".............")
+ (goto-char 19)
+ (insert "......")
+ (goto-char 19)
+ (delete-char 3)
+ (goto-char 8)
+ (delete-char 3)
+ (goto-char 9)
+ (insert ".......")
+ (goto-char 29)
+ (insert "...............")
+ (goto-char 38)
+ (insert ".......")
+ (goto-char 34)
+ (insert "......")
+ (goto-char 28)
+ (delete-char 20)
+ (goto-char 22)
+ (insert "............")
+ (goto-char 21)
+ (delete-char 23)
+ (goto-char 25)
+ (delete-char 2)
+ (goto-char 19)
+ (delete-char 2)
+ (goto-char 12)
+ (delete-char 6)
+ (goto-char 12)
+ (delete-char 0)
+ (goto-char 13)
+ (delete-char 0)
+ (goto-char 12)
+ (insert "........")
+ (goto-char 23)
+ (delete-char 2)
+ (goto-char 5)
+ (insert "...............")
+ (goto-char 28)
+ (delete-char 0)
+ (goto-char 16)
+ (insert "..........")
+ (goto-char 8)
+ (delete-char 17)
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 12)
+ (insert ".")
+ (goto-char 14)
+ (delete-char 12)
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 34)
+ (insert "")
+ (goto-char 25)
+ (delete-char 8)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 98)
+ (4 . 37)
+ (4 . 97)
+ (25 . 29)
+ (25 . 32)
+ (25 . 84))))))
+
+(ert-deftest overlay-autogenerated-test-64 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 31 10 nil nil nil)
+ (make-overlay 17 58 nil nil t)
+ (make-overlay 20 21 nil t nil)
+ (make-overlay 3 47 nil t t)
+ (make-overlay 47 43 nil t t)
+ (make-overlay 54 8 nil nil t)
+ (make-overlay 51 26 nil t nil)
+ (make-overlay 60 14 nil t nil)
+ (make-overlay 38 6 nil nil t)
+ (make-overlay 41 9 nil nil nil)
+ (make-overlay 44 38 nil nil t)
+ (make-overlay 55 48 nil nil t)
+ (make-overlay 10 41 nil nil t)
+ (make-overlay 35 49 nil t nil)
+ (make-overlay 50 46 nil nil nil)
+ (make-overlay 28 28 nil t nil)
+ (goto-char 59)
+ (delete-char 3)
+ (goto-char 28)
+ (widen)
+ (narrow-to-region 13 7)
+ (goto-char 11)
+ (insert ".")
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 8)
+ (delete-char 0)
+ (goto-char 7)
+ (insert ".............")
+ (goto-char 9)
+ (insert "..........")
+ (goto-char 22)
+ (delete-char 1)
+ (goto-char 31)
+ (delete-char 2)
+ (goto-char 22)
+ (insert ".........")
+ (goto-char 33)
+ (delete-char 1)
+ (goto-char 29)
+ (widen)
+ (narrow-to-region 59 51)
+ (goto-char 52)
+ (insert ".........")
+ (goto-char 53)
+ (insert "........")
+ (goto-char 53)
+ (delete-char 4)
+ (goto-char 54)
+ (insert "........")
+ (goto-char 53)
+ (insert "....")
+ (goto-char 75)
+ (widen)
+ (goto-char 70)
+ (delete-char 2)
+ (goto-char 108)
+ (delete-char 1)
+ (goto-char 80)
+ (widen)
+ (goto-char 70)
+ (widen)
+ (narrow-to-region 49 63)
+ (goto-char 49)
+ (insert "...")
+ (goto-char 66)
+ (delete-char 0)
+ (goto-char 63)
+ (delete-char 3)
+ (goto-char 59)
+ (insert "..........")
+ (goto-char 56)
+ (delete-char 6)
+ (goto-char 60)
+ (insert ".........")
+ (goto-char 62)
+ (widen)
+ (goto-char 58)
+ (insert ".............")
+ (goto-char 105)
+ (widen)
+ (narrow-to-region 94 109)
+ (goto-char 103)
+ (insert "............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 134)
+ (6 . 125)
+ (38 . 141)
+ (39 . 118)
+ (39 . 128)
+ (39 . 128)
+ (40 . 146)
+ (43 . 145)
+ (101 . 138)
+ (103 . 103))))))
+
+) ;; End of `when nil' for autogenerated insert/delete/narrow tests.
+
(ert-deftest buffer-multibyte-overlong-sequences ()
(dolist (uni '("\xE0\x80\x80"
"\xF0\x80\x80\x80"
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 1edbd1777c..734b4a0d22 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -823,7 +823,7 @@ Return a list of results."
(should (= (comp-tests-tco-f 1 0 10) 55))))
(defun comp-tests-fw-prop-checker-1 (_)
- "Check that inside `comp-tests-fw-prop-f' `concat' and `length' are folded."
+ "Check that inside `comp-tests-fw-prop-1-f' `concat' and `length' are
folded."
(should
(cl-notany
#'identity
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 1099fd0467..a9a45d5463 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -263,7 +263,7 @@ must evaluate to a regular expression string."
(ert-deftest module--test-assertions--load-non-live-object-with-global-copy ()
"Check that -module-assertions verify that non-live objects aren't accessed.
-This differs from `module--test-assertions-load-non-live-object'
+This differs from `module--test-assertions--load-non-live-object'
in that it stows away a global reference. The module assertions
should nevertheless detect the invalid load."
:tags (if (getenv "EMACS_EMBA_CI") '(:unstable))
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index fde5af38fc..7568d941d0 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -857,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))
@@ -911,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
@@ -1350,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/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
- feature/package+vc updated (eaafc10f67 -> 2a4f37fe52), Philip Kaludercic, 2022/10/30
- feature/package+vc bb86ed20e1 08/10: Display a message after installing source packages, Philip Kaludercic, 2022/10/30
- feature/package+vc a00ec87c0b 01/10: Update handling for new elpa-packages.eld format, Philip Kaludercic, 2022/10/30
- feature/package+vc 4097781655 03/10: Ensure that package specifications are always fetched, Philip Kaludercic, 2022/10/30
- feature/package+vc a52cec7b6b 04/10: Explicitly handle :vc-backend in a package specification, Philip Kaludercic, 2022/10/30
- feature/package+vc 30f1e7c1e9 05/10: Extract last source package release from local VCS data, Philip Kaludercic, 2022/10/30
- feature/package+vc 8b49d553b6 06/10: ; Avoid a type error on malformed "elpa-packages.eld" input, Philip Kaludercic, 2022/10/30
- feature/package+vc ec3f102b8c 07/10: Prefer "Package-Version" over "Version" if available, Philip Kaludercic, 2022/10/30
- feature/package+vc 60b3eb0754 02/10: Allow specifying the VC backend used by 'package-vc-install', Philip Kaludercic, 2022/10/30
- feature/package+vc d33998ed3b 09/10: Have 'last-change' accept a line number instead of a range, Philip Kaludercic, 2022/10/30
- feature/package+vc 2a4f37fe52 10/10: Merge remote-tracking branch 'origin/master' into feature/package+vc,
Philip Kaludercic <=