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.
This commit is contained in:
Gregory Heytings 2023-07-06 17:04:53 +00:00
parent 9b38773a20
commit b741dc7fcd
2 changed files with 23 additions and 11 deletions

View file

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

View file

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