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

Merge branch 'scratch/fix-locked-narrowing'

Browse source
This commit is contained in:
Gregory Heytings 2023-02-13 11:44:37 +01:00
commit b948d0d7ef
14 changed files with 340 additions and 137 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
doc/lispref/commands.texi
View file

@ -99,6 +99,12 @@ is removed from the hook.
emacs, The GNU Emacs Manual}) runs these two hooks just as a keyboard
command does.
Note that, when the buffer text includes very long lines, these two
hooks are called as if they were in a @code{with-narrowing} form
(@pxref{Narrowing}), with a
@code{long-line-optimizations-in-command-hooks} label and with the
buffer narrowed to a portion around point.
@node Defining Commands
@section Defining Commands
@cindex defining commands

10
doc/lispref/display.texi
View file

@ -3501,11 +3501,11 @@ function finishes are the ones that really matter.
For efficiency, we recommend writing these functions so that they
usually assign faces to around 400 to 600 characters at each call.
When the buffer text includes very long lines, these functions are
called with the buffer narrowed to a relatively small region around
@var{pos}, and with narrowing locked, so the functions cannot use
@code{widen} to gain access to the rest of the buffer.
@xref{Narrowing}.
Note that, when the buffer text includes very long lines, these
functions are called as if they were in a @code{with-narrowing} form
(@pxref{Narrowing}), with a
@code{long-line-optimizations-in-fontification-functions} label and
with the buffer narrowed to a portion around @var{pos}.
@end defvar
@node Basic Faces

82
doc/lispref/positions.texi
View file

@ -1037,11 +1037,13 @@ positions.
In an interactive call, @var{start} and @var{end} are set to the bounds
of the current region (point and the mark, with the smallest first).
Note that, in rare circumstances, Emacs may decide to leave, for
performance reasons, the accessible portion of the buffer unchanged
after a call to @code{narrow-to-region}. This can happen when a Lisp
program is called via low-level hooks, such as
@code{jit-lock-functions}, @code{post-command-hook}, etc.
However, when the narrowing has been set by @code{with-narrowing} with
a label argument (see below), @code{narrow-to-region} can be used only
within the limits of that narrowing. If @var{start} or @var{end} are
outside these limits, the corresponding limit set by
@code{with-narrowing} is used instead. To gain access to other
portions of the buffer, use @code{without-narrowing} with the same
label.
@end deffn
@deffn Command narrow-to-page &optional move-count
@ -1065,13 +1067,13 @@ It is equivalent to the following expression:
@example
(narrow-to-region 1 (1+ (buffer-size)))
@end example
@end deffn
Note that, in rare circumstances, Emacs may decide to leave, for
performance reasons, the accessible portion of the buffer unchanged
after a call to @code{widen}. This can happen when a Lisp program is
called via low-level hooks, such as @code{jit-lock-functions},
@code{post-command-hook}, etc.
However, when a narrowing has been set by @code{with-narrowing} with a
label argument (see below), the limits set by @code{with-narrowing}
are restored, instead of canceling the narrowing. To gain access to
other portions of the buffer, use @code{without-narrowing} with the
same label.
@end deffn
@defun buffer-narrowed-p
This function returns non-@code{nil} if the buffer is narrowed, and
@ -1086,6 +1088,9 @@ in effect. The state of narrowing is restored even in the event of an
abnormal exit via @code{throw} or error (@pxref{Nonlocal Exits}).
Therefore, this construct is a clean way to narrow a buffer temporarily.
This construct also saves and restores the narrowings that were set by
@code{with-narrowing} with a label argument (see below).
The value returned by @code{save-restriction} is that returned by the
last form in @var{body}, or @code{nil} if no body forms were given.
@ -1135,3 +1140,58 @@ This is the contents of foo@point{}
@end group
@end example
@end defspec
@defspec with-narrowing start end [:label label] body
This special form saves the current bounds of the accessible portion
of the buffer, sets the accessible portion to start at @var{start} and
end at @var{end}, evaluates the @var{body} forms, and restores the
saved bounds. In that case it is equivalent to
@example
(save-restriction
(narrow-to-region start end)
body)
@end example
When the optional @var{label} symbol argument is present however, the
narrowing is labeled. A labeled narrowing differs from a non-labeled
one in several ways:
@itemize @bullet
@item
During the evaluation of the @var{body} form, @code{narrow-to-region}
and @code{widen} can be used only within the @var{start} and @var{end}
limits.
@item
To lift the restriction introduced by @code{with-narrowing} and gain
access to other portions of the buffer, use @code{without-narrowing}
with the same @var{label} argument. (Another way to gain access to
other portions of the buffer is to use an indirect buffer
(@pxref{Indirect Buffers}).)
@item
Labeled narrowings can be nested.
@item
Labeled narrowings can only be used in Lisp programs: they are never
visible on display, and never interfere with narrowings set by the
user.
@end itemize
@end defspec
@defspec without-narrowing [:label label] body
This special form saves the current bounds of the accessible portion
of the buffer, widens the buffer, evaluates the @var{body} forms, and
restores the saved bounds. In that case it is equivalent to
@example
(save-restriction
(widen)
body)
@end example
When the optional @var{label} argument is present however, the
narrowing set by @code{with-narrowing} with the same @var{label}
argument is lifted.
@end defspec

17
etc/NEWS
View file

@ -615,8 +615,13 @@ with 'C-x x t', or try disabling all known slow minor modes with
and the major mode with 'M-x so-long-mode', or visit the file with
'M-x find-file-literally' instead of the usual 'C-x C-f'.
Note that the display optimizations in these cases may cause the
buffer to be occasionally mis-fontified.
In buffers in which these display optimizations are in effect, the
'fontification-functions', 'pre-command-hook' and 'post-command-hook'
hooks are executed on a narrowed portion of the buffer, whose size is
controlled by the options 'long-line-optimizations-region-size' and
'long-line-optimizations-bol-search-limit', as if they were in a
'with-narrowing' form. This may, in particular, cause occasional
mis-fontifications in these buffers.
The new function 'long-line-optimizations-p' returns non-nil when
these optimizations are in effect in the current buffer.
@ -3814,6 +3819,14 @@ TIMEOUT is the idle time after which to deactivate the transient map.
The default timeout value can be defined by the new variable
'set-transient-map-timeout'.
+++
** New forms 'with-narrowing' and 'without-narrowing'.
These forms can be used as enhanced alternatives to the
'save-restriction' form combined with, respectively,
'narrow-to-region' and 'widen'. They also accept an optional label
argument, with which labeled narrowings can be created and lifted.
See the "(elisp) Narrowing" node for details.
** Connection Local Variables
+++

2
lisp/emacs-lisp/bytecomp.el
View file

@ -4900,7 +4900,7 @@ binding slots have been popped."
(defun byte-compile-save-restriction (form)
(byte-compile-out 'byte-save-restriction 0)
(byte-compile-body-do-effect (cdr form))
(byte-compile-out 'byte-unbind 1))
(byte-compile-out 'byte-unbind 2))
(defun byte-compile-save-current-buffer (form)
(byte-compile-out 'byte-save-current-buffer 0)

45
lisp/subr.el
View file

@ -3946,25 +3946,46 @@ See also `locate-user-emacs-file'.")
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.
When the optional :label LABEL argument is present, in which
LABEL is a symbol, inside BODY, `narrow-to-region' and `widen'
can be used only within the START and END limits. To gain access
to other portions of the buffer, use `without-narrowing' with the
same LABEL argument.
\(fn START END [:locked TAG] BODY)"
(if (eq (car rest) :locked)
\(fn START END [:label LABEL] BODY)"
(if (eq (car rest) :label)
`(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)
(defun internal--with-narrowing (start end body &optional label)
"Helper function for `with-narrowing', which see."
(save-restriction
(progn
(narrow-to-region start end)
(if tag (narrowing-lock tag))
(funcall body))))
(narrow-to-region start end)
(if label (internal--lock-narrowing label))
(funcall body)))
(defmacro without-narrowing (&rest rest)
"Execute BODY without restrictions.
The current restrictions, if any, are restored upon return.
When the optional :label LABEL argument is present, the
restrictions set by `with-narrowing' with the same LABEL argument
are lifted.
\(fn [:label LABEL] BODY)"
(if (eq (car rest) :label)
`(internal--without-narrowing (lambda () ,@(cddr rest))
,(cadr rest))
`(internal--without-narrowing (lambda () ,@rest))))
(defun internal--without-narrowing (body &optional label)
"Helper function for `without-narrowing', which see."
(save-restriction
(if label (internal--unlock-narrowing label))
(widen)
(funcall body)))
(defun find-tag-default-bounds ()
"Determine the boundaries of the default tag, based on text at point.

47
src/buffer.c
View file

@ -5916,40 +5916,41 @@ 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, 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.
DEFVAR_INT ("long-line-optimizations-region-size",
long_line_optimizations_region_size,
doc: /* Region size for 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.
This variable has effect only in buffers in which
`long-line-optimizations-p' is non-nil. For performance reasons, in
such buffers, the `fontification-functions', `pre-command-hook' and
`post-command-hook' hooks are executed on a narrowed buffer around
point, as if they were called in a `with-narrowing' form with a label.
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'.
See also `long-line-optimizations-bol-search-limit'.
There is no reason to change that value except for debugging purposes. */);
long_line_locked_narrowing_region_size = 500000;
long_line_optimizations_region_size = 500000;
DEFVAR_INT ("long-line-locked-narrowing-bol-search-limit",
long_line_locked_narrowing_bol_search_limit,
DEFVAR_INT ("long-line-optimizations-bol-search-limit",
long_line_optimizations_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.
This variable has effect only in buffers in which
`long-line-optimizations-p' is non-nil. For performance reasons, in
such buffers, the `fontification-functions', `pre-command-hook' and
`post-command-hook' hooks are executed on a narrowed buffer around
point, as if they were called in a `with-narrowing' form with a label.
The variable `long-line-optimizations-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;
long_line_optimizations_bol_search_limit = 128;
DEFVAR_INT ("large-hscroll-threshold", large_hscroll_threshold,
doc: /* Horizontal scroll of truncated lines above which to use redisplay shortcuts.

2
src/bytecode.c
View file

@ -942,6 +942,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
CASE (Bsave_restriction):
record_unwind_protect (save_restriction_restore,
save_restriction_save ());
record_unwind_protect (narrowing_locks_restore,
narrowing_locks_save ());
NEXT;
CASE (Bcatch): /* Obsolete since 25. */

2
src/comp.c
View file

@ -5063,6 +5063,8 @@ helper_save_restriction (void)
{
record_unwind_protect (save_restriction_restore,
save_restriction_save ());
record_unwind_protect (narrowing_locks_restore,
narrowing_locks_save ());
}
static bool

98
src/editfns.c
View file

@ -2659,7 +2659,11 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region,
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. */
internal--lock-narrowing, internal--unlock-narrowing and
save-restriction. For efficiency reasons, an alist is used instead
of a buffer-local variable: otherwise reset_outermost_narrowings,
which is called during each redisplay cycle, would have to loop
through all live buffers. */
static Lisp_Object narrowing_locks;
/* Add BUF with its LOCKS in the narrowing_locks alist. */
@ -2763,7 +2767,10 @@ unwind_reset_outermost_narrowing (Lisp_Object buf)
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. */
not be visible on display.
See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=57207#140 and
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=57207#254 for example
recipes that demonstrate why this is necessary. */
void
reset_outermost_narrowings (void)
{
@ -2787,32 +2794,30 @@ reset_outermost_narrowings (void)
/* Helper functions to save and restore the narrowing locks of the
current buffer in Fsave_restriction. */
static Lisp_Object
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));
if (!NILP (locks))
locks = XCAR (XCDR (locks));
return Fcons (buf, Fcopy_sequence (locks));
}
static void
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);
if (!NILP (saved_locks))
narrowing_locks_add (buf, saved_locks);
}
static void
unwind_narrow_to_region_locked (Lisp_Object tag)
{
Fnarrowing_unlock (tag);
Finternal__unlock_narrowing (tag);
Fwiden ();
}
@ -2821,7 +2826,7 @@ void
narrow_to_region_locked (Lisp_Object begv, Lisp_Object zv, Lisp_Object tag)
{
Fnarrow_to_region (begv, zv);
Fnarrowing_lock (tag);
Finternal__lock_narrowing (tag);
record_unwind_protect (restore_point_unwind, Fpoint_marker ());
record_unwind_protect (unwind_narrow_to_region_locked, tag);
}
@ -2829,10 +2834,12 @@ narrow_to_region_locked (Lisp_Object begv, Lisp_Object zv, Lisp_Object 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, 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. */)
This allows the buffer's full text to be seen and edited.
However, when restrictions have been set by `with-narrowing' with a
label, `widen' restores the narrowing limits set by `with-narrowing'.
To gain access to other portions of the buffer, use
`without-narrowing' with the same label. */)
(void)
{
Fset (Qoutermost_narrowing, Qnil);
@ -2879,11 +2886,12 @@ When calling from Lisp, pass two arguments START and END:
positions (integers or markers) bounding the text that should
remain visible.
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. */)
However, when restrictions have been set by `with-narrowing' with a
label, `narrow-to-region' can be used only within the limits of these
restrictions. If the START or END arguments are outside these limits,
the corresponding limit set by `with-narrowing' is used instead of the
argument. To gain access to other portions of the buffer, use
`without-narrowing' with the same label. */)
(Lisp_Object start, Lisp_Object end)
{
EMACS_INT s = fix_position (start), e = fix_position (end);
@ -2912,7 +2920,7 @@ limit of the locked restriction is used instead of the argument. */)
/* 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. */
only by internal--lock-narrowing. */
Fset (Qoutermost_narrowing, list3 (Qoutermost_narrowing,
Fpoint_min_marker (),
Fpoint_max_marker ()));
@ -2932,31 +2940,18 @@ limit of the locked restriction is used instead of the argument. */)
return Qnil;
}
DEFUN ("narrowing-lock", Fnarrowing_lock, Snarrowing_lock, 1, 1, 0,
doc: /* Lock the current narrowing with TAG.
DEFUN ("internal--lock-narrowing", Finternal__lock_narrowing,
Sinternal__lock_narrowing, 1, 1, 0,
doc: /* Lock the current narrowing with LABEL.
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. */)
This is an internal function used by `with-narrowing'. */)
(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 internal--lock-narrowing is ever called without being preceded
by narrow-to-region, do nothing. */
if (NILP (outermost_narrowing))
return Qnil;
if (NILP (narrowing_lock_peek_tag (buf)))
@ -2967,16 +2962,11 @@ not be used as a stronger variant of normal restrictions. */)
return Qnil;
}
DEFUN ("narrowing-unlock", Fnarrowing_unlock, Snarrowing_unlock, 1, 1, 0,
doc: /* Unlock a narrowing locked with (narrowing-lock TAG).
DEFUN ("internal--unlock-narrowing", Finternal__unlock_narrowing,
Sinternal__unlock_narrowing, 1, 1, 0,
doc: /* Unlock a narrowing locked with LABEL.
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'. */)
This is an internal function used by `without-narrowing'. */)
(Lisp_Object tag)
{
Lisp_Object buf = Fcurrent_buffer ();
@ -3083,8 +3073,8 @@ DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0
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, as well as their locks if they have been locked with
`narrowing-lock', when it is entered, and restores them when it is exited.
restrictions, including those that were set by `with-narrowing' with a
label argument, 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).
@ -4903,8 +4893,8 @@ it to be non-nil. */);
defsubr (&Sdelete_and_extract_region);
defsubr (&Swiden);
defsubr (&Snarrow_to_region);
defsubr (&Snarrowing_lock);
defsubr (&Snarrowing_unlock);
defsubr (&Sinternal__lock_narrowing);
defsubr (&Sinternal__unlock_narrowing);
defsubr (&Ssave_restriction);
defsubr (&Stranspose_regions);
}

31
src/keyboard.c
View file

@ -1910,12 +1910,13 @@ safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct window *w)
specbind (Qinhibit_quit, Qt);
if (current_buffer->long_line_optimizations_p
&& long_line_locked_narrowing_region_size > 0)
&& long_line_optimizations_region_size > 0)
{
ptrdiff_t begv = get_locked_narrowing_begv (PT);
ptrdiff_t zv = get_locked_narrowing_zv (PT);
if (begv != BEG || zv != Z)
narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv), hook);
narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv),
Qlong_line_optimizations_in_command_hooks);
}
run_hook_with_args (2, ((Lisp_Object []) {hook, hook}),
@ -12168,6 +12169,8 @@ syms_of_keyboard (void)
/* Hooks to run before and after each command. */
DEFSYM (Qpre_command_hook, "pre-command-hook");
DEFSYM (Qpost_command_hook, "post-command-hook");
DEFSYM (Qlong_line_optimizations_in_command_hooks,
"long-line-optimizations-in-command-hooks");
/* Hook run after the region is selected. */
DEFSYM (Qpost_select_region_hook, "post-select-region-hook");
@ -12728,13 +12731,11 @@ If an unhandled error happens in running this hook, the function in
which the error occurred is unconditionally removed, since otherwise
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 (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.
Note that, when `long-line-optimizations-p' is non-nil in the buffer,
these functions are called as if they were in a `with-narrowing' form,
with a `long-line-optimizations-in-command-hooks' label and with the
buffer narrowed to a portion around point whose size is specified by
`long-line-optimizations-region-size'.
See also `post-command-hook'. */);
Vpre_command_hook = Qnil;
@ -12750,13 +12751,11 @@ It is a bad idea to use this hook for expensive processing. If
unavoidable, wrap your code in `(while-no-input (redisplay) CODE)' to
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 (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.
Note that, when `long-line-optimizations-p' is non-nil in the buffer,
these functions are called as if they were in a `with-narrowing' form,
with a `long-line-optimizations-in-command-hooks' label and with the
buffer narrowed to a portion around point whose size is specified by
`long-line-optimizations-region-size'.
See also `pre-command-hook'. */);
Vpost_command_hook = Qnil;

2
src/lisp.h
View file

@ -4684,6 +4684,8 @@ extern void save_excursion_save (union specbinding *);
extern void save_excursion_restore (Lisp_Object, Lisp_Object);
extern Lisp_Object save_restriction_save (void);
extern void save_restriction_restore (Lisp_Object);
extern Lisp_Object narrowing_locks_save (void);
extern void narrowing_locks_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);

27
src/xdisp.c
View file

@ -3536,11 +3536,11 @@ get_closer_narrowed_begv (struct window *w, ptrdiff_t pos)
ptrdiff_t
get_locked_narrowing_begv (ptrdiff_t pos)
{
if (long_line_locked_narrowing_region_size <= 0)
if (long_line_optimizations_region_size <= 0)
return BEGV;
int len = long_line_locked_narrowing_region_size / 2;
int len = long_line_optimizations_region_size / 2;
int begv = max (pos - len, BEGV);
int limit = long_line_locked_narrowing_bol_search_limit;
int limit = long_line_optimizations_bol_search_limit;
while (limit > 0)
{
if (begv == BEGV || FETCH_BYTE (CHAR_TO_BYTE (begv) - 1) == '\n')
@ -3554,9 +3554,9 @@ get_locked_narrowing_begv (ptrdiff_t pos)
ptrdiff_t
get_locked_narrowing_zv (ptrdiff_t pos)
{
if (long_line_locked_narrowing_region_size <= 0)
if (long_line_optimizations_region_size <= 0)
return ZV;
int len = long_line_locked_narrowing_region_size / 2;
int len = long_line_optimizations_region_size / 2;
return min (pos + len, ZV);
}
@ -4394,7 +4394,7 @@ handle_fontified_prop (struct it *it)
eassert (it->end_charpos == ZV);
if (current_buffer->long_line_optimizations_p
&& long_line_locked_narrowing_region_size > 0)
&& long_line_optimizations_region_size > 0)
{
ptrdiff_t begv = it->locked_narrowing_begv;
ptrdiff_t zv = it->locked_narrowing_zv;
@ -4406,7 +4406,7 @@ handle_fontified_prop (struct it *it)
}
if (begv != BEG || zv != Z)
narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv),
Qfontification_functions);
Qlong_line_optimizations_in_fontification_functions);
}
/* Don't allow Lisp that runs from 'fontification-functions'
@ -36266,6 +36266,8 @@ be let-bound around code that needs to disable messages temporarily. */);
DEFSYM (QCfile, ":file");
DEFSYM (Qfontified, "fontified");
DEFSYM (Qfontification_functions, "fontification-functions");
DEFSYM (Qlong_line_optimizations_in_fontification_functions,
"long-line-optimizations-in-fontification-functions");
/* Name of the symbol which disables Lisp evaluation in 'display'
properties. This is used by enriched.el. */
@ -36775,12 +36777,11 @@ Each function is called with one argument POS. Functions must
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 (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. */);
Note that, when `long-line-optimizations-p' is non-nil in the buffer,
these functions are called as if they were in a `with-narrowing' form,
with a `long-line-optimizations-in-fontification-functions' label and
with the buffer narrowed to a portion around POS whose size is
specified by `long-line-optimizations-region-size'. */);
Vfontification_functions = Qnil;
Fmake_variable_buffer_local (Qfontification_functions);

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

@ -8539,4 +8539,110 @@ Finally, kill the buffer and its temporary file."
(if f2 (delete-file f2))
)))
(ert-deftest test-labeled-narrowing ()
"Test `with-narrowing' and `without-narrowing'."
(with-current-buffer (generate-new-buffer " foo" t)
(insert (make-string 5000 ?a))
(should (= (point-min) 1))
(should (= (point-max) 5001))
(with-narrowing
100 500 :label 'foo
(should (= (point-min) 100))
(should (= (point-max) 500))
(widen)
(should (= (point-min) 100))
(should (= (point-max) 500))
(narrow-to-region 1 5000)
(should (= (point-min) 100))
(should (= (point-max) 500))
(narrow-to-region 50 150)
(should (= (point-min) 100))
(should (= (point-max) 150))
(widen)
(should (= (point-min) 100))
(should (= (point-max) 500))
(narrow-to-region 400 1000)
(should (= (point-min) 400))
(should (= (point-max) 500))
(without-narrowing
:label 'bar
(should (= (point-min) 100))
(should (= (point-max) 500)))
(without-narrowing
:label 'foo
(should (= (point-min) 1))
(should (= (point-max) 5001)))
(should (= (point-min) 400))
(should (= (point-max) 500))
(widen)
(should (= (point-min) 100))
(should (= (point-max) 500))
(with-narrowing
50 250 :label 'bar
(should (= (point-min) 100))
(should (= (point-max) 250))
(widen)
(should (= (point-min) 100))
(should (= (point-max) 250))
(without-narrowing
:label 'bar
(should (= (point-min) 100))
(should (= (point-max) 500))
(without-narrowing
:label 'foo
(should (= (point-min) 1))
(should (= (point-max) 5001)))
(should (= (point-min) 100))
(should (= (point-max) 500)))
(should (= (point-min) 100))
(should (= (point-max) 250)))
(should (= (point-min) 100))
(should (= (point-max) 500))
(with-narrowing
50 250 :label 'bar
(should (= (point-min) 100))
(should (= (point-max) 250))
(with-narrowing
150 500 :label 'baz
(should (= (point-min) 150))
(should (= (point-max) 250))
(without-narrowing
:label 'bar
(should (= (point-min) 150))
(should (= (point-max) 250)))
(without-narrowing
:label 'foo
(should (= (point-min) 150))
(should (= (point-max) 250)))
(without-narrowing
:label 'baz
(should (= (point-min) 100))
(should (= (point-max) 250))
(without-narrowing
:label 'foo
(should (= (point-min) 100))
(should (= (point-max) 250)))
(without-narrowing
:label 'bar
(should (= (point-min) 100))
(should (= (point-max) 500))
(without-narrowing
:label 'foobar
(should (= (point-min) 100))
(should (= (point-max) 500)))
(without-narrowing
:label 'foo
(should (= (point-min) 1))
(should (= (point-max) 5001)))
(should (= (point-min) 100))
(should (= (point-max) 500)))
(should (= (point-min) 100))
(should (= (point-max) 250)))
(should (= (point-min) 150))
(should (= (point-max) 250)))
(should (= (point-min) 100))
(should (= (point-max) 250))))
(should (= (point-min) 1))
(should (= (point-max) 5001))))
;;; buffer-tests.el ends here