emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/long-lines-and-font-locking d3c4833d13: Add an optional 'lock' p


From: Gregory Heytings
Subject: feature/long-lines-and-font-locking d3c4833d13: Add an optional 'lock' parameter to 'narrow-to-region'
Date: Thu, 28 Jul 2022 16:41:50 -0400 (EDT)

branch: feature/long-lines-and-font-locking
commit d3c4833d1350e26a2ae35e00eaf2d6bef1724679
Author: Gregory Heytings <gregory@heytings.org>
Commit: Gregory Heytings <gregory@heytings.org>

    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.
---
 doc/lispref/positions.texi | 11 ++++++-
 etc/NEWS                   |  7 ++++
 src/bytecode.c             |  2 +-
 src/editfns.c              | 81 +++++++++++++++++++++++++++++++++++-----------
 src/lread.c                |  2 +-
 src/process.c              |  2 +-
 src/xdisp.c                | 15 ++-------
 7 files changed, 84 insertions(+), 36 deletions(-)

diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index ca1166caac..3a9a152f8d 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 9de106c26f..ec6f6c7168 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 d75767bb0c..241cbaf04f 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 6dec2d468c..40e65dda0c 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 0b46a2e4ee..0720774db2 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 d6d51b26e1..444265a1bc 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 6237d5a022..d91a7ac65b 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.  */



reply via email to

[Prev in Thread] Current Thread [Next in Thread]