Add an optional 'lock' parameter to 'narrow-to-region'

* src/editfns.c (Fnarrow_to_region): Add the parameter to the
function, and handle it. Update docstring.
(unwind_locked_begv, unwind_locked_zv): New functions.
(Fwiden): Do nothing when restrictions are locked. Update
docstring.
(syms_of_editfns): Replace the 'inhibit-widen' symbol and variable
with a 'restrictions-locked' symbol and variable. Update docstring.

* src/xdisp.c (handle_fontified_prop): Use Fnarrow_to_region with
the new parameter.
(unwind_narrowed_zv): Remove function.

* src/process.c (Finternal_default_process_filter): Add a third
argument to Fnarrow_to_region.

* src/lread.c (readevalloop): Add a third argument to
Fnarrow_to_region.

* src/bytecode.c (exec_byte_code): Add a third argument to
Fnarrow_to_region.

* etc/NEWS (like): Mention the new parameter of 'narrow-to-region'.

* doc/lispref/positions.texi (Narrowing): Document it.
This commit is contained in:
Gregory Heytings 2022-07-28 20:37:49 +00:00
parent 2bab0f2db6
commit d3c4833d13
7 changed files with 84 additions and 36 deletions

View file

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

View file

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

View file

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

View file

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

View file

@ -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. */

View file

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

View file

@ -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. */