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:
parent
9b38773a20
commit
b741dc7fcd
2 changed files with 23 additions and 11 deletions
|
@ -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)
|
||||
|
|
|
@ -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);
|
||||
|
|
Loading…
Add table
Reference in a new issue