Merge branch 'scratch/fix-locked-narrowing'

14 files changed, 341 insertions, 138 deletions

diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index dc78adc4520..9723c279a45 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -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
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index c5374e1481a..f0ca7440c60 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -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
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index f3824436246..bad83e1be2d 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -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
diff --git a/etc/NEWS b/etc/NEWS
index 2d15e39036a..de4f65ebe62 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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
 
 +++
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 5df1205869c..c6cda6b588a 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -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)
diff --git a/lisp/subr.el b/lisp/subr.el
index 9e6388987df..58a8e85b61d 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -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.
-
-\(fn START END [:locked TAG] BODY)"
-  (if (eq (car rest) :locked)
+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 [: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.
diff --git a/src/buffer.c b/src/buffer.c
index 38648519ba0..755061d0dee 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -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.
diff --git a/src/bytecode.c b/src/bytecode.c
index 124348e5b35..8e214560f30 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -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.  */
diff --git a/src/comp.c b/src/comp.c
index 10cf7962ba1..0e2dfd3913b 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -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
diff --git a/src/editfns.c b/src/editfns.c
index 78d2c73ecbf..f9879662168 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -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.
-
-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'.
+DEFUN ("internal--lock-narrowing", Finternal__lock_narrowing,
+       Sinternal__lock_narrowing, 1, 1, 0,
+       doc: /* Lock the current narrowing with LABEL.
 
-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);
 }
diff --git a/src/keyboard.c b/src/keyboard.c
index 6f0f075e54e..1d0b907bd8e 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -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;
diff --git a/src/lisp.h b/src/lisp.h
index 1276285e2f2..93197d38176 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -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);
diff --git a/src/xdisp.c b/src/xdisp.c
index a19c9908616..1450b869d20 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -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);
 
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 9d4bbf3e040..0ae78c8d9d9 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -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