From b741dc7fcde0c601a01470655ceaeeef854ac32e Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
Date: Thu, 6 Jul 2023 17:04:53 +0000
Subject: [PATCH] Add internal function to enter a labeled restriction

* src/editfns.c (Finternal__labeled_narrow_to_region): New
function.  A specific function is necessary to avoid unnecessary
slowdowns when 'narrow-to-region'/'widen' are called in a loop.
(Fnarrow_to_region): Remove the call to Fset, which has been moved
into Finternal__labeled_narrow_to_region.
(labeled_narrow_to_region): Use the new function.
(syms_of_editfns): Add the symbol of the new function.

* lisp/subr.el (internal--with-restriction): Use the new function.
---
 lisp/subr.el  |  5 +++--
 src/editfns.c | 29 ++++++++++++++++++++---------
 2 files changed, 23 insertions(+), 11 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 85adef5b689..0b397b7bebf 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3980,8 +3980,9 @@ same LABEL argument.
 (defun internal--with-restriction (start end body &optional label)
   "Helper function for `with-restriction', which see."
   (save-restriction
-    (narrow-to-region start end)
-    (if label (internal--label-restriction label))
+    (if label
+        (internal--labeled-narrow-to-region start end label)
+      (narrow-to-region start end))
     (funcall body)))
 
 (defmacro without-restriction (&rest rest)
diff --git a/src/editfns.c b/src/editfns.c
index a1e48daf6c6..49c5c1f7b2f 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2868,8 +2868,7 @@ void
 labeled_narrow_to_region (Lisp_Object begv, Lisp_Object zv,
 			  Lisp_Object label)
 {
-  Fnarrow_to_region (begv, zv);
-  Finternal__label_restriction (label);
+  Finternal__labeled_narrow_to_region (begv, zv, label);
   record_unwind_protect (restore_point_unwind, Fpoint_marker ());
   record_unwind_protect (unwind_labeled_narrow_to_region, label);
 }
@@ -2967,13 +2966,6 @@ argument.  To gain access to other portions of the buffer, use
       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.  That
-     information is used only by internal--label-restriction.  */
-  Fset (Qoutermost_restriction, list3 (Qoutermost_restriction,
-				       Fpoint_min_marker (),
-				       Fpoint_max_marker ()));
-
   if (BEGV != s || ZV != e)
     current_buffer->clip_changed = 1;
 
@@ -3011,6 +3003,24 @@ This is an internal function used by `with-restriction'.  */)
   return Qnil;
 }
 
+DEFUN ("internal--labeled-narrow-to-region", Finternal__labeled_narrow_to_region,
+       Sinternal__labeled_narrow_to_region, 3, 3, 0,
+       doc: /* Restrict editing to START-END, and label the restriction with LABEL.
+
+This is an internal function used by `with-restriction'.  */)
+  (Lisp_Object start, Lisp_Object end, Lisp_Object label)
+{
+  /* Record the accessible range of the buffer when narrow-to-region
+     is called, that is, before applying the narrowing.  That
+     information is used only by internal--label-restriction.  */
+  Fset (Qoutermost_restriction, list3 (Qoutermost_restriction,
+				       Fpoint_min_marker (),
+				       Fpoint_max_marker ()));
+  Fnarrow_to_region (start, end);
+  Finternal__label_restriction (label);
+  return Qnil;
+}
+
 DEFUN ("internal--unlabel-restriction", Finternal__unlabel_restriction,
        Sinternal__unlabel_restriction, 1, 1, 0,
        doc: /* If the current restriction is labeled with LABEL, remove its label.
@@ -4964,6 +4974,7 @@ it to be non-nil.  */);
   defsubr (&Swiden);
   defsubr (&Snarrow_to_region);
   defsubr (&Sinternal__label_restriction);
+  defsubr (&Sinternal__labeled_narrow_to_region);
   defsubr (&Sinternal__unlabel_restriction);
   defsubr (&Ssave_restriction);
   defsubr (&Stranspose_regions);
-- 
2.39.2