procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'origin/feature/noverlay'

Browse source
This commit is contained in:
Stefan Monnier 2022-10-28 17:44:44 -04:00
commit 71589b101c
31 changed files with 13793 additions and 1429 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.clang-format
View file

@ -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

1
configure.ac
View file

@ -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

39
src/Makefile.in
View file

@ -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

60
src/alloc.c
View file

@ -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 &&

1537
src/buffer.c
View file

File diff suppressed because it is too large Load diff

114
src/buffer.h
View file

@ -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);
}
#define OVERLAY_START(OV) XOVERLAY (OV)->start
INLINE ptrdiff_t
overlay_end (struct Lisp_Overlay *ov)
{
if (! ov->buffer)
return -1;
return itree_node_end (ov->buffer->overlays, ov->interval);
}
/* Return the marker that stands for where OV ends in the buffer. */
/* Return the start of OV in its buffer, or -1 if OV is not associated
with any buffer. */
#define OVERLAY_END(OV) XOVERLAY (OV)->end
INLINE ptrdiff_t
OVERLAY_START (Lisp_Object ov)
{
return overlay_start (XOVERLAY (ov));
}
/* 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
/* Return the actual buffer position for the marker P.
We assume you know which buffer it's pointing into. */
INLINE ptrdiff_t
OVERLAY_POSITION (Lisp_Object p)
INLINE Lisp_Object
OVERLAY_PLIST (Lisp_Object ov)
{
return marker_position (p);
return XOVERLAY (ov)->plist;
}
/* Return the buffer of overlay OV. */
INLINE struct buffer *
OVERLAY_BUFFER (Lisp_Object ov)
{
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 */

67
src/editfns.c
View file

@ -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
{

1
src/eval.c
View file

@ -1716,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 ();

3
src/fileio.c
View file

@ -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 ();

15
src/fns.c
View file

@ -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.
@ -2797,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;
@ -5094,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)
@ -5108,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);
}

5
src/indent.c
View file

@ -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);

12
src/insdel.c
View file

@ -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.

4
src/intervals.c
View file

@ -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;

1421
src/itree.c Normal file
View file

File diff suppressed because it is too large Load diff

181
src/itree.h Normal file
View file

@ -0,0 +1,181 @@
/* 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,
};
void itree_node_init (struct itree_node *, bool, bool, Lisp_Object);
ptrdiff_t itree_node_begin (struct itree_tree *, struct itree_node *);
ptrdiff_t itree_node_end (struct itree_tree *, struct itree_node *);
void itree_node_set_region (struct itree_tree *, struct itree_node *,
ptrdiff_t, ptrdiff_t);
struct itree_tree *itree_create (void);
void itree_destroy (struct itree_tree *);
intmax_t itree_size (struct itree_tree *);
void itree_clear (struct itree_tree *);
void itree_insert (struct itree_tree *tree, struct itree_node *node,
ptrdiff_t begin, ptrdiff_t end);
struct itree_node *itree_remove (struct itree_tree *,
struct itree_node *);
void itree_insert_gap (struct itree_tree *, ptrdiff_t, ptrdiff_t);
void itree_delete_gap (struct itree_tree *, ptrdiff_t, ptrdiff_t);
/* Iteration functions. Almost all code should use ITREE_FOREACH
instead. */
bool itree_iterator_busy_p (void);
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);
void itree_iterator_narrow (struct itree_iterator *, ptrdiff_t,
ptrdiff_t);
void itree_iterator_finish (struct itree_iterator *);
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

4
src/keyboard.c
View file

@ -1695,8 +1695,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)))
{

9
src/lisp.h
View file

@ -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.
@ -2606,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
@ -4420,7 +4418,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);

68
src/pdumper.c
View file

@ -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);
if (buffer->overlays && buffer->overlays->root != NULL)
/* We haven't implemented the code to dump overlays. */
emacs_abort ();
else
out->overlays = NULL;
dump_field_lv_rawptr (ctx, out, buffer, &buffer->overlays_after,
Lisp_Vectorlike, WEIGHT_NORMAL);
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);

14
src/print.c
View file

@ -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);

55
src/textprop.c
View file

@ -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;
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 (XBUFFER (object)) <= pos
&& pos <= BUF_ZV (XBUFFER (object))))
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)

10
src/window.h
View file

@ -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 */

197
src/xdisp.c
View file

@ -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)
{
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 (end < charpos)
break;
/* Process overlays. */
ITREE_FOREACH (node, current_buffer->overlays, charpos - 1, charpos + 1, DESCENDING)
{
Lisp_Object overlay = node->data;
eassert (OVERLAYP (overlay));
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);
&& (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);
/* 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;
{
ITREE_FOREACH_ABORT ();
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;
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;
@ -24618,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. */
@ -35256,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);
}
@ -35284,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. */

17
src/xfaces.c
View file

@ -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;

1
test/manual/noverlay/.gitignore vendored Normal file
View file

@ -0,0 +1 @@
itree-tests

32
test/manual/noverlay/Makefile.in Normal file
View file

@ -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

11
test/manual/noverlay/check-sanitize.sh Executable file
View file

@ -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/'

52
test/manual/noverlay/emacs-compat.h Normal file
View file

@ -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

1381
test/manual/noverlay/itree-tests.c Normal file
View file

File diff suppressed because it is too large Load diff

2480
test/manual/noverlay/many-errors.py Normal file
View file

File diff suppressed because it is too large Load diff

764
test/manual/noverlay/overlay-perf.el Normal file
View file

@ -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)

6665
test/src/buffer-tests.el
View file

File diff suppressed because it is too large Load diff