Merge branch 'scratch/fix-locked-narrowing'

7 files changed, 103 insertions, 106 deletions

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