diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index ca1166caac4..3a9a152f8dd 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -995,13 +995,18 @@ the entire buffer regardless of any narrowing. types of text, consider using an alternative facility described in @ref{Swapping Text}. -@deffn Command narrow-to-region start end +@deffn Command narrow-to-region start end &optional lock This function sets the accessible portion of the current buffer to start at @var{start} and end at @var{end}. Both arguments should be character positions. In an interactive call, @var{start} and @var{end} are set to the bounds of the current region (point and the mark, with the smallest first). + +When @var{lock} is non-@code{nil}, calls to @code{widen}, or to +@code{narrow-to-region} with an optional argument @var{lock} +@code{nil}, do not produce any effect until the end of the current +body form. @end deffn @deffn Command narrow-to-page &optional move-count @@ -1027,6 +1032,10 @@ It is equivalent to the following expression: @end example @end deffn +However, when @code{widen} is called inside a body form in which +@code{narrow-to-region} was called with an optional argument +@code{lock} non-@code{nil}, it does not produce any effect. + @defun buffer-narrowed-p This function returns non-@code{nil} if the buffer is narrowed, and @code{nil} otherwise. diff --git a/etc/NEWS b/etc/NEWS index 9de106c26ff..ec6f6c7168a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2456,6 +2456,13 @@ abbrevs. This has been generalized via the 'save-some-buffers-functions', and packages can now register things to be saved. ++++ +** New argument LOCK of 'narrow-to-region'. +When 'narrow-to-region' is called from Lisp with the optional third +argument LOCK non-nil, calls to 'widen', or to 'narrow-to-region' with +an optional argument LOCK nil, do not produce any effect until the end +of the current body form. + ** Themes --- diff --git a/src/bytecode.c b/src/bytecode.c index d75767bb0c5..241cbaf04f6 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1481,7 +1481,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, CASE (Bnarrow_to_region): { Lisp_Object v1 = POP; - TOP = Fnarrow_to_region (TOP, v1); + TOP = Fnarrow_to_region (TOP, v1, Qnil); NEXT; } diff --git a/src/editfns.c b/src/editfns.c index 6dec2d468c0..40e65dda0c9 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2658,10 +2658,14 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region, DEFUN ("widen", Fwiden, Swiden, 0, 0, "", doc: /* Remove restrictions (narrowing) from current buffer. -This allows the buffer's full text to be seen and edited. */) +This allows the buffer's full text to be seen and edited. + +When called from Lisp inside a body form in which `narrow-to-region' +was called with an optional argument LOCK non-nil, this does not +produce any effect. */) (void) { - if (!NILP (Vinhibit_widen)) + if (! NILP (Vrestrictions_locked)) return Qnil; if (BEG != BEGV || Z != ZV) current_buffer->clip_changed = 1; @@ -2673,7 +2677,19 @@ This allows the buffer's full text to be seen and edited. */) return Qnil; } -DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r", +static void +unwind_locked_begv (Lisp_Object point_min) +{ + SET_BUF_BEGV (current_buffer, XFIXNUM (point_min)); +} + +static void +unwind_locked_zv (Lisp_Object point_max) +{ + SET_BUF_ZV (current_buffer, XFIXNUM (point_max)); +} + +DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 3, "r", doc: /* Restrict editing in this buffer to the current region. The rest of the text becomes temporarily invisible and untouchable but is not deleted; if you save the buffer in a file, the invisible @@ -2682,8 +2698,13 @@ See also `save-restriction'. When calling from Lisp, pass two arguments START and END: positions (integers or markers) bounding the text that should -remain visible. */) - (Lisp_Object start, Lisp_Object end) +remain visible. + +When called from Lisp with the optional argument LOCK non-nil, +calls to `widen', or to `narrow-to-region' with an optional +argument LOCK nil, do not produce any effect until the end of +the current body form. */) + (Lisp_Object start, Lisp_Object end, Lisp_Object lock) { EMACS_INT s = fix_position (start), e = fix_position (end); @@ -2692,14 +2713,37 @@ remain visible. */) EMACS_INT tem = s; s = e; e = tem; } - if (!(BEG <= s && s <= e && e <= Z)) - args_out_of_range (start, end); + if (! NILP (lock)) + { + if (!(BEGV <= s && s <= e && e <= ZV)) + args_out_of_range (start, end); - if (BEGV != s || ZV != e) - current_buffer->clip_changed = 1; + if (BEGV != s || ZV != e) + current_buffer->clip_changed = 1; + + record_unwind_protect (unwind_locked_begv, Fpoint_min ()); + record_unwind_protect (unwind_locked_zv, Fpoint_max ()); + + SET_BUF_BEGV (current_buffer, s); + SET_BUF_ZV (current_buffer, e); + + specbind (Qrestrictions_locked, Qt); + } + else + { + if (! NILP (Vrestrictions_locked)) + return Qnil; + + if (!(BEG <= s && s <= e && e <= Z)) + args_out_of_range (start, end); + + if (BEGV != s || ZV != e) + current_buffer->clip_changed = 1; + + SET_BUF_BEGV (current_buffer, s); + SET_BUF_ZV (current_buffer, e); + } - SET_BUF_BEGV (current_buffer, s); - SET_BUF_ZV (current_buffer, e); if (PT < s) SET_PT (s); if (e < PT) @@ -4459,7 +4503,6 @@ syms_of_editfns (void) DEFSYM (Qbuffer_access_fontify_functions, "buffer-access-fontify-functions"); DEFSYM (Qwall, "wall"); DEFSYM (Qpropertize, "propertize"); - DEFSYM (Qinhibit_widen, "inhibit-widen"); DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion, doc: /* Non-nil means text motion commands don't notice fields. */); @@ -4520,14 +4563,14 @@ This variable is experimental; email 32252@debbugs.gnu.org if you need it to be non-nil. */); binary_as_unsigned = false; - DEFVAR_LISP ("inhibit-widen", Vinhibit_widen, - doc: /* Non-nil inhibits the `widen' function. + DEFSYM (Qrestrictions_locked, "restrictions-locked"); + DEFVAR_LISP ("restrictions-locked", Vrestrictions_locked, + doc: /* If non-nil, restrictions are currently locked. -Do NOT set this globally to a non-nil value, as doing that will -disable the `widen' function everywhere, including the \\[widen\] -command. This variable is intended to be let-bound around code -that needs to disable `widen' temporarily. */); - Vinhibit_widen = Qnil; +This happens when `narrow-to-region', which see, is called from Lisp +with an optional argument LOCK non-nil. */); + Vrestrictions_locked = Qnil; + Funintern (Qrestrictions_locked, Qnil); defsubr (&Spropertize); defsubr (&Schar_equal); diff --git a/src/lread.c b/src/lread.c index 0b46a2e4ee5..0720774db2b 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2261,7 +2261,7 @@ readevalloop (Lisp_Object readcharfun, /* Set point and ZV around stuff to be read. */ Fgoto_char (start); if (!NILP (end)) - Fnarrow_to_region (make_fixnum (BEGV), end); + Fnarrow_to_region (make_fixnum (BEGV), end, Qnil); /* Just for cleanliness, convert END to a marker if it is an integer. */ diff --git a/src/process.c b/src/process.c index d6d51b26e11..444265a1bcb 100644 --- a/src/process.c +++ b/src/process.c @@ -6329,7 +6329,7 @@ Otherwise it discards the output. */) /* If the restriction isn't what it should be, set it. */ if (old_begv != BEGV || old_zv != ZV) - Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv)); + Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv), Qnil); bset_read_only (current_buffer, old_read_only); SET_PT_BOTH (opoint, opoint_byte); diff --git a/src/xdisp.c b/src/xdisp.c index 6237d5a0222..d91a7ac65bb 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3547,12 +3547,6 @@ unwind_narrowed_begv (Lisp_Object point_min) SET_BUF_BEGV (current_buffer, XFIXNUM (point_min)); } -static void -unwind_narrowed_zv (Lisp_Object point_max) -{ - SET_BUF_ZV (current_buffer, XFIXNUM (point_max)); -} - /* Set DST to EXPR. When IT indicates that BEGV should temporarily be updated to optimize display, evaluate EXPR with BEGV set to BV. */ @@ -4414,13 +4408,8 @@ handle_fontified_prop (struct it *it) eassert (it->end_charpos == ZV); if (it->narrowed_begv) - { - record_unwind_protect (unwind_narrowed_begv, Fpoint_min ()); - record_unwind_protect (unwind_narrowed_zv, Fpoint_max ()); - SET_BUF_BEGV (current_buffer, it->narrowed_begv); - SET_BUF_ZV (current_buffer, it->narrowed_zv); - specbind (Qinhibit_widen, Qt); - } + Fnarrow_to_region (make_fixnum (it->narrowed_begv), + make_fixnum (it->narrowed_zv), Qt); /* Don't allow Lisp that runs from 'fontification-functions' clear our face and image caches behind our back. */