[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 849223fba1: Merge branch 'feature/improved-locked-narrowing'
|
From: |
Gregory Heytings |
|
Subject: |
master 849223fba1: Merge branch 'feature/improved-locked-narrowing' |
|
Date: |
Sun, 27 Nov 2022 16:20:10 -0500 (EST) |
branch: master
commit 849223fba1ef899f90a6edff05bce24b90fbb043
Merge: 89a10ffcc4 18fa159fa9
Author: Gregory Heytings <gregory@heytings.org>
Commit: Gregory Heytings <gregory@heytings.org>
Merge branch 'feature/improved-locked-narrowing'
---
lisp/subr.el | 25 ++++
src/buffer.c | 37 +++++-
src/dispextern.h | 10 ++
src/editfns.c | 373 ++++++++++++++++++++++++++++++++++++++++++++-----------
src/keyboard.c | 16 +--
src/lisp.h | 3 +-
src/xdisp.c | 59 +++++++--
7 files changed, 432 insertions(+), 91 deletions(-)
diff --git a/lisp/subr.el b/lisp/subr.el
index 4f671de918..cfce5b18c5 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -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.
diff --git a/src/buffer.c b/src/buffer.c
index ac7f4f8e9d..71be7ed9e1 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -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.
diff --git a/src/dispextern.h b/src/dispextern.h
index 2afbdeabaa..df6134e68f 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -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);
diff --git a/src/editfns.c b/src/editfns.c
index 17dca4708e..b364f441b5 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2653,88 +2653,216 @@ DEFUN ("delete-and-extract-region",
Fdelete_and_extract_region,
return del_range_1 (XFIXNUM (start), XFIXNUM (end), 1, 1);
}
-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.
+/* 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);
+}
-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'. */)
- (void)
+/* 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 (Vrestrictions_locked))
+ if (NILP (Fbuffer_live_p (buf)))
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;
+ 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
-unwind_locked_begv (Lisp_Object point_min)
+narrowing_lock_push (Lisp_Object buf, Lisp_Object lock)
{
- SET_BUF_BEGV (current_buffer, XFIXNUM (point_min));
+ 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
-unwind_locked_zv (Lisp_Object point_max)
+narrowing_lock_pop (Lisp_Object buf)
{
- SET_BUF_ZV (current_buffer, XFIXNUM (point_max));
+ 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)))));
}
-/* 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)
+static void
+unwind_reset_outermost_narrowing (Lisp_Object buf)
{
- EMACS_INT s = fix_position (start), e = fix_position (end);
-
- if (e < s)
+ 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)
{
- EMACS_INT tem = s; s = e; e = tem;
+ 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);
+}
- if (lock)
+/* 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))
{
- if (!(BEGV <= s && s <= e && e <= ZV))
- args_out_of_range (start, end);
+ 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);
+ }
+}
- if (BEGV != s || ZV != e)
- current_buffer->clip_changed = 1;
+/* 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));
+}
- record_unwind_protect (restore_point_unwind, Fpoint_marker ());
- record_unwind_protect (unwind_locked_begv, Fpoint_min ());
- record_unwind_protect (unwind_locked_zv, Fpoint_max ());
+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);
+}
- SET_BUF_BEGV (current_buffer, s);
- SET_BUF_ZV (current_buffer, e);
+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, 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)
+{
+ Fset (Qoutermost_narrowing, Qnil);
+ Lisp_Object buf = Fcurrent_buffer ();
+ Lisp_Object tag = narrowing_lock_peek_tag (buf);
+
+ if (NILP (tag))
+ {
+ 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);
}
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);
}
diff --git a/src/keyboard.c b/src/keyboard.c
index 811998823c..b82a5e1a3e 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -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.
diff --git a/src/lisp.h b/src/lisp.h
index 6a24a53817..0f70f60d75 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -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);
diff --git a/src/xdisp.c b/src/xdisp.c
index 5dcf21dc4c..0002c3d611 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -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);