From b741dc7fcde0c601a01470655ceaeeef854ac32e Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 6 Jul 2023 17:04:53 +0000 Subject: [PATCH 1/2] 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); From 01fb898420fe8260a1adc267993549a93b901cd8 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 6 Jul 2023 17:04:55 +0000 Subject: [PATCH 2/2] Simplify after adding internal function to enter a labeled restriction * src/editfns.c: (Finternal__labeled_narrow_to_region): Merge the code of Finternal__label_restriction into this function. (Finternal__label_restriction): Remove this function. (syms_of_editfns): Remove the 'outermost-restriction' buffer local variable, which is not used anymore, and the symbol of 'internal--label-restriction'. (Fwiden): Remove the call to reset the 'outermost-restriction' buffer local variable. --- src/editfns.c | 53 ++++++++++++++------------------------------------- 1 file changed, 14 insertions(+), 39 deletions(-) diff --git a/src/editfns.c b/src/editfns.c index 49c5c1f7b2f..211f1a03bee 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2682,11 +2682,12 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region, records the restriction bounds that were current when the first labeled restriction was entered (which may be a narrowing that was set by the user and is visible on display). This alist is used - internally by narrow-to-region, widen, internal--label-restriction, - internal--unlabel-restriction and save-restriction. For efficiency - reasons, an alist is used instead of a buffer-local variable: - otherwise reset_outermost_restrictions, which is called during each - redisplay cycle, would have to loop through all live buffers. */ + internally by narrow-to-region, internal--labeled-narrow-to-region, + widen, internal--unlabel-restriction and save-restriction. For + efficiency reasons, an alist is used instead of a buffer-local + variable: otherwise reset_outermost_restrictions, which is called + during each redisplay cycle, would have to loop through all live + buffers. */ static Lisp_Object labeled_restrictions; /* Add BUF with its list of labeled RESTRICTIONS in the @@ -2884,7 +2885,6 @@ To gain access to other portions of the buffer, use `without-restriction' with the same label. */) (void) { - Fset (Qoutermost_restriction, Qnil); Lisp_Object buf = Fcurrent_buffer (); Lisp_Object label = labeled_restrictions_peek_label (buf); @@ -2981,20 +2981,18 @@ argument. To gain access to other portions of the buffer, use return Qnil; } -DEFUN ("internal--label-restriction", Finternal__label_restriction, - Sinternal__label_restriction, 1, 1, 0, - doc: /* Label the current restriction with LABEL. +DEFUN ("internal--labeled-narrow-to-region", Finternal__labeled_narrow_to_region, + Sinternal__labeled_narrow_to_region, 3, 3, 0, + doc: /* Restrict editing in this buffer to START-END, and label the restriction with LABEL. This is an internal function used by `with-restriction'. */) - (Lisp_Object label) + (Lisp_Object start, Lisp_Object end, Lisp_Object label) { Lisp_Object buf = Fcurrent_buffer (); - Lisp_Object outermost_restriction - = buffer_local_value (Qoutermost_restriction, buf); - /* If internal--label-restriction is ever called without being - preceded by narrow-to-region, do nothing. */ - if (NILP (outermost_restriction)) - return Qnil; + Lisp_Object outermost_restriction = list3 (Qoutermost_restriction, + Fpoint_min_marker (), + Fpoint_max_marker ()); + Fnarrow_to_region (start, end); if (NILP (labeled_restrictions_peek_label (buf))) labeled_restrictions_push (buf, outermost_restriction); labeled_restrictions_push (buf, list3 (label, @@ -3003,24 +3001,6 @@ 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. @@ -4875,10 +4855,6 @@ This variable is experimental; email 32252@debbugs.gnu.org if you need it to be non-nil. */); binary_as_unsigned = false; - DEFVAR_LISP ("outermost-restriction", Voutermost_restriction, - doc: /* Outermost narrowing bounds, if any. Internal use only. */); - Voutermost_restriction = Qnil; - Fmake_variable_buffer_local (Qoutermost_restriction); DEFSYM (Qoutermost_restriction, "outermost-restriction"); Funintern (Qoutermost_restriction, Qnil); @@ -4973,7 +4949,6 @@ it to be non-nil. */); defsubr (&Sdelete_and_extract_region); defsubr (&Swiden); defsubr (&Snarrow_to_region); - defsubr (&Sinternal__label_restriction); defsubr (&Sinternal__labeled_narrow_to_region); defsubr (&Sinternal__unlabel_restriction); defsubr (&Ssave_restriction);