From 01efdbd33664d45818f0686589d38e2bfad0ab69 Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
Date: Sun, 21 Aug 2022 19:33:46 +0000
Subject: [PATCH] Better way to protect redisplay routines from locked
 narrowings.

* src/xdisp.c (reset_outermost_narrowing,
unwind_reset_outermost_narrowing): New functions.
(redisplay_internal): Use the new functions.

* src/editfns.c (Fnarrow_to_region): Use the limits of the
locked restriction instead of the position arguments if necessary.
Update docstring.
(Fnarrowing_lock): Update docstring.
---
 src/editfns.c | 36 ++++++++++++++++++++++++------------
 src/xdisp.c   | 35 +++++++++++++++++++++++++++++++++++
 2 files changed, 59 insertions(+), 12 deletions(-)

diff --git a/src/editfns.c b/src/editfns.c
index f52db223e47..c6727832928 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2731,7 +2731,9 @@ 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.  */)
+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)
 {
   EMACS_INT s = fix_position (start), e = fix_position (end);
@@ -2741,17 +2743,15 @@ restrictions that were current when `narrowing-lock' was called.  */)
       EMACS_INT tem = s; s = e; e = tem;
     }
 
-  if (NILP (Vnarrowing_locks))
-    {
-      if (!(BEG <= s && s <= e && e <= Z))
-	args_out_of_range (start, end);
-    }
-  else
+  if (!(BEG <= s && s <= e && e <= Z))
+    args_out_of_range (start, end);
+
+  if (! NILP (Vnarrowing_locks))
     {
       ptrdiff_t begv = XFIXNUM (Fcar (Fcdr (Fcar (Vnarrowing_locks))));
       ptrdiff_t zv = XFIXNUM (Fcdr (Fcdr (Fcar (Vnarrowing_locks))));
-      if (!(begv <= s && s <= e && e <= zv))
-	args_out_of_range (start, end);
+      if (s < begv) s = begv;
+      if (e > zv) e = zv;
     }
 
   Fset (Qoutermost_narrowing,
@@ -2774,12 +2774,24 @@ restrictions that were current when `narrowing-lock' was called.  */)
   return Qnil;
 }
 
-DEFUN ("narrowing-lock", Fnarrowing_lock, Snarrowing_lock, 1, 1, "",
+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.  */)
+`narrowing-lock' was called, unless the lock is removed with
+\(narrowing-unlock TAG).
+
+Locking restrictions should be used sparingly, after carefully
+considering the potential adverse effects on the code that will be
+executed with locked restrictions.  It is 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)
 {
   if (NILP (Vnarrowing_locks))
@@ -2790,7 +2802,7 @@ used only within the limits of the restrictions that were current when
   return Qnil;
 }
 
-DEFUN ("narrowing-unlock", Fnarrowing_unlock, Snarrowing_unlock, 1, 1, "",
+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
diff --git a/src/xdisp.c b/src/xdisp.c
index 8f63b029c1f..2ee02684dc4 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -16363,6 +16363,39 @@ do { if (! polling_stopped_here) stop_polling ();	\
 do { if (polling_stopped_here) start_polling ();	\
        polling_stopped_here = false; } while (false)
 
+static void
+unwind_reset_outermost_narrowing (Lisp_Object buf)
+{
+  Lisp_Object innermost_narrowing =
+    Fcar (buffer_local_value (Qnarrowing_locks, buf));
+  if (! NILP (innermost_narrowing))
+    {
+      SET_BUF_BEGV (XBUFFER (buf),
+		    XFIXNUM (Fcar (Fcdr (innermost_narrowing))));
+      SET_BUF_ZV (XBUFFER (buf),
+		  XFIXNUM (Fcdr (Fcdr (innermost_narrowing))));
+    }
+}
+
+static void
+reset_outermost_narrowings (void)
+{
+  Lisp_Object tail, buf, outermost_narrowing;
+  FOR_EACH_LIVE_BUFFER (tail, buf)
+    {
+      outermost_narrowing =
+	Fassq (Qoutermost_narrowing,
+	       buffer_local_value (Qnarrowing_locks, buf));
+      if (!NILP (outermost_narrowing))
+	{
+	  SET_BUF_BEGV (XBUFFER (buf),
+			XFIXNUM (Fcar (Fcdr (outermost_narrowing))));
+	  SET_BUF_ZV (XBUFFER (buf),
+		      XFIXNUM (Fcdr (Fcdr (outermost_narrowing))));
+	  record_unwind_protect (unwind_reset_outermost_narrowing, buf);
+	}
+    }
+}
 
 /* Perhaps in the future avoid recentering windows if it
    is not necessary; currently that causes some problems.  */
@@ -16449,6 +16482,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;
-- 
2.39.5