From a4aa32bdfff7aaf54efbacbb04b7f2b52fef92a7 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 9 Feb 2023 01:09:10 +0000 Subject: [PATCH 1/9] Fix 'save-restriction' for narrowing locks * src/editfns.c (narrowing_locks_save): (narrowing_locks_restore): Make them non-static. * src/lisp.h: Make them externally visible. * src/bytecode.c (exec_byte_code): Save and restore narrowing locks. * lisp/emacs-lisp/bytecomp.el (byte-compile-save-restriction): Increment unbinding count. * src/comp.c (helper_save_restriction): Save and restore narrowing locks. --- lisp/emacs-lisp/bytecomp.el | 2 +- src/bytecode.c | 2 ++ src/comp.c | 2 ++ src/editfns.c | 4 ++-- src/lisp.h | 2 ++ 5 files changed, 9 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5df1205869c..c6cda6b588a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4900,7 +4900,7 @@ binding slots have been popped." (defun byte-compile-save-restriction (form) (byte-compile-out 'byte-save-restriction 0) (byte-compile-body-do-effect (cdr form)) - (byte-compile-out 'byte-unbind 1)) + (byte-compile-out 'byte-unbind 2)) (defun byte-compile-save-current-buffer (form) (byte-compile-out 'byte-save-current-buffer 0) diff --git a/src/bytecode.c b/src/bytecode.c index 124348e5b35..8e214560f30 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -942,6 +942,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, CASE (Bsave_restriction): record_unwind_protect (save_restriction_restore, save_restriction_save ()); + record_unwind_protect (narrowing_locks_restore, + narrowing_locks_save ()); NEXT; CASE (Bcatch): /* Obsolete since 25. */ diff --git a/src/comp.c b/src/comp.c index 10cf7962ba1..0e2dfd3913b 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5063,6 +5063,8 @@ helper_save_restriction (void) { record_unwind_protect (save_restriction_restore, save_restriction_save ()); + record_unwind_protect (narrowing_locks_restore, + narrowing_locks_save ()); } static bool diff --git a/src/editfns.c b/src/editfns.c index 78d2c73ecbf..21e22181b82 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2787,7 +2787,7 @@ reset_outermost_narrowings (void) /* Helper functions to save and restore the narrowing locks of the current buffer in Fsave_restriction. */ -static Lisp_Object +Lisp_Object narrowing_locks_save (void) { Lisp_Object buf = Fcurrent_buffer (); @@ -2798,7 +2798,7 @@ narrowing_locks_save (void) return Fcons (buf, Fcopy_sequence (locks)); } -static void +void narrowing_locks_restore (Lisp_Object buf_and_saved_locks) { if (NILP (buf_and_saved_locks)) diff --git a/src/lisp.h b/src/lisp.h index 1276285e2f2..93197d38176 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4684,6 +4684,8 @@ extern void save_excursion_save (union specbinding *); extern void save_excursion_restore (Lisp_Object, Lisp_Object); extern Lisp_Object save_restriction_save (void); extern void save_restriction_restore (Lisp_Object); +extern Lisp_Object narrowing_locks_save (void); +extern void narrowing_locks_restore (Lisp_Object); extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool); From 97314447e609e673be060bcdf0f244f396a70a3a Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 9 Feb 2023 01:09:10 +0000 Subject: [PATCH 2/9] Make 'narrowing-lock' and 'narrowing-unlock' internal * src/editfns.c (Finternal__lock_narrowing): Renamed from 'narrowing-lock'. (Finternal__unlock_narrowing): Renamed from 'narrowing-unlock'. (unwind_narrow_to_region_locked): (narrow_to_region_locked): (syms_of_editfns): Use the new names. * lisp/subr.el (internal--with-narrowing): Use the new name. --- lisp/subr.el | 2 +- src/editfns.c | 14 ++++++++------ 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 32c997425cf..5cc0c94ba48 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3963,7 +3963,7 @@ detailed description. (save-restriction (progn (narrow-to-region start end) - (if tag (narrowing-lock tag)) + (if tag (internal--lock-narrowing tag)) (funcall body)))) (defun find-tag-default-bounds () diff --git a/src/editfns.c b/src/editfns.c index 21e22181b82..e1c57502805 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2812,7 +2812,7 @@ narrowing_locks_restore (Lisp_Object buf_and_saved_locks) static void unwind_narrow_to_region_locked (Lisp_Object tag) { - Fnarrowing_unlock (tag); + Finternal__unlock_narrowing (tag); Fwiden (); } @@ -2821,7 +2821,7 @@ void narrow_to_region_locked (Lisp_Object begv, Lisp_Object zv, Lisp_Object tag) { Fnarrow_to_region (begv, zv); - Fnarrowing_lock (tag); + Finternal__lock_narrowing (tag); record_unwind_protect (restore_point_unwind, Fpoint_marker ()); record_unwind_protect (unwind_narrow_to_region_locked, tag); } @@ -2932,7 +2932,8 @@ limit of the locked restriction is used instead of the argument. */) return Qnil; } -DEFUN ("narrowing-lock", Fnarrowing_lock, Snarrowing_lock, 1, 1, 0, +DEFUN ("internal--lock-narrowing", Finternal__lock_narrowing, + Sinternal__lock_narrowing, 1, 1, 0, doc: /* Lock the current narrowing with TAG. When restrictions are locked, `narrow-to-region' and `widen' can be @@ -2967,7 +2968,8 @@ not be used as a stronger variant of normal restrictions. */) return Qnil; } -DEFUN ("narrowing-unlock", Fnarrowing_unlock, Snarrowing_unlock, 1, 1, 0, +DEFUN ("internal--unlock-narrowing", Finternal__unlock_narrowing, + Sinternal__unlock_narrowing, 1, 1, 0, doc: /* Unlock a narrowing locked with (narrowing-lock TAG). Unlocking restrictions locked with `narrowing-lock' should be used @@ -4903,8 +4905,8 @@ it to be non-nil. */); defsubr (&Sdelete_and_extract_region); defsubr (&Swiden); defsubr (&Snarrow_to_region); - defsubr (&Snarrowing_lock); - defsubr (&Snarrowing_unlock); + defsubr (&Sinternal__lock_narrowing); + defsubr (&Sinternal__unlock_narrowing); defsubr (&Ssave_restriction); defsubr (&Stranspose_regions); } From d8438e2bb44f448d1a0653321a8f262a1b6a3f2b Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 9 Feb 2023 01:09:10 +0000 Subject: [PATCH 3/9] Add 'without-narrowing' macro * lisp/subr.el (without-narrowing): New macro, companion (and almost identical) to 'with-narrowing'. --- lisp/subr.el | 27 +++++++++++++++++++++++---- 1 file changed, 23 insertions(+), 4 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 5cc0c94ba48..af3f1f1abd5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3952,18 +3952,37 @@ and END limits, unless the restrictions are unlocked by calling `narrowing-unlock' with TAG. See `narrowing-lock' for a more detailed description. -\(fn START END [:locked TAG] BODY)" - (if (eq (car rest) :locked) +\(fn START END [:label LABEL] BODY)" + (if (eq (car rest) :label) `(internal--with-narrowing ,start ,end (lambda () ,@(cddr rest)) ,(cadr rest)) `(internal--with-narrowing ,start ,end (lambda () ,@rest)))) -(defun internal--with-narrowing (start end body &optional tag) +(defun internal--with-narrowing (start end body &optional label) "Helper function for `with-narrowing', which see." (save-restriction (progn (narrow-to-region start end) - (if tag (internal--lock-narrowing tag)) + (if label (internal--lock-narrowing label)) + (funcall body)))) + +(defmacro without-narrowing (&rest rest) + "Execute BODY without restrictions. + +The current restrictions, if any, are restored upon return. + +\(fn [:label LABEL] BODY)" + (if (eq (car rest) :label) + `(internal--without-narrowing (lambda () ,@(cddr rest)) + ,(cadr rest)) + `(internal--without-narrowing (lambda () ,@rest)))) + +(defun internal--without-narrowing (body &optional label) + "Helper function for `without-narrowing', which see." + (save-restriction + (progn + (if label (internal--unlock-narrowing label)) + (widen) (funcall body)))) (defun find-tag-default-bounds () From 0d73e4aa261d1d751a7469a6274b2e1b9fa210e6 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 9 Feb 2023 01:09:10 +0000 Subject: [PATCH 4/9] Add specific symbols for narrowings * src/xdisp.c (syms_of_xdisp): Define symbol. (handle_fontified_prop): Use it. * src/keyboard.c (syms_of_keyboard): Define symbol. (safe_run_hooks_maybe_narrowed): Use it. --- src/keyboard.c | 5 ++++- src/xdisp.c | 4 +++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index 6f0f075e54e..243767aff53 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1915,7 +1915,8 @@ safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct window *w) ptrdiff_t begv = get_locked_narrowing_begv (PT); ptrdiff_t zv = get_locked_narrowing_zv (PT); if (begv != BEG || zv != Z) - narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv), hook); + narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv), + Qlong_line_optimizations_in_command_hooks); } run_hook_with_args (2, ((Lisp_Object []) {hook, hook}), @@ -12168,6 +12169,8 @@ syms_of_keyboard (void) /* Hooks to run before and after each command. */ DEFSYM (Qpre_command_hook, "pre-command-hook"); DEFSYM (Qpost_command_hook, "post-command-hook"); + DEFSYM (Qlong_line_optimizations_in_command_hooks, + "long-line-optimizations-in-command-hooks"); /* Hook run after the region is selected. */ DEFSYM (Qpost_select_region_hook, "post-select-region-hook"); diff --git a/src/xdisp.c b/src/xdisp.c index a19c9908616..f777d2899b4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4406,7 +4406,7 @@ handle_fontified_prop (struct it *it) } if (begv != BEG || zv != Z) narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv), - Qfontification_functions); + Qlong_line_optimizations_in_fontification_functions); } /* Don't allow Lisp that runs from 'fontification-functions' @@ -36266,6 +36266,8 @@ be let-bound around code that needs to disable messages temporarily. */); DEFSYM (QCfile, ":file"); DEFSYM (Qfontified, "fontified"); DEFSYM (Qfontification_functions, "fontification-functions"); + DEFSYM (Qlong_line_optimizations_in_fontification_functions, + "long-line-optimizations-in-fontification-functions"); /* Name of the symbol which disables Lisp evaluation in 'display' properties. This is used by enriched.el. */ From a6cd4553d48aff1d241d54d62dc1b39b3ff541e0 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 9 Feb 2023 01:09:10 +0000 Subject: [PATCH 5/9] Rename two long line optimizations variables * src/buffer.c (syms_of_buffer): Rename two variables. * src/xdisp.c (get_locked_narrowing_begv): (get_locked_narrowing_zv): (handle_fontified_prop): Use the new names. * src/keyboard.c (safe_run_hooks_maybe_narrowed): Use the new names. --- src/buffer.c | 12 ++++++------ src/keyboard.c | 2 +- src/xdisp.c | 12 ++++++------ 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/buffer.c b/src/buffer.c index 38648519ba0..07723a7c6ff 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5916,8 +5916,8 @@ If nil, these display shortcuts will always remain disabled. There is no reason to change that value except for debugging purposes. */); XSETFASTINT (Vlong_line_threshold, 50000); - DEFVAR_INT ("long-line-locked-narrowing-region-size", - long_line_locked_narrowing_region_size, + DEFVAR_INT ("long-line-optimizations-region-size", + long_line_optimizations_region_size, doc: /* Region size for locked narrowing in buffers with long lines. This variable has effect only in buffers which contain one or more @@ -5932,10 +5932,10 @@ To disable that narrowing, set this variable to 0. See also `long-line-locked-narrowing-bol-search-limit'. There is no reason to change that value except for debugging purposes. */); - long_line_locked_narrowing_region_size = 500000; + long_line_optimizations_region_size = 500000; - DEFVAR_INT ("long-line-locked-narrowing-bol-search-limit", - long_line_locked_narrowing_bol_search_limit, + DEFVAR_INT ("long-line-optimizations-bol-search-limit", + long_line_optimizations_bol_search_limit, doc: /* Limit for beginning of line search in buffers with long lines. This variable has effect only in buffers which contain one or more @@ -5949,7 +5949,7 @@ small integer, specifies the number of characters by which that region can be extended backwards to make it start at the beginning of a line. There is no reason to change that value except for debugging purposes. */); - long_line_locked_narrowing_bol_search_limit = 128; + long_line_optimizations_bol_search_limit = 128; DEFVAR_INT ("large-hscroll-threshold", large_hscroll_threshold, doc: /* Horizontal scroll of truncated lines above which to use redisplay shortcuts. diff --git a/src/keyboard.c b/src/keyboard.c index 243767aff53..4417aa97d28 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1910,7 +1910,7 @@ safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct window *w) specbind (Qinhibit_quit, Qt); if (current_buffer->long_line_optimizations_p - && long_line_locked_narrowing_region_size > 0) + && long_line_optimizations_region_size > 0) { ptrdiff_t begv = get_locked_narrowing_begv (PT); ptrdiff_t zv = get_locked_narrowing_zv (PT); diff --git a/src/xdisp.c b/src/xdisp.c index f777d2899b4..8034b20d5f8 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3536,11 +3536,11 @@ get_closer_narrowed_begv (struct window *w, ptrdiff_t pos) ptrdiff_t get_locked_narrowing_begv (ptrdiff_t pos) { - if (long_line_locked_narrowing_region_size <= 0) + if (long_line_optimizations_region_size <= 0) return BEGV; - int len = long_line_locked_narrowing_region_size / 2; + int len = long_line_optimizations_region_size / 2; int begv = max (pos - len, BEGV); - int limit = long_line_locked_narrowing_bol_search_limit; + int limit = long_line_optimizations_bol_search_limit; while (limit > 0) { if (begv == BEGV || FETCH_BYTE (CHAR_TO_BYTE (begv) - 1) == '\n') @@ -3554,9 +3554,9 @@ get_locked_narrowing_begv (ptrdiff_t pos) ptrdiff_t get_locked_narrowing_zv (ptrdiff_t pos) { - if (long_line_locked_narrowing_region_size <= 0) + if (long_line_optimizations_region_size <= 0) return ZV; - int len = long_line_locked_narrowing_region_size / 2; + int len = long_line_optimizations_region_size / 2; return min (pos + len, ZV); } @@ -4394,7 +4394,7 @@ handle_fontified_prop (struct it *it) eassert (it->end_charpos == ZV); if (current_buffer->long_line_optimizations_p - && long_line_locked_narrowing_region_size > 0) + && long_line_optimizations_region_size > 0) { ptrdiff_t begv = it->locked_narrowing_begv; ptrdiff_t zv = it->locked_narrowing_zv; From 79ce185ad1373845781646812638d4872b8aee69 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 9 Feb 2023 01:09:10 +0000 Subject: [PATCH 6/9] Update the documentation about labeled (locked) narrowing * src/xdisp.c (syms_of_xdisp) : Update docstring. * src/keyboard.c (syms_of_keyboard) : (syms_of_keyboard) : Update docstring. * src/editfns.c: (narrowing_locks): Explain why an alist is used instead of a buffer-local variable. (reset_outermost_narrowings): Point to recipes that demonstrate why it is necessary to restore the user narrowing bounds when redisplay starts. (Fwiden): Update docstring. (Fnarrow_to_region): Update docstring. (Finternal__lock_narrowing): Update docstring. (Finternal__unlock_narrowing): Update docstring. (Fsave_restriction): Update docstring. * src/buffer.c (syms_of_buffer) : Update docstring. (syms_of_buffer) : Update docstring. * lisp/subr.el (with-narrowing): Update docstring. (without-narrowing): Update docstring. * etc/NEWS: Mention the 'long-line-optimizations-region-size' and 'long-line-optimizations-bol-search-limit' options. Announce the 'with-narrowing' and 'without-narrowing' forms. * doc/lispref/positions.texi (Narrowing): Update the documentation of 'narrow-to-region', 'widen' and 'save-restriction'. Document the 'with-narrowing' and 'without-narrowing' special forms. * doc/lispref/display.texi (Auto Faces): Update the documentation. * doc/lispref/commands.texi (Command Overview): Document the fact that the buffer is narrowed around 'pre-command-hook' and 'post-command-hook' when the buffer text includes very long lines. --- doc/lispref/commands.texi | 6 +++ doc/lispref/display.texi | 10 ++--- doc/lispref/positions.texi | 82 +++++++++++++++++++++++++++++++++----- etc/NEWS | 16 +++++++- lisp/subr.el | 14 ++++--- src/buffer.c | 35 ++++++++-------- src/editfns.c | 70 ++++++++++++++------------------ src/keyboard.c | 24 +++++------ src/xdisp.c | 11 +++-- 9 files changed, 168 insertions(+), 100 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index dc78adc4520..be34027d21d 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -99,6 +99,12 @@ is removed from the hook. emacs, The GNU Emacs Manual}) runs these two hooks just as a keyboard command does. + Note that, when the buffer text includes very long lines, these two +hooks are called as if they were in a @code{with-narrowing} form (see +@ref{Narrowing}), with a +@code{long-line-optimizations-in-command-hooks} label and with the +buffer narrowed to a portion around point. + @node Defining Commands @section Defining Commands @cindex defining commands diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index c5374e1481a..1b7ef006634 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -3501,11 +3501,11 @@ function finishes are the ones that really matter. For efficiency, we recommend writing these functions so that they usually assign faces to around 400 to 600 characters at each call. -When the buffer text includes very long lines, these functions are -called with the buffer narrowed to a relatively small region around -@var{pos}, and with narrowing locked, so the functions cannot use -@code{widen} to gain access to the rest of the buffer. -@xref{Narrowing}. +Note that, when the buffer text includes very long lines, these +functions are called as if they were in a @code{with-narrowing} form +(see @ref{Narrowing}), with a +@code{long-line-optimizations-in-fontification-functions} label and +with the buffer narrowed to a portion around @var{pos}. @end defvar @node Basic Faces diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index f3824436246..e7d5c610d67 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -1037,11 +1037,13 @@ 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). -Note that, in rare circumstances, Emacs may decide to leave, for -performance reasons, the accessible portion of the buffer unchanged -after a call to @code{narrow-to-region}. This can happen when a Lisp -program is called via low-level hooks, such as -@code{jit-lock-functions}, @code{post-command-hook}, etc. +However, when the narrowing has been set by @code{with-narrowing} with +a label argument (see below), @code{narrow-to-region} can be used only +within the limits of that narrowing. If @var{start} or @var{end} are +outside these limits, the corresponding limit set by +@code{with-narrowing} is used instead. To gain access to other +portions of the buffer, use @code{without-narrowing} with the same +label. @end deffn @deffn Command narrow-to-page &optional move-count @@ -1065,13 +1067,13 @@ It is equivalent to the following expression: @example (narrow-to-region 1 (1+ (buffer-size))) @end example -@end deffn -Note that, in rare circumstances, Emacs may decide to leave, for -performance reasons, the accessible portion of the buffer unchanged -after a call to @code{widen}. This can happen when a Lisp program is -called via low-level hooks, such as @code{jit-lock-functions}, -@code{post-command-hook}, etc. +However, when a narrowing has been set by @code{with-narrowing} with a +label argument (see below), the limits set by @code{with-narrowing} +are restored, instead of canceling the narrowing. To gain access to +other portions of the buffer, use @code{without-narrowing} with the +same label. +@end deffn @defun buffer-narrowed-p This function returns non-@code{nil} if the buffer is narrowed, and @@ -1086,6 +1088,9 @@ in effect. The state of narrowing is restored even in the event of an abnormal exit via @code{throw} or error (@pxref{Nonlocal Exits}). Therefore, this construct is a clean way to narrow a buffer temporarily. +This construct also saves and restores the narrowings that were set by +@code{with-narrowing} with a label argument (see below). + The value returned by @code{save-restriction} is that returned by the last form in @var{body}, or @code{nil} if no body forms were given. @@ -1135,3 +1140,58 @@ This is the contents of foo@point{} @end group @end example @end defspec + +@defspec with-narrowing start end [:label label] body +This special form saves the current bounds of the accessible portion +of the buffer, sets the accessible portion to start at @var{start} and +end at @var{end}, evaluates the @var{body} forms, and restores the +saved bounds. In that case it is equivalent to + +@example +(save-restriction + (narrow-to-region start end) + body) +@end example + +When the optional @var{label} symbol argument is present however, the +narrowing is labeled. A labeled narrowing differs from a non-labeled +one in several ways: + +@itemize @bullet +@item +During the evaluation of the @var{body} form, @code{narrow-to-region} +and @code{widen} can be used only within the @var{start} and @var{end} +limits. + +@item +To lift the restriction introduced by @code{with-narrowing} and gain +access to other portions of the buffer, use @code{without-narrowing} +with the same @var{label} argument. (Another way to gain access to +other portions of the buffer is to use an indirect buffer +(@pxref{Indirect Buffers}).) + +@item +Labeled narrowings can be nested. + +@item +Labeled narrowings can only be used in Lisp programs: they are never +visible on display, and never interfere with narrowings set by the +user. +@end itemize +@end defspec + +@defspec without-narrowing [:label label] body +This special form saves the current bounds of the accessible portion +of the buffer, widens the buffer, evaluates the @var{body} forms, and +restores the saved bounds. In that case it is equivalent to + +@example +(save-restriction + (widen) + body) +@end example + +When the optional @var{label} argument is present however, the +narrowing set by @code{with-narrowing} with the same @var{label} +argument are lifted. +@end defspec diff --git a/etc/NEWS b/etc/NEWS index 2d15e39036a..01e7f2cfb09 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -615,8 +615,12 @@ with 'C-x x t', or try disabling all known slow minor modes with and the major mode with 'M-x so-long-mode', or visit the file with 'M-x find-file-literally' instead of the usual 'C-x C-f'. -Note that the display optimizations in these cases may cause the -buffer to be occasionally mis-fontified. +In buffers in which these display optimizations are in effect, the +'fontification-functions', 'pre-command-hook' and 'post-command-hook' +hooks are executed on a narrowed portion of the buffer, whose size is +controlled by the options 'long-line-optimizations-region-size' and +'long-line-optimizations-bol-search-limit'. This may, in particular, +cause occasional mis-fontifications in these buffers. The new function 'long-line-optimizations-p' returns non-nil when these optimizations are in effect in the current buffer. @@ -3814,6 +3818,14 @@ TIMEOUT is the idle time after which to deactivate the transient map. The default timeout value can be defined by the new variable 'set-transient-map-timeout'. ++++ +** New forms 'with-narrowing' and 'without-narrowing'. +These forms can be used as enhanced alternatives to the +'save-restriction' form combined with, respectively, +'narrow-to-region' and 'widen'. They also accept an optional label +argument, with which labeled narrowings can be created and lifted. +See the "(elisp) Narrowing" node for details. + ** Connection Local Variables +++ diff --git a/lisp/subr.el b/lisp/subr.el index af3f1f1abd5..7ed0cb02a70 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3946,11 +3946,11 @@ See also `locate-user-emacs-file'.") The current restrictions, if any, are restored upon return. -With the optional :locked TAG argument, inside BODY, -`narrow-to-region' and `widen' can be used only within the START -and END limits, unless the restrictions are unlocked by calling -`narrowing-unlock' with TAG. See `narrowing-lock' for a more -detailed description. +When the optional :label LABEL argument is present, in which +LABEL is a symbol, inside BODY, `narrow-to-region' and `widen' +can be used only within the START and END limits. To gain access +to other portions of the buffer, use `without-narrowing' with the +same LABEL argument. \(fn START END [:label LABEL] BODY)" (if (eq (car rest) :label) @@ -3971,6 +3971,10 @@ detailed description. The current restrictions, if any, are restored upon return. +When the optional :label LABEL argument is present, the +restrictions set by `with-narrowing' with the same LABEL argument +are lifted. + \(fn [:label LABEL] BODY)" (if (eq (car rest) :label) `(internal--without-narrowing (lambda () ,@(cddr rest)) diff --git a/src/buffer.c b/src/buffer.c index 07723a7c6ff..755061d0dee 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5918,18 +5918,18 @@ There is no reason to change that value except for debugging purposes. */); DEFVAR_INT ("long-line-optimizations-region-size", long_line_optimizations_region_size, - doc: /* Region size for locked narrowing in buffers with long lines. + doc: /* Region size for narrowing in buffers with long lines. -This variable has effect only in buffers which contain one or more -lines whose length is above `long-line-threshold', which see. For -performance reasons, in such buffers, low-level hooks such as -`fontification-functions' or `post-command-hook' are executed on a -narrowed buffer, with a narrowing locked with `narrowing-lock'. This -variable specifies the size of the narrowed region around point. +This variable has effect only in buffers in which +`long-line-optimizations-p' is non-nil. For performance reasons, in +such buffers, the `fontification-functions', `pre-command-hook' and +`post-command-hook' hooks are executed on a narrowed buffer around +point, as if they were called in a `with-narrowing' form with a label. +This variable specifies the size of the narrowed region around point. To disable that narrowing, set this variable to 0. -See also `long-line-locked-narrowing-bol-search-limit'. +See also `long-line-optimizations-bol-search-limit'. There is no reason to change that value except for debugging purposes. */); long_line_optimizations_region_size = 500000; @@ -5938,15 +5938,16 @@ There is no reason to change that value except for debugging purposes. */); long_line_optimizations_bol_search_limit, doc: /* Limit for beginning of line search in buffers with long lines. -This variable has effect only in buffers which contain one or more -lines whose length is above `long-line-threshold', which see. For -performance reasons, in such buffers, low-level hooks such as -`fontification-functions' or `post-command-hook' are executed on a -narrowed buffer, with a narrowing locked with `narrowing-lock'. The -variable `long-line-locked-narrowing-region-size' specifies the size -of the narrowed region around point. This variable, which should be a -small integer, specifies the number of characters by which that region -can be extended backwards to make it start at the beginning of a line. +This variable has effect only in buffers in which +`long-line-optimizations-p' is non-nil. For performance reasons, in +such buffers, the `fontification-functions', `pre-command-hook' and +`post-command-hook' hooks are executed on a narrowed buffer around +point, as if they were called in a `with-narrowing' form with a label. +The variable `long-line-optimizations-region-size' specifies the +size of the narrowed region around point. This variable, which should +be a small integer, specifies the number of characters by which that +region can be extended backwards to make it start at the beginning of +a line. There is no reason to change that value except for debugging purposes. */); long_line_optimizations_bol_search_limit = 128; diff --git a/src/editfns.c b/src/editfns.c index e1c57502805..64906671be7 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2659,7 +2659,11 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region, the (uninterned) Qoutermost_narrowing tag and records the narrowing bounds that were set by the user and that are visible on display. This alist is used internally by narrow-to-region, widen, - narrowing-lock, narrowing-unlock and save-restriction. */ + internal--lock-narrowing, internal--unlock-narrowing and + save-restriction. For efficiency reasons, an alist is used instead + of a buffer-local variable: otherwise reset_outermost_narrowings, + which is called during each redisplay cycle, would have to loop + through all live buffers. */ static Lisp_Object narrowing_locks; /* Add BUF with its LOCKS in the narrowing_locks alist. */ @@ -2763,7 +2767,10 @@ unwind_reset_outermost_narrowing (Lisp_Object buf) In particular, this function is called when redisplay starts, so that if a Lisp function executed during redisplay calls (redisplay) while a locked narrowing is in effect, the locked narrowing will - not be visible on display. */ + not be visible on display. + See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=57207#140 and + https://debbugs.gnu.org/cgi/bugreport.cgi?bug=57207#254 for example + recipes that demonstrate why this is necessary. */ void reset_outermost_narrowings (void) { @@ -2829,10 +2836,12 @@ narrow_to_region_locked (Lisp_Object begv, Lisp_Object zv, Lisp_Object tag) 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, unless -restrictions have been locked with `narrowing-lock', which see, in -which case the narrowing that was current when `narrowing-lock' was -called is restored. */) +This allows the buffer's full text to be seen and edited. + +However, when restrictions have been set by `with-narrowing' with a +label, `widen' restores the narrowing limits set by `with-narrowing'. +To gain access to other portions of the buffer, use +`without-narrowing' with the same label. */) (void) { Fset (Qoutermost_narrowing, Qnil); @@ -2879,11 +2888,12 @@ When calling from Lisp, pass two arguments START and END: positions (integers or markers) bounding the text that should remain visible. -When restrictions have been locked with `narrowing-lock', which see, -`narrow-to-region' can be used only within the limits of the -restrictions that were current when `narrowing-lock' was called. If -the START or END arguments are outside these limits, the corresponding -limit of the locked restriction is used instead of the argument. */) +However, when restrictions have been set by `with-narrowing' with a +label, `narrow-to-region' can be used only within the limits of these +restrictions. If the START or END arguments are outside these limits, +the corresponding limit set by `with-narrowing' is used instead of the +argument. To gain access to other portions of the buffer, use +`without-narrowing' with the same label. */) (Lisp_Object start, Lisp_Object end) { EMACS_INT s = fix_position (start), e = fix_position (end); @@ -2912,7 +2922,7 @@ limit of the locked restriction is used instead of the argument. */) /* Record the accessible range of the buffer when narrow-to-region is called, that is, before applying the narrowing. It is used - only by narrowing-lock. */ + only by internal--lock-narrowing. */ Fset (Qoutermost_narrowing, list3 (Qoutermost_narrowing, Fpoint_min_marker (), Fpoint_max_marker ())); @@ -2934,30 +2944,16 @@ limit of the locked restriction is used instead of the argument. */) DEFUN ("internal--lock-narrowing", Finternal__lock_narrowing, Sinternal__lock_narrowing, 1, 1, 0, - doc: /* Lock the current narrowing with TAG. + doc: /* Lock the current narrowing with LABEL. -When restrictions are locked, `narrow-to-region' and `widen' can be -used only within the limits of the restrictions that were current when -`narrowing-lock' was called, unless the lock is removed by calling -`narrowing-unlock' with TAG. - -Locking restrictions should be used sparingly, after carefully -considering the potential adverse effects on the code that will be -executed within locked restrictions. It is typically meant to be used -around portions of code that would become too slow, and make Emacs -unresponsive, if they were executed in a large buffer. For example, -restrictions are locked by Emacs around low-level hooks such as -`fontification-functions' or `post-command-hook'. - -Locked restrictions are never visible on display, and can therefore -not be used as a stronger variant of normal restrictions. */) +This is an internal function used by `with-narrowing'. */) (Lisp_Object tag) { Lisp_Object buf = Fcurrent_buffer (); Lisp_Object outermost_narrowing = buffer_local_value (Qoutermost_narrowing, buf); - /* If narrowing-lock is called without being preceded by - narrow-to-region, do nothing. */ + /* If internal--lock-narrowing is ever called without being preceded + by narrow-to-region, do nothing. */ if (NILP (outermost_narrowing)) return Qnil; if (NILP (narrowing_lock_peek_tag (buf))) @@ -2970,15 +2966,9 @@ not be used as a stronger variant of normal restrictions. */) DEFUN ("internal--unlock-narrowing", Finternal__unlock_narrowing, Sinternal__unlock_narrowing, 1, 1, 0, - doc: /* Unlock a narrowing locked with (narrowing-lock TAG). + doc: /* Unlock a narrowing locked with LABEL. -Unlocking restrictions locked with `narrowing-lock' should be used -sparingly, after carefully considering the reasons why restrictions -were locked. Restrictions are typically locked around portions of -code that would become too slow, and make Emacs unresponsive, if they -were executed in a large buffer. For example, restrictions are locked -by Emacs around low-level hooks such as `fontification-functions' or -`post-command-hook'. */) +This is an internal function used by `without-narrowing'. */) (Lisp_Object tag) { Lisp_Object buf = Fcurrent_buffer (); @@ -3085,8 +3075,8 @@ DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0 The buffer's restrictions make parts of the beginning and end invisible. \(They are set up with `narrow-to-region' and eliminated with `widen'.) This special form, `save-restriction', saves the current buffer's -restrictions, as well as their locks if they have been locked with -`narrowing-lock', when it is entered, and restores them when it is exited. +restrictions, including those that were set by `with-narrowing' with a +label argument, when it is entered, and restores them when it is exited. So any `narrow-to-region' within BODY lasts only until the end of the form. The old restrictions settings are restored even in case of abnormal exit \(throw or error). diff --git a/src/keyboard.c b/src/keyboard.c index 4417aa97d28..1d0b907bd8e 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12731,13 +12731,11 @@ If an unhandled error happens in running this hook, the function in which the error occurred is unconditionally removed, since otherwise the error might happen repeatedly and make Emacs nonfunctional. -Note that, when the current buffer contains one or more lines whose -length is above `long-line-threshold', these hook functions are called -with the buffer narrowed to a small portion around point (whose size -is specified by `long-line-locked-narrowing-region-size'), and the -narrowing is locked (see `narrowing-lock'), so that these hook -functions cannot use `widen' to gain access to other portions of -buffer text. +Note that, when `long-line-optimizations-p' is non-nil in the buffer, +these functions are called as if they were in a `with-narrowing' form, +with a `long-line-optimizations-in-command-hooks' label and with the +buffer narrowed to a portion around point whose size is specified by +`long-line-optimizations-region-size'. See also `post-command-hook'. */); Vpre_command_hook = Qnil; @@ -12753,13 +12751,11 @@ It is a bad idea to use this hook for expensive processing. If unavoidable, wrap your code in `(while-no-input (redisplay) CODE)' to avoid making Emacs unresponsive while the user types. -Note that, when the current buffer contains one or more lines whose -length is above `long-line-threshold', these hook functions are called -with the buffer narrowed to a small portion around point (whose size -is specified by `long-line-locked-narrowing-region-size'), and the -narrowing is locked (see `narrowing-lock'), so that these hook -functions cannot use `widen' to gain access to other portions of -buffer text. +Note that, when `long-line-optimizations-p' is non-nil in the buffer, +these functions are called as if they were in a `with-narrowing' form, +with a `long-line-optimizations-in-command-hooks' label and with the +buffer narrowed to a portion around point whose size is specified by +`long-line-optimizations-region-size'. See also `pre-command-hook'. */); Vpost_command_hook = Qnil; diff --git a/src/xdisp.c b/src/xdisp.c index 8034b20d5f8..1450b869d20 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -36777,12 +36777,11 @@ Each function is called with one argument POS. Functions must fontify a region starting at POS in the current buffer, and give fontified regions the property `fontified' with a non-nil value. -Note that, when the buffer contains one or more lines whose length is -above `long-line-threshold', these functions are called with the -buffer narrowed to a small portion around POS (whose size is specified -by `long-line-locked-narrowing-region-size'), and the narrowing is -locked (see `narrowing-lock'), so that these functions cannot use -`widen' to gain access to other portions of buffer text. */); +Note that, when `long-line-optimizations-p' is non-nil in the buffer, +these functions are called as if they were in a `with-narrowing' form, +with a `long-line-optimizations-in-fontification-functions' label and +with the buffer narrowed to a portion around POS whose size is +specified by `long-line-optimizations-region-size'. */); Vfontification_functions = Qnil; Fmake_variable_buffer_local (Qfontification_functions); From 2956e54b1dda1647a9399211c7d09b208b85dcfa Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 9 Feb 2023 01:09:10 +0000 Subject: [PATCH 7/9] Add an extensive test for labeled (locked) narrowing * test/src/buffer-tests.el (test-labeled-narrowing): New test. --- test/src/buffer-tests.el | 106 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 106 insertions(+) diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 9d4bbf3e040..0ae78c8d9d9 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -8539,4 +8539,110 @@ Finally, kill the buffer and its temporary file." (if f2 (delete-file f2)) ))) +(ert-deftest test-labeled-narrowing () + "Test `with-narrowing' and `without-narrowing'." + (with-current-buffer (generate-new-buffer " foo" t) + (insert (make-string 5000 ?a)) + (should (= (point-min) 1)) + (should (= (point-max) 5001)) + (with-narrowing + 100 500 :label 'foo + (should (= (point-min) 100)) + (should (= (point-max) 500)) + (widen) + (should (= (point-min) 100)) + (should (= (point-max) 500)) + (narrow-to-region 1 5000) + (should (= (point-min) 100)) + (should (= (point-max) 500)) + (narrow-to-region 50 150) + (should (= (point-min) 100)) + (should (= (point-max) 150)) + (widen) + (should (= (point-min) 100)) + (should (= (point-max) 500)) + (narrow-to-region 400 1000) + (should (= (point-min) 400)) + (should (= (point-max) 500)) + (without-narrowing + :label 'bar + (should (= (point-min) 100)) + (should (= (point-max) 500))) + (without-narrowing + :label 'foo + (should (= (point-min) 1)) + (should (= (point-max) 5001))) + (should (= (point-min) 400)) + (should (= (point-max) 500)) + (widen) + (should (= (point-min) 100)) + (should (= (point-max) 500)) + (with-narrowing + 50 250 :label 'bar + (should (= (point-min) 100)) + (should (= (point-max) 250)) + (widen) + (should (= (point-min) 100)) + (should (= (point-max) 250)) + (without-narrowing + :label 'bar + (should (= (point-min) 100)) + (should (= (point-max) 500)) + (without-narrowing + :label 'foo + (should (= (point-min) 1)) + (should (= (point-max) 5001))) + (should (= (point-min) 100)) + (should (= (point-max) 500))) + (should (= (point-min) 100)) + (should (= (point-max) 250))) + (should (= (point-min) 100)) + (should (= (point-max) 500)) + (with-narrowing + 50 250 :label 'bar + (should (= (point-min) 100)) + (should (= (point-max) 250)) + (with-narrowing + 150 500 :label 'baz + (should (= (point-min) 150)) + (should (= (point-max) 250)) + (without-narrowing + :label 'bar + (should (= (point-min) 150)) + (should (= (point-max) 250))) + (without-narrowing + :label 'foo + (should (= (point-min) 150)) + (should (= (point-max) 250))) + (without-narrowing + :label 'baz + (should (= (point-min) 100)) + (should (= (point-max) 250)) + (without-narrowing + :label 'foo + (should (= (point-min) 100)) + (should (= (point-max) 250))) + (without-narrowing + :label 'bar + (should (= (point-min) 100)) + (should (= (point-max) 500)) + (without-narrowing + :label 'foobar + (should (= (point-min) 100)) + (should (= (point-max) 500))) + (without-narrowing + :label 'foo + (should (= (point-min) 1)) + (should (= (point-max) 5001))) + (should (= (point-min) 100)) + (should (= (point-max) 500))) + (should (= (point-min) 100)) + (should (= (point-max) 250))) + (should (= (point-min) 150)) + (should (= (point-max) 250))) + (should (= (point-min) 100)) + (should (= (point-max) 250)))) + (should (= (point-min) 1)) + (should (= (point-max) 5001)))) + ;;; buffer-tests.el ends here From 4297039bd1325166eac82d950951716ec122d465 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Fri, 10 Feb 2023 20:55:47 +0000 Subject: [PATCH 8/9] Save and restore the absence of narrowing locks * src/editfns.c (narrowing_locks_save): Return the buffer with a empty locks list when the current buffer has no narrowing locks. (narrowing_locks_restore): Remove the narrowing locks if the buffer had no narrowing locks. --- src/editfns.c | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/editfns.c b/src/editfns.c index 64906671be7..f9879662168 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2799,21 +2799,19 @@ narrowing_locks_save (void) { Lisp_Object buf = Fcurrent_buffer (); Lisp_Object locks = assq_no_quit (buf, narrowing_locks); - if (NILP (locks)) - return Qnil; - locks = XCAR (XCDR (locks)); + if (!NILP (locks)) + locks = XCAR (XCDR (locks)); return Fcons (buf, Fcopy_sequence (locks)); } void narrowing_locks_restore (Lisp_Object buf_and_saved_locks) { - if (NILP (buf_and_saved_locks)) - return; Lisp_Object buf = XCAR (buf_and_saved_locks); Lisp_Object saved_locks = XCDR (buf_and_saved_locks); narrowing_locks_remove (buf); - narrowing_locks_add (buf, saved_locks); + if (!NILP (saved_locks)) + narrowing_locks_add (buf, saved_locks); } static void From dcb2379a463678bdadd05ee39d61e7da84c71c5e Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Mon, 13 Feb 2023 10:23:39 +0000 Subject: [PATCH 9/9] Minor improvements to labeled narrowing * lisp/subr.el (internal--with-narrowing): (internal--without-narrowing): Remove unnecessary 'progn'. * etc/NEWS: Mention 'with-narrowing' in the entry about long lines. * doc/lispref/positions.texi (Narrowing): Fix typo. * doc/lispref/display.texi (Auto Faces): Use @pxref. * doc/lispref/commands.texi (Command Overview): Use @pxref. --- doc/lispref/commands.texi | 4 ++-- doc/lispref/display.texi | 2 +- doc/lispref/positions.texi | 2 +- etc/NEWS | 5 +++-- lisp/subr.el | 14 ++++++-------- 5 files changed, 13 insertions(+), 14 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index be34027d21d..9723c279a45 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -100,8 +100,8 @@ emacs, The GNU Emacs Manual}) runs these two hooks just as a keyboard command does. Note that, when the buffer text includes very long lines, these two -hooks are called as if they were in a @code{with-narrowing} form (see -@ref{Narrowing}), with a +hooks are called as if they were in a @code{with-narrowing} form +(@pxref{Narrowing}), with a @code{long-line-optimizations-in-command-hooks} label and with the buffer narrowed to a portion around point. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 1b7ef006634..f0ca7440c60 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -3503,7 +3503,7 @@ usually assign faces to around 400 to 600 characters at each call. Note that, when the buffer text includes very long lines, these functions are called as if they were in a @code{with-narrowing} form -(see @ref{Narrowing}), with a +(@pxref{Narrowing}), with a @code{long-line-optimizations-in-fontification-functions} label and with the buffer narrowed to a portion around @var{pos}. @end defvar diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index e7d5c610d67..bad83e1be2d 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -1193,5 +1193,5 @@ restores the saved bounds. In that case it is equivalent to When the optional @var{label} argument is present however, the narrowing set by @code{with-narrowing} with the same @var{label} -argument are lifted. +argument is lifted. @end defspec diff --git a/etc/NEWS b/etc/NEWS index 01e7f2cfb09..de4f65ebe62 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -619,8 +619,9 @@ In buffers in which these display optimizations are in effect, the 'fontification-functions', 'pre-command-hook' and 'post-command-hook' hooks are executed on a narrowed portion of the buffer, whose size is controlled by the options 'long-line-optimizations-region-size' and -'long-line-optimizations-bol-search-limit'. This may, in particular, -cause occasional mis-fontifications in these buffers. +'long-line-optimizations-bol-search-limit', as if they were in a +'with-narrowing' form. This may, in particular, cause occasional +mis-fontifications in these buffers. The new function 'long-line-optimizations-p' returns non-nil when these optimizations are in effect in the current buffer. diff --git a/lisp/subr.el b/lisp/subr.el index 7ed0cb02a70..d280c7fef13 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3961,10 +3961,9 @@ same LABEL argument. (defun internal--with-narrowing (start end body &optional label) "Helper function for `with-narrowing', which see." (save-restriction - (progn - (narrow-to-region start end) - (if label (internal--lock-narrowing label)) - (funcall body)))) + (narrow-to-region start end) + (if label (internal--lock-narrowing label)) + (funcall body))) (defmacro without-narrowing (&rest rest) "Execute BODY without restrictions. @@ -3984,10 +3983,9 @@ are lifted. (defun internal--without-narrowing (body &optional label) "Helper function for `without-narrowing', which see." (save-restriction - (progn - (if label (internal--unlock-narrowing label)) - (widen) - (funcall body)))) + (if label (internal--unlock-narrowing label)) + (widen) + (funcall body))) (defun find-tag-default-bounds () "Determine the boundaries of the default tag, based on text at point.