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

Merge branch 'feature/improved-locked-narrowing'

Browse source
This commit is contained in:
Gregory Heytings 2022-11-27 22:19:41 +01:00
commit 849223fba1
7 changed files with 445 additions and 104 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
lisp/subr.el
View file

@ -3936,6 +3936,31 @@ See also `locate-user-emacs-file'.")
"Return non-nil if the current buffer is narrowed."
(/= (- (point-max) (point-min)) (buffer-size)))
(defmacro with-narrowing (start end &rest rest)
"Execute BODY with restrictions set to START and END.
The current restrictions, if any, are restored upon return.
With the optional :locked TAG argument, inside BODY,
`narrow-to-region' and `widen' can be used only within the START
and END limits, unless the restrictions are unlocked by calling
`narrowing-unlock' with TAG. See `narrowing-lock' for a more
detailed description.
\(fn START END [:locked TAG] BODY)"
(if (eq (car rest) :locked)
`(internal--with-narrowing ,start ,end (lambda () ,@(cddr rest))
,(cadr rest))
`(internal--with-narrowing ,start ,end (lambda () ,@rest))))
(defun internal--with-narrowing (start end body &optional tag)
"Helper function for `with-narrowing', which see."
(save-restriction
(progn
(narrow-to-region start end)
(if tag (narrowing-lock tag))
(funcall body))))
(defun find-tag-default-bounds ()
"Determine the boundaries of the default tag, based on text at point.
Return a cons cell with the beginning and end of the found tag.

37
src/buffer.c
View file

@ -5898,7 +5898,42 @@ this threshold.
If nil, these display shortcuts will always remain disabled.
There is no reason to change that value except for debugging purposes. */);
XSETFASTINT (Vlong_line_threshold, 10000);
XSETFASTINT (Vlong_line_threshold, 50000);
DEFVAR_INT ("long-line-locked-narrowing-region-size",
long_line_locked_narrowing_region_size,
doc: /* Region size for locked narrowing in buffers with long lines.
This variable has effect only in buffers which contain one or more
lines whose length is above `long-line-threshold', which see. For
performance reasons, in such buffers, low-level hooks such as
`fontification-functions' or `post-command-hook' are executed on a
narrowed buffer, with a narrowing locked with `narrowing-lock'. This
variable specifies the size of the narrowed region around point.
To disable that narrowing, set this variable to 0.
See also `long-line-locked-narrowing-bol-search-limit'.
There is no reason to change that value except for debugging purposes. */);
long_line_locked_narrowing_region_size = 500000;
DEFVAR_INT ("long-line-locked-narrowing-bol-search-limit",
long_line_locked_narrowing_bol_search_limit,
doc: /* Limit for beginning of line search in buffers with long lines.
This variable has effect only in buffers which contain one or more
lines whose length is above `long-line-threshold', which see. For
performance reasons, in such buffers, low-level hooks such as
`fontification-functions' or `post-command-hook' are executed on a
narrowed buffer, with a narrowing locked with `narrowing-lock'. The
variable `long-line-locked-narrowing-region-size' specifies the size
of the narrowed region around point. This variable, which should be a
small integer, specifies the number of characters by which that region
can be extended backwards to make it start at the beginning of a line.
There is no reason to change that value except for debugging purposes. */);
long_line_locked_narrowing_bol_search_limit = 128;
DEFVAR_INT ("large-hscroll-threshold", large_hscroll_threshold,
doc: /* Horizontal scroll of truncated lines above which to use redisplay shortcuts.

10
src/dispextern.h
View file

@ -2342,6 +2342,14 @@ struct it
optimize display. */
ptrdiff_t narrowed_zv;
/* Begin position of the buffer for the locked narrowing around
low-level hooks. */
ptrdiff_t locked_narrowing_begv;
/* End position of the buffer for the locked narrowing around
low-level hooks. */
ptrdiff_t locked_narrowing_zv;
/* C string to iterate over. Non-null means get characters from
this string, otherwise characters are read from current_buffer
or it->string. */
@ -3405,6 +3413,8 @@ void init_iterator (struct it *, struct window *, ptrdiff_t,
ptrdiff_t get_narrowed_begv (struct window *, ptrdiff_t);
ptrdiff_t get_narrowed_zv (struct window *, ptrdiff_t);
ptrdiff_t get_closer_narrowed_begv (struct window *, ptrdiff_t);
ptrdiff_t get_locked_narrowing_begv (ptrdiff_t);
ptrdiff_t get_locked_narrowing_zv (ptrdiff_t);
void init_iterator_to_row_start (struct it *, struct window *,
struct glyph_row *);
void start_display (struct it *, struct window *, struct text_pos);

399
src/editfns.c
View file

@ -2653,88 +2653,216 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region,
return del_range_1 (XFIXNUM (start), XFIXNUM (end), 1, 1);
}
/* Alist of buffers in which locked narrowing is used. The car of
each list element is a buffer, the cdr is a list of triplets (tag
begv-marker zv-marker). The last element of that list always uses
the (uninterned) Qoutermost_narrowing tag and records the narrowing
bounds that were set by the user and that are visible on display.
This alist is used internally by narrow-to-region, widen,
narrowing-lock, narrowing-unlock and save-restriction. */
static Lisp_Object narrowing_locks;
/* Add BUF with its LOCKS in the narrowing_locks alist. */
static void
narrowing_locks_add (Lisp_Object buf, Lisp_Object locks)
{
narrowing_locks = nconc2 (list1 (list2 (buf, locks)), narrowing_locks);
}
/* Remove BUF and its locks from the narrowing_locks alist. Do
nothing if BUF is not present in narrowing_locks. */
static void
narrowing_locks_remove (Lisp_Object buf)
{
narrowing_locks = Fdelq (Fassoc (buf, narrowing_locks, Qnil),
narrowing_locks);
}
/* Retrieve one of the BEGV/ZV bounds of a narrowing in BUF from the
narrowing_locks alist, as a pointer to a struct Lisp_Marker, or
NULL if BUF is not in narrowing_locks or is a killed buffer. When
OUTERMOST is true, the bounds that were set by the user and that
are visible on display are returned. Otherwise the innermost
locked narrowing bounds are returned. */
static struct Lisp_Marker *
narrowing_lock_get_bound (Lisp_Object buf, bool begv, bool outermost)
{
if (NILP (Fbuffer_live_p (buf)))
return NULL;
Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks);
if (NILP (buffer_locks))
return NULL;
buffer_locks = XCAR (XCDR (buffer_locks));
Lisp_Object bounds
= outermost
? XCDR (assq_no_quit (Qoutermost_narrowing, buffer_locks))
: XCDR (XCAR (buffer_locks));
eassert (! NILP (bounds));
Lisp_Object marker = begv ? XCAR (bounds) : XCAR (XCDR (bounds));
eassert (EQ (Fmarker_buffer (marker), buf));
return XMARKER (marker);
}
/* Retrieve the tag of the innermost narrowing in BUF. Return nil if
BUF is not in narrowing_locks or is a killed buffer. */
static Lisp_Object
narrowing_lock_peek_tag (Lisp_Object buf)
{
if (NILP (Fbuffer_live_p (buf)))
return Qnil;
Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks);
if (NILP (buffer_locks))
return Qnil;
Lisp_Object tag = XCAR (XCAR (XCAR (XCDR (buffer_locks))));
eassert (! NILP (tag));
return tag;
}
/* Add a LOCK for BUF in the narrowing_locks alist. */
static void
narrowing_lock_push (Lisp_Object buf, Lisp_Object lock)
{
Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks);
if (NILP (buffer_locks))
narrowing_locks_add (buf, list1 (lock));
else
XSETCDR (buffer_locks, list1 (nconc2 (list1 (lock),
XCAR (XCDR (buffer_locks)))));
}
/* Remove the innermost lock in BUF from the narrowing_locks alist.
Do nothing if BUF is not present in narrowing_locks. */
static void
narrowing_lock_pop (Lisp_Object buf)
{
Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks);
if (NILP (buffer_locks))
return;
if (EQ (narrowing_lock_peek_tag (buf), Qoutermost_narrowing))
narrowing_locks_remove (buf);
else
XSETCDR (buffer_locks, list1 (XCDR (XCAR (XCDR (buffer_locks)))));
}
static void
unwind_reset_outermost_narrowing (Lisp_Object buf)
{
struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, false);
struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, false);
if (begv != NULL && zv != NULL)
{
SET_BUF_BEGV_BOTH (XBUFFER (buf), begv->charpos, begv->bytepos);
SET_BUF_ZV_BOTH (XBUFFER (buf), zv->charpos, zv->bytepos);
}
else
narrowing_locks_remove (buf);
}
/* Restore the narrowing bounds that were set by the user, and restore
the bounds of the locked narrowing upon return.
In particular, this function is called when redisplay starts, so
that if a Lisp function executed during redisplay calls (redisplay)
while a locked narrowing is in effect, the locked narrowing will
not be visible on display. */
void
reset_outermost_narrowings (void)
{
Lisp_Object val, buf;
for (val = narrowing_locks; CONSP (val); val = XCDR (val))
{
buf = XCAR (XCAR (val));
eassert (BUFFERP (buf));
struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, true);
struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, true);
if (begv != NULL && zv != NULL)
{
SET_BUF_BEGV_BOTH (XBUFFER (buf), begv->charpos, begv->bytepos);
SET_BUF_ZV_BOTH (XBUFFER (buf), zv->charpos, zv->bytepos);
record_unwind_protect (unwind_reset_outermost_narrowing, buf);
}
else
narrowing_locks_remove (buf);
}
}
/* Helper functions to save and restore the narrowing locks of the
current buffer in Fsave_restriction. */
static Lisp_Object
narrowing_locks_save (void)
{
Lisp_Object buf = Fcurrent_buffer ();
Lisp_Object locks = assq_no_quit (buf, narrowing_locks);
if (NILP (locks))
return Qnil;
locks = XCAR (XCDR (locks));
return Fcons (buf, Fcopy_sequence (locks));
}
static void
narrowing_locks_restore (Lisp_Object buf_and_saved_locks)
{
if (NILP (buf_and_saved_locks))
return;
Lisp_Object buf = XCAR (buf_and_saved_locks);
Lisp_Object saved_locks = XCDR (buf_and_saved_locks);
narrowing_locks_remove (buf);
narrowing_locks_add (buf, saved_locks);
}
static void
unwind_narrow_to_region_locked (Lisp_Object tag)
{
Fnarrowing_unlock (tag);
Fwiden ();
}
/* Narrow current_buffer to BEGV-ZV with a narrowing locked with TAG. */
void
narrow_to_region_locked (Lisp_Object begv, Lisp_Object zv, Lisp_Object tag)
{
Fnarrow_to_region (begv, zv);
Fnarrowing_lock (tag);
record_unwind_protect (restore_point_unwind, Fpoint_marker ());
record_unwind_protect (unwind_narrow_to_region_locked, tag);
}
DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
doc: /* Remove restrictions (narrowing) from current buffer.
This allows the buffer's full text to be seen and edited.
Note that, when the current buffer contains one or more lines whose
length is above `long-line-threshold', Emacs may decide to leave, for
performance reasons, the accessible portion of the buffer unchanged
after this function is called from low-level hooks, such as
`jit-lock-functions' or `post-command-hook'. */)
This allows the buffer's full text to be seen and edited, unless
restrictions have been locked with `narrowing-lock', which see, in
which case the narrowing that was current when `narrowing-lock' was
called is restored. */)
(void)
{
if (! NILP (Vrestrictions_locked))
return Qnil;
if (BEG != BEGV || Z != ZV)
current_buffer->clip_changed = 1;
BEGV = BEG;
BEGV_BYTE = BEG_BYTE;
SET_BUF_ZV_BOTH (current_buffer, Z, Z_BYTE);
/* Changing the buffer bounds invalidates any recorded current column. */
invalidate_current_column ();
return Qnil;
}
Fset (Qoutermost_narrowing, Qnil);
Lisp_Object buf = Fcurrent_buffer ();
Lisp_Object tag = narrowing_lock_peek_tag (buf);
static void
unwind_locked_begv (Lisp_Object point_min)
{
SET_BUF_BEGV (current_buffer, XFIXNUM (point_min));
}
static void
unwind_locked_zv (Lisp_Object point_max)
{
SET_BUF_ZV (current_buffer, XFIXNUM (point_max));
}
/* Internal function for Fnarrow_to_region, meant to be used with a
third argument 'true', in which case it should be followed by "specbind
(Qrestrictions_locked, Qt)". */
Lisp_Object
narrow_to_region_internal (Lisp_Object start, Lisp_Object end, bool lock)
{
EMACS_INT s = fix_position (start), e = fix_position (end);
if (e < s)
if (NILP (tag))
{
EMACS_INT tem = s; s = e; e = tem;
}
if (lock)
{
if (!(BEGV <= s && s <= e && e <= ZV))
args_out_of_range (start, end);
if (BEGV != s || ZV != e)
if (BEG != BEGV || Z != ZV)
current_buffer->clip_changed = 1;
record_unwind_protect (restore_point_unwind, Fpoint_marker ());
record_unwind_protect (unwind_locked_begv, Fpoint_min ());
record_unwind_protect (unwind_locked_zv, Fpoint_max ());
SET_BUF_BEGV (current_buffer, s);
SET_BUF_ZV (current_buffer, e);
BEGV = BEG;
BEGV_BYTE = BEG_BYTE;
SET_BUF_ZV_BOTH (current_buffer, Z, Z_BYTE);
}
else
{
if (! NILP (Vrestrictions_locked))
return Qnil;
if (!(BEG <= s && s <= e && e <= Z))
args_out_of_range (start, end);
if (BEGV != s || ZV != e)
struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, false);
struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, false);
eassert (begv != NULL && zv != NULL);
if (begv->charpos != BEGV || zv->charpos != ZV)
current_buffer->clip_changed = 1;
SET_BUF_BEGV (current_buffer, s);
SET_BUF_ZV (current_buffer, e);
SET_BUF_BEGV_BOTH (current_buffer, begv->charpos, begv->bytepos);
SET_BUF_ZV_BOTH (current_buffer, zv->charpos, zv->bytepos);
/* If the only remaining bounds in narrowing_locks for
current_buffer are the bounds that were set by the user, no
locked narrowing is in effect in current_buffer anymore:
remove it from the narrowing_locks alist. */
if (EQ (tag, Qoutermost_narrowing))
narrowing_lock_pop (buf);
}
if (PT < s)
SET_PT (s);
if (e < PT)
SET_PT (e);
/* Changing the buffer bounds invalidates any recorded current column. */
invalidate_current_column ();
return Qnil;
@ -2751,14 +2879,110 @@ When calling from Lisp, pass two arguments START and END:
positions (integers or markers) bounding the text that should
remain visible.
Note that, when the current buffer contains one or more lines whose
length is above `long-line-threshold', Emacs may decide to leave, for
performance reasons, the accessible portion of the buffer unchanged
after this function is called from low-level hooks, such as
`jit-lock-functions' or `post-command-hook'. */)
When restrictions have been locked with `narrowing-lock', which see,
`narrow-to-region' can be used only within the limits of the
restrictions that were current when `narrowing-lock' was called. If
the START or END arguments are outside these limits, the corresponding
limit of the locked restriction is used instead of the argument. */)
(Lisp_Object start, Lisp_Object end)
{
return narrow_to_region_internal (start, end, false);
EMACS_INT s = fix_position (start), e = fix_position (end);
if (e < s)
{
EMACS_INT tem = s; s = e; e = tem;
}
if (!(BEG <= s && s <= e && e <= Z))
args_out_of_range (start, end);
Lisp_Object buf = Fcurrent_buffer ();
if (! NILP (narrowing_lock_peek_tag (buf)))
{
struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, false);
struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, false);
eassert (begv != NULL && zv != NULL);
/* Limit the start and end positions to those of the locked
narrowing. */
if (s < begv->charpos) s = begv->charpos;
if (s > zv->charpos) s = zv->charpos;
if (e < begv->charpos) e = begv->charpos;
if (e > zv->charpos) e = zv->charpos;
}
/* Record the accessible range of the buffer when narrow-to-region
is called, that is, before applying the narrowing. It is used
only by narrowing-lock. */
Fset (Qoutermost_narrowing, list3 (Qoutermost_narrowing,
Fpoint_min_marker (),
Fpoint_max_marker ()));
if (BEGV != s || ZV != e)
current_buffer->clip_changed = 1;
SET_BUF_BEGV (current_buffer, s);
SET_BUF_ZV (current_buffer, e);
if (PT < s)
SET_PT (s);
if (e < PT)
SET_PT (e);
/* Changing the buffer bounds invalidates any recorded current column. */
invalidate_current_column ();
return Qnil;
}
DEFUN ("narrowing-lock", Fnarrowing_lock, Snarrowing_lock, 1, 1, 0,
doc: /* Lock the current narrowing with TAG.
When restrictions are locked, `narrow-to-region' and `widen' can be
used only within the limits of the restrictions that were current when
`narrowing-lock' was called, unless the lock is removed by calling
`narrowing-unlock' with TAG.
Locking restrictions should be used sparingly, after carefully
considering the potential adverse effects on the code that will be
executed within locked restrictions. It is typically meant to be used
around portions of code that would become too slow, and make Emacs
unresponsive, if they were executed in a large buffer. For example,
restrictions are locked by Emacs around low-level hooks such as
`fontification-functions' or `post-command-hook'.
Locked restrictions are never visible on display, and can therefore
not be used as a stronger variant of normal restrictions. */)
(Lisp_Object tag)
{
Lisp_Object buf = Fcurrent_buffer ();
Lisp_Object outermost_narrowing
= buffer_local_value (Qoutermost_narrowing, buf);
/* If narrowing-lock is called without being preceded by
narrow-to-region, do nothing. */
if (NILP (outermost_narrowing))
return Qnil;
if (NILP (narrowing_lock_peek_tag (buf)))
narrowing_lock_push (buf, outermost_narrowing);
narrowing_lock_push (buf, list3 (tag,
Fpoint_min_marker (),
Fpoint_max_marker ()));
return Qnil;
}
DEFUN ("narrowing-unlock", Fnarrowing_unlock, Snarrowing_unlock, 1, 1, 0,
doc: /* Unlock a narrowing locked with (narrowing-lock TAG).
Unlocking restrictions locked with `narrowing-lock' should be used
sparingly, after carefully considering the reasons why restrictions
were locked. Restrictions are typically locked around portions of
code that would become too slow, and make Emacs unresponsive, if they
were executed in a large buffer. For example, restrictions are locked
by Emacs around low-level hooks such as `fontification-functions' or
`post-command-hook'. */)
(Lisp_Object tag)
{
Lisp_Object buf = Fcurrent_buffer ();
if (EQ (narrowing_lock_peek_tag (buf), tag))
narrowing_lock_pop (buf);
return Qnil;
}
Lisp_Object
@ -2858,11 +3082,12 @@ DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0
doc: /* Execute BODY, saving and restoring current buffer's restrictions.
The buffer's restrictions make parts of the beginning and end invisible.
\(They are set up with `narrow-to-region' and eliminated with `widen'.)
This special form, `save-restriction', saves the current buffer's restrictions
when it is entered, and restores them when it is exited.
This special form, `save-restriction', saves the current buffer's
restrictions, as well as their locks if they have been locked with
`narrowing-lock', when it is entered, and restores them when it is exited.
So any `narrow-to-region' within BODY lasts only until the end of the form.
The old restrictions settings are restored
even in case of abnormal exit (throw or error).
The old restrictions settings are restored even in case of abnormal exit
\(throw or error).
The value returned is the value of the last form in BODY.
@ -2877,6 +3102,7 @@ usage: (save-restriction &rest BODY) */)
specpdl_ref count = SPECPDL_INDEX ();
record_unwind_protect (save_restriction_restore, save_restriction_save ());
record_unwind_protect (narrowing_locks_restore, narrowing_locks_save ());
val = Fprogn (body);
return unbind_to (count, val);
}
@ -4518,6 +4744,8 @@ syms_of_editfns (void)
DEFSYM (Qwall, "wall");
DEFSYM (Qpropertize, "propertize");
staticpro (&narrowing_locks);
DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion,
doc: /* Non-nil means text motion commands don't notice fields. */);
Vinhibit_field_text_motion = Qnil;
@ -4577,11 +4805,12 @@ This variable is experimental; email 32252@debbugs.gnu.org if you need
it to be non-nil. */);
binary_as_unsigned = false;
DEFSYM (Qrestrictions_locked, "restrictions-locked");
DEFVAR_LISP ("restrictions-locked", Vrestrictions_locked,
doc: /* If non-nil, restrictions are currently locked. */);
Vrestrictions_locked = Qnil;
Funintern (Qrestrictions_locked, Qnil);
DEFVAR_LISP ("outermost-narrowing", Voutermost_narrowing,
doc: /* Outermost narrowing bounds, if any. Internal use only. */);
Voutermost_narrowing = Qnil;
Fmake_variable_buffer_local (Qoutermost_narrowing);
DEFSYM (Qoutermost_narrowing, "outermost-narrowing");
Funintern (Qoutermost_narrowing, Qnil);
defsubr (&Spropertize);
defsubr (&Schar_equal);
@ -4674,6 +4903,8 @@ it to be non-nil. */);
defsubr (&Sdelete_and_extract_region);
defsubr (&Swiden);
defsubr (&Snarrow_to_region);
defsubr (&Snarrowing_lock);
defsubr (&Snarrowing_unlock);
defsubr (&Ssave_restriction);
defsubr (&Stranspose_regions);
}

16
src/keyboard.c
View file

@ -1911,9 +1911,9 @@ safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct window *w)
specbind (Qinhibit_quit, Qt);
if (current_buffer->long_line_optimizations_p)
narrow_to_region_internal (make_fixnum (get_narrowed_begv (w, PT)),
make_fixnum (get_narrowed_zv (w, PT)),
true);
narrow_to_region_locked (make_fixnum (get_locked_narrowing_begv (PT)),
make_fixnum (get_locked_narrowing_zv (PT)),
hook);
run_hook_with_args (2, ((Lisp_Object []) {hook, hook}),
safe_run_hook_funcall);
@ -12727,8 +12727,9 @@ the error might happen repeatedly and make Emacs nonfunctional.
Note that, when the current buffer contains one or more lines whose
length is above `long-line-threshold', these hook functions are called
with the buffer narrowed to a small portion around point, and the
narrowing is locked (see `narrow-to-region'), so that these hook
with the buffer narrowed to a small portion around point (whose size
is specified by `long-line-locked-narrowing-region-size'), and the
narrowing is locked (see `narrowing-lock'), so that these hook
functions cannot use `widen' to gain access to other portions of
buffer text.
@ -12748,8 +12749,9 @@ avoid making Emacs unresponsive while the user types.
Note that, when the current buffer contains one or more lines whose
length is above `long-line-threshold', these hook functions are called
with the buffer narrowed to a small portion around point, and the
narrowing is locked (see `narrow-to-region'), so that these hook
with the buffer narrowed to a small portion around point (whose size
is specified by `long-line-locked-narrowing-region-size'), and the
narrowing is locked (see `narrowing-lock'), so that these hook
functions cannot use `widen' to gain access to other portions of
buffer text.

3
src/lisp.h
View file

@ -4687,7 +4687,8 @@ extern void save_restriction_restore (Lisp_Object);
extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
ptrdiff_t, bool);
extern Lisp_Object narrow_to_region_internal (Lisp_Object, Lisp_Object, bool);
extern void narrow_to_region_locked (Lisp_Object, Lisp_Object, Lisp_Object);
extern void reset_outermost_narrowings (void);
extern void init_editfns (void);
extern void syms_of_editfns (void);

59
src/xdisp.c
View file

@ -3533,6 +3533,33 @@ get_closer_narrowed_begv (struct window *w, ptrdiff_t pos)
return max ((pos / len - 1) * len, BEGV);
}
ptrdiff_t
get_locked_narrowing_begv (ptrdiff_t pos)
{
if (long_line_locked_narrowing_region_size == 0)
return BEGV;
int len = long_line_locked_narrowing_region_size / 2;
int begv = max (pos - len, BEGV);
int limit = long_line_locked_narrowing_bol_search_limit;
while (limit)
{
if (begv == BEGV || FETCH_BYTE (CHAR_TO_BYTE (begv) - 1) == '\n')
return begv;
begv--;
limit--;
}
return begv;
}
ptrdiff_t
get_locked_narrowing_zv (ptrdiff_t pos)
{
if (long_line_locked_narrowing_region_size == 0)
return ZV;
int len = long_line_locked_narrowing_region_size / 2;
return min (pos + len, ZV);
}
static void
unwind_narrowed_begv (Lisp_Object point_min)
{
@ -4368,16 +4395,16 @@ handle_fontified_prop (struct it *it)
if (current_buffer->long_line_optimizations_p)
{
ptrdiff_t begv = it->narrowed_begv;
ptrdiff_t zv = it->narrowed_zv;
ptrdiff_t begv = it->locked_narrowing_begv;
ptrdiff_t zv = it->locked_narrowing_zv;
ptrdiff_t charpos = IT_CHARPOS (*it);
if (charpos < begv || charpos > zv)
{
begv = get_narrowed_begv (it->w, charpos);
zv = get_narrowed_zv (it->w, charpos);
begv = get_locked_narrowing_begv (charpos);
zv = get_locked_narrowing_zv (charpos);
}
narrow_to_region_internal (make_fixnum (begv), make_fixnum (zv), true);
specbind (Qrestrictions_locked, Qt);
narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv),
Qfontification_functions);
}
/* Don't allow Lisp that runs from 'fontification-functions'
@ -7435,12 +7462,20 @@ reseat (struct it *it, struct text_pos pos, bool force_p)
{
it->narrowed_begv = get_narrowed_begv (it->w, window_point (it->w));
it->narrowed_zv = get_narrowed_zv (it->w, window_point (it->w));
it->locked_narrowing_begv
= get_locked_narrowing_begv (window_point (it->w));
it->locked_narrowing_zv
= get_locked_narrowing_zv (window_point (it->w));
}
else if ((pos.charpos < it->narrowed_begv || pos.charpos > it->narrowed_zv)
&& (!redisplaying_p || it->line_wrap == TRUNCATE))
{
it->narrowed_begv = get_narrowed_begv (it->w, pos.charpos);
it->narrowed_zv = get_narrowed_zv (it->w, pos.charpos);
it->locked_narrowing_begv
= get_locked_narrowing_begv (window_point (it->w));
it->locked_narrowing_zv
= get_locked_narrowing_zv (window_point (it->w));
}
}
@ -16266,7 +16301,6 @@ do { if (! polling_stopped_here) stop_polling (); \
do { if (polling_stopped_here) start_polling (); \
polling_stopped_here = false; } while (false)
/* Perhaps in the future avoid recentering windows if it
is not necessary; currently that causes some problems. */
@ -16352,6 +16386,8 @@ redisplay_internal (void)
FOR_EACH_FRAME (tail, frame)
XFRAME (frame)->already_hscrolled_p = false;
reset_outermost_narrowings ();
retry:
/* Remember the currently selected window. */
sw = w;
@ -36711,10 +36747,11 @@ fontify a region starting at POS in the current buffer, and give
fontified regions the property `fontified' with a non-nil value.
Note that, when the buffer contains one or more lines whose length is
above `long-line-threshold', these functions are called with the buffer
narrowed to a small portion around POS, and the narrowing is locked (see
`narrow-to-region'), so that these functions cannot use `widen' to gain
access to other portions of buffer text. */);
above `long-line-threshold', these functions are called with the
buffer narrowed to a small portion around POS (whose size is specified
by `long-line-locked-narrowing-region-size'), and the narrowing is
locked (see `narrowing-lock'), so that these functions cannot use
`widen' to gain access to other portions of buffer text. */);
Vfontification_functions = Qnil;
Fmake_variable_buffer_local (Qfontification_functions);