diff options
author | Gregory Heytings <gregory@heytings.org> | 2022-11-27 22:19:41 +0100 |
---|---|---|
committer | Gregory Heytings <gregory@heytings.org> | 2022-11-27 22:19:41 +0100 |
commit | 849223fba1ef899f90a6edff05bce24b90fbb043 (patch) | |
tree | b5ab707f2da7d13ba2cb10c8af441547152c83ef /src | |
parent | 89a10ffcc49c5832619649b7876cc339fa9d0dcf (diff) | |
parent | 18fa159fa91b515f2281b83648961fdc5e21aca7 (diff) | |
download | emacs-849223fba1ef899f90a6edff05bce24b90fbb043.tar.gz |
Merge branch 'feature/improved-locked-narrowing'
Diffstat (limited to 'src')
-rw-r--r-- | src/buffer.c | 37 | ||||
-rw-r--r-- | src/dispextern.h | 10 | ||||
-rw-r--r-- | src/editfns.c | 373 | ||||
-rw-r--r-- | src/keyboard.c | 16 | ||||
-rw-r--r-- | src/lisp.h | 3 | ||||
-rw-r--r-- | src/xdisp.c | 59 |
6 files changed, 407 insertions, 91 deletions
diff --git a/src/buffer.c b/src/buffer.c index ac7f4f8e9d4..71be7ed9e13 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5898,7 +5898,42 @@ this threshold. 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, 10000); + XSETFASTINT (Vlong_line_threshold, 50000); + + DEFVAR_INT ("long-line-locked-narrowing-region-size", + long_line_locked_narrowing_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 +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. + +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; + + DEFVAR_INT ("long-line-locked-narrowing-bol-search-limit", + long_line_locked_narrowing_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. + +There is no reason to change that value except for debugging purposes. */); + long_line_locked_narrowing_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/dispextern.h b/src/dispextern.h index 2afbdeabaab..df6134e68f0 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2342,6 +2342,14 @@ struct it optimize display. */ ptrdiff_t narrowed_zv; + /* Begin position of the buffer for the locked narrowing around + low-level hooks. */ + ptrdiff_t locked_narrowing_begv; + + /* End position of the buffer for the locked narrowing around + low-level hooks. */ + ptrdiff_t locked_narrowing_zv; + /* C string to iterate over. Non-null means get characters from this string, otherwise characters are read from current_buffer or it->string. */ @@ -3405,6 +3413,8 @@ void init_iterator (struct it *, struct window *, ptrdiff_t, ptrdiff_t get_narrowed_begv (struct window *, ptrdiff_t); ptrdiff_t get_narrowed_zv (struct window *, ptrdiff_t); ptrdiff_t get_closer_narrowed_begv (struct window *, ptrdiff_t); +ptrdiff_t get_locked_narrowing_begv (ptrdiff_t); +ptrdiff_t get_locked_narrowing_zv (ptrdiff_t); void init_iterator_to_row_start (struct it *, struct window *, struct glyph_row *); void start_display (struct it *, struct window *, struct text_pos); diff --git a/src/editfns.c b/src/editfns.c index 17dca4708ed..b364f441b53 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2653,88 +2653,216 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region, return del_range_1 (XFIXNUM (start), XFIXNUM (end), 1, 1); } -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. +/* Alist of buffers in which locked narrowing is used. The car of + each list element is a buffer, the cdr is a list of triplets (tag + begv-marker zv-marker). The last element of that list always uses + 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. */ +static Lisp_Object narrowing_locks; + +/* Add BUF with its LOCKS in the narrowing_locks alist. */ +static void +narrowing_locks_add (Lisp_Object buf, Lisp_Object locks) +{ + narrowing_locks = nconc2 (list1 (list2 (buf, locks)), narrowing_locks); +} -Note that, when the current buffer contains one or more lines whose -length is above `long-line-threshold', Emacs may decide to leave, for -performance reasons, the accessible portion of the buffer unchanged -after this function is called from low-level hooks, such as -`jit-lock-functions' or `post-command-hook'. */) - (void) +/* Remove BUF and its locks from the narrowing_locks alist. Do + nothing if BUF is not present in narrowing_locks. */ +static void +narrowing_locks_remove (Lisp_Object buf) +{ + narrowing_locks = Fdelq (Fassoc (buf, narrowing_locks, Qnil), + narrowing_locks); +} + +/* Retrieve one of the BEGV/ZV bounds of a narrowing in BUF from the + narrowing_locks alist, as a pointer to a struct Lisp_Marker, or + NULL if BUF is not in narrowing_locks or is a killed buffer. When + OUTERMOST is true, the bounds that were set by the user and that + are visible on display are returned. Otherwise the innermost + locked narrowing bounds are returned. */ +static struct Lisp_Marker * +narrowing_lock_get_bound (Lisp_Object buf, bool begv, bool outermost) +{ + if (NILP (Fbuffer_live_p (buf))) + return NULL; + Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks); + if (NILP (buffer_locks)) + return NULL; + buffer_locks = XCAR (XCDR (buffer_locks)); + Lisp_Object bounds + = outermost + ? XCDR (assq_no_quit (Qoutermost_narrowing, buffer_locks)) + : XCDR (XCAR (buffer_locks)); + eassert (! NILP (bounds)); + Lisp_Object marker = begv ? XCAR (bounds) : XCAR (XCDR (bounds)); + eassert (EQ (Fmarker_buffer (marker), buf)); + return XMARKER (marker); +} + +/* Retrieve the tag of the innermost narrowing in BUF. Return nil if + BUF is not in narrowing_locks or is a killed buffer. */ +static Lisp_Object +narrowing_lock_peek_tag (Lisp_Object buf) { - if (! NILP (Vrestrictions_locked)) + if (NILP (Fbuffer_live_p (buf))) return Qnil; - if (BEG != BEGV || Z != ZV) - current_buffer->clip_changed = 1; - BEGV = BEG; - BEGV_BYTE = BEG_BYTE; - SET_BUF_ZV_BOTH (current_buffer, Z, Z_BYTE); - /* Changing the buffer bounds invalidates any recorded current column. */ - invalidate_current_column (); - return Qnil; + Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks); + if (NILP (buffer_locks)) + return Qnil; + Lisp_Object tag = XCAR (XCAR (XCAR (XCDR (buffer_locks)))); + eassert (! NILP (tag)); + return tag; } +/* Add a LOCK for BUF in the narrowing_locks alist. */ static void -unwind_locked_begv (Lisp_Object point_min) +narrowing_lock_push (Lisp_Object buf, Lisp_Object lock) { - SET_BUF_BEGV (current_buffer, XFIXNUM (point_min)); + Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks); + if (NILP (buffer_locks)) + narrowing_locks_add (buf, list1 (lock)); + else + XSETCDR (buffer_locks, list1 (nconc2 (list1 (lock), + XCAR (XCDR (buffer_locks))))); } +/* Remove the innermost lock in BUF from the narrowing_locks alist. + Do nothing if BUF is not present in narrowing_locks. */ static void -unwind_locked_zv (Lisp_Object point_max) +narrowing_lock_pop (Lisp_Object buf) { - SET_BUF_ZV (current_buffer, XFIXNUM (point_max)); + Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks); + if (NILP (buffer_locks)) + return; + if (EQ (narrowing_lock_peek_tag (buf), Qoutermost_narrowing)) + narrowing_locks_remove (buf); + else + XSETCDR (buffer_locks, list1 (XCDR (XCAR (XCDR (buffer_locks))))); } -/* Internal function for Fnarrow_to_region, meant to be used with a - third argument 'true', in which case it should be followed by "specbind - (Qrestrictions_locked, Qt)". */ -Lisp_Object -narrow_to_region_internal (Lisp_Object start, Lisp_Object end, bool lock) +static void +unwind_reset_outermost_narrowing (Lisp_Object buf) { - EMACS_INT s = fix_position (start), e = fix_position (end); - - if (e < s) + struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, false); + struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, false); + if (begv != NULL && zv != NULL) { - EMACS_INT tem = s; s = e; e = tem; + SET_BUF_BEGV_BOTH (XBUFFER (buf), begv->charpos, begv->bytepos); + SET_BUF_ZV_BOTH (XBUFFER (buf), zv->charpos, zv->bytepos); } + else + narrowing_locks_remove (buf); +} - if (lock) +/* Restore the narrowing bounds that were set by the user, and restore + the bounds of the locked narrowing upon return. + 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. */ +void +reset_outermost_narrowings (void) +{ + Lisp_Object val, buf; + for (val = narrowing_locks; CONSP (val); val = XCDR (val)) { - if (!(BEGV <= s && s <= e && e <= ZV)) - args_out_of_range (start, end); + buf = XCAR (XCAR (val)); + eassert (BUFFERP (buf)); + struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, true); + struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, true); + if (begv != NULL && zv != NULL) + { + SET_BUF_BEGV_BOTH (XBUFFER (buf), begv->charpos, begv->bytepos); + SET_BUF_ZV_BOTH (XBUFFER (buf), zv->charpos, zv->bytepos); + record_unwind_protect (unwind_reset_outermost_narrowing, buf); + } + else + narrowing_locks_remove (buf); + } +} - if (BEGV != s || ZV != e) - current_buffer->clip_changed = 1; +/* Helper functions to save and restore the narrowing locks of the + current buffer in Fsave_restriction. */ +static Lisp_Object +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)); + return Fcons (buf, Fcopy_sequence (locks)); +} - record_unwind_protect (restore_point_unwind, Fpoint_marker ()); - record_unwind_protect (unwind_locked_begv, Fpoint_min ()); - record_unwind_protect (unwind_locked_zv, Fpoint_max ()); +static 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); +} - SET_BUF_BEGV (current_buffer, s); - SET_BUF_ZV (current_buffer, e); +static void +unwind_narrow_to_region_locked (Lisp_Object tag) +{ + Fnarrowing_unlock (tag); + Fwiden (); +} + +/* Narrow current_buffer to BEGV-ZV with a narrowing locked with TAG. */ +void +narrow_to_region_locked (Lisp_Object begv, Lisp_Object zv, Lisp_Object tag) +{ + Fnarrow_to_region (begv, zv); + Fnarrowing_lock (tag); + record_unwind_protect (restore_point_unwind, Fpoint_marker ()); + record_unwind_protect (unwind_narrow_to_region_locked, 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. */) + (void) +{ + Fset (Qoutermost_narrowing, Qnil); + Lisp_Object buf = Fcurrent_buffer (); + Lisp_Object tag = narrowing_lock_peek_tag (buf); + + if (NILP (tag)) + { + if (BEG != BEGV || Z != ZV) + current_buffer->clip_changed = 1; + BEGV = BEG; + BEGV_BYTE = BEG_BYTE; + SET_BUF_ZV_BOTH (current_buffer, Z, Z_BYTE); } 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) + struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, false); + struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, false); + eassert (begv != NULL && zv != NULL); + if (begv->charpos != BEGV || zv->charpos != ZV) current_buffer->clip_changed = 1; - - SET_BUF_BEGV (current_buffer, s); - SET_BUF_ZV (current_buffer, e); + SET_BUF_BEGV_BOTH (current_buffer, begv->charpos, begv->bytepos); + SET_BUF_ZV_BOTH (current_buffer, zv->charpos, zv->bytepos); + /* If the only remaining bounds in narrowing_locks for + current_buffer are the bounds that were set by the user, no + locked narrowing is in effect in current_buffer anymore: + remove it from the narrowing_locks alist. */ + if (EQ (tag, Qoutermost_narrowing)) + narrowing_lock_pop (buf); } - - if (PT < s) - SET_PT (s); - if (e < PT) - SET_PT (e); /* Changing the buffer bounds invalidates any recorded current column. */ invalidate_current_column (); return Qnil; @@ -2751,14 +2879,110 @@ When calling from Lisp, pass two arguments START and END: positions (integers or markers) bounding the text that should remain visible. -Note that, when the current buffer contains one or more lines whose -length is above `long-line-threshold', Emacs may decide to leave, for -performance reasons, the accessible portion of the buffer unchanged -after this function is called from low-level hooks, such as -`jit-lock-functions' or `post-command-hook'. */) +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. */) (Lisp_Object start, Lisp_Object end) { - return narrow_to_region_internal (start, end, false); + EMACS_INT s = fix_position (start), e = fix_position (end); + + if (e < s) + { + EMACS_INT tem = s; s = e; e = tem; + } + + if (!(BEG <= s && s <= e && e <= Z)) + args_out_of_range (start, end); + + Lisp_Object buf = Fcurrent_buffer (); + if (! NILP (narrowing_lock_peek_tag (buf))) + { + struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, false); + struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, false); + eassert (begv != NULL && zv != NULL); + /* Limit the start and end positions to those of the locked + narrowing. */ + if (s < begv->charpos) s = begv->charpos; + if (s > zv->charpos) s = zv->charpos; + if (e < begv->charpos) e = begv->charpos; + 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. It is used + only by narrowing-lock. */ + Fset (Qoutermost_narrowing, list3 (Qoutermost_narrowing, + Fpoint_min_marker (), + Fpoint_max_marker ())); + + if (BEGV != s || ZV != e) + current_buffer->clip_changed = 1; + + SET_BUF_BEGV (current_buffer, s); + SET_BUF_ZV (current_buffer, e); + + if (PT < s) + SET_PT (s); + if (e < PT) + SET_PT (e); + /* Changing the buffer bounds invalidates any recorded current column. */ + invalidate_current_column (); + return Qnil; +} + +DEFUN ("narrowing-lock", Fnarrowing_lock, Snarrowing_lock, 1, 1, 0, + doc: /* Lock the current narrowing with TAG. + +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. */) + (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 (NILP (outermost_narrowing)) + return Qnil; + if (NILP (narrowing_lock_peek_tag (buf))) + narrowing_lock_push (buf, outermost_narrowing); + narrowing_lock_push (buf, list3 (tag, + Fpoint_min_marker (), + Fpoint_max_marker ())); + return Qnil; +} + +DEFUN ("narrowing-unlock", Fnarrowing_unlock, Snarrowing_unlock, 1, 1, 0, + doc: /* Unlock a narrowing locked with (narrowing-lock TAG). + +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'. */) + (Lisp_Object tag) +{ + Lisp_Object buf = Fcurrent_buffer (); + if (EQ (narrowing_lock_peek_tag (buf), tag)) + narrowing_lock_pop (buf); + return Qnil; } Lisp_Object @@ -2858,11 +3082,12 @@ DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0 doc: /* Execute BODY, saving and restoring current buffer's restrictions. 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 -when it is entered, and restores them when it is exited. +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. 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). +The old restrictions settings are restored even in case of abnormal exit +\(throw or error). The value returned is the value of the last form in BODY. @@ -2877,6 +3102,7 @@ usage: (save-restriction &rest BODY) */) specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect (save_restriction_restore, save_restriction_save ()); + record_unwind_protect (narrowing_locks_restore, narrowing_locks_save ()); val = Fprogn (body); return unbind_to (count, val); } @@ -4518,6 +4744,8 @@ syms_of_editfns (void) DEFSYM (Qwall, "wall"); DEFSYM (Qpropertize, "propertize"); + staticpro (&narrowing_locks); + DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion, doc: /* Non-nil means text motion commands don't notice fields. */); Vinhibit_field_text_motion = Qnil; @@ -4577,11 +4805,12 @@ This variable is experimental; email 32252@debbugs.gnu.org if you need it to be non-nil. */); binary_as_unsigned = false; - DEFSYM (Qrestrictions_locked, "restrictions-locked"); - DEFVAR_LISP ("restrictions-locked", Vrestrictions_locked, - doc: /* If non-nil, restrictions are currently locked. */); - Vrestrictions_locked = Qnil; - Funintern (Qrestrictions_locked, Qnil); + DEFVAR_LISP ("outermost-narrowing", Voutermost_narrowing, + doc: /* Outermost narrowing bounds, if any. Internal use only. */); + Voutermost_narrowing = Qnil; + Fmake_variable_buffer_local (Qoutermost_narrowing); + DEFSYM (Qoutermost_narrowing, "outermost-narrowing"); + Funintern (Qoutermost_narrowing, Qnil); defsubr (&Spropertize); defsubr (&Schar_equal); @@ -4674,6 +4903,8 @@ it to be non-nil. */); defsubr (&Sdelete_and_extract_region); defsubr (&Swiden); defsubr (&Snarrow_to_region); + defsubr (&Snarrowing_lock); + defsubr (&Snarrowing_unlock); defsubr (&Ssave_restriction); defsubr (&Stranspose_regions); } diff --git a/src/keyboard.c b/src/keyboard.c index 811998823cc..b82a5e1a3ef 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1911,9 +1911,9 @@ safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct window *w) specbind (Qinhibit_quit, Qt); if (current_buffer->long_line_optimizations_p) - narrow_to_region_internal (make_fixnum (get_narrowed_begv (w, PT)), - make_fixnum (get_narrowed_zv (w, PT)), - true); + narrow_to_region_locked (make_fixnum (get_locked_narrowing_begv (PT)), + make_fixnum (get_locked_narrowing_zv (PT)), + hook); run_hook_with_args (2, ((Lisp_Object []) {hook, hook}), safe_run_hook_funcall); @@ -12727,8 +12727,9 @@ 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, and the -narrowing is locked (see `narrow-to-region'), so that these hook +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. @@ -12748,8 +12749,9 @@ 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, and the -narrowing is locked (see `narrow-to-region'), so that these hook +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. diff --git a/src/lisp.h b/src/lisp.h index 6a24a538172..0f70f60d75c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4687,7 +4687,8 @@ extern void save_restriction_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); -extern Lisp_Object narrow_to_region_internal (Lisp_Object, Lisp_Object, bool); +extern void narrow_to_region_locked (Lisp_Object, Lisp_Object, Lisp_Object); +extern void reset_outermost_narrowings (void); extern void init_editfns (void); extern void syms_of_editfns (void); diff --git a/src/xdisp.c b/src/xdisp.c index 5dcf21dc4ce..0002c3d611c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3533,6 +3533,33 @@ get_closer_narrowed_begv (struct window *w, ptrdiff_t pos) return max ((pos / len - 1) * len, BEGV); } +ptrdiff_t +get_locked_narrowing_begv (ptrdiff_t pos) +{ + if (long_line_locked_narrowing_region_size == 0) + return BEGV; + int len = long_line_locked_narrowing_region_size / 2; + int begv = max (pos - len, BEGV); + int limit = long_line_locked_narrowing_bol_search_limit; + while (limit) + { + if (begv == BEGV || FETCH_BYTE (CHAR_TO_BYTE (begv) - 1) == '\n') + return begv; + begv--; + limit--; + } + return begv; +} + +ptrdiff_t +get_locked_narrowing_zv (ptrdiff_t pos) +{ + if (long_line_locked_narrowing_region_size == 0) + return ZV; + int len = long_line_locked_narrowing_region_size / 2; + return min (pos + len, ZV); +} + static void unwind_narrowed_begv (Lisp_Object point_min) { @@ -4368,16 +4395,16 @@ handle_fontified_prop (struct it *it) if (current_buffer->long_line_optimizations_p) { - ptrdiff_t begv = it->narrowed_begv; - ptrdiff_t zv = it->narrowed_zv; + ptrdiff_t begv = it->locked_narrowing_begv; + ptrdiff_t zv = it->locked_narrowing_zv; ptrdiff_t charpos = IT_CHARPOS (*it); if (charpos < begv || charpos > zv) { - begv = get_narrowed_begv (it->w, charpos); - zv = get_narrowed_zv (it->w, charpos); + begv = get_locked_narrowing_begv (charpos); + zv = get_locked_narrowing_zv (charpos); } - narrow_to_region_internal (make_fixnum (begv), make_fixnum (zv), true); - specbind (Qrestrictions_locked, Qt); + narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv), + Qfontification_functions); } /* Don't allow Lisp that runs from 'fontification-functions' @@ -7435,12 +7462,20 @@ reseat (struct it *it, struct text_pos pos, bool force_p) { it->narrowed_begv = get_narrowed_begv (it->w, window_point (it->w)); it->narrowed_zv = get_narrowed_zv (it->w, window_point (it->w)); + it->locked_narrowing_begv + = get_locked_narrowing_begv (window_point (it->w)); + it->locked_narrowing_zv + = get_locked_narrowing_zv (window_point (it->w)); } else if ((pos.charpos < it->narrowed_begv || pos.charpos > it->narrowed_zv) && (!redisplaying_p || it->line_wrap == TRUNCATE)) { it->narrowed_begv = get_narrowed_begv (it->w, pos.charpos); it->narrowed_zv = get_narrowed_zv (it->w, pos.charpos); + it->locked_narrowing_begv + = get_locked_narrowing_begv (window_point (it->w)); + it->locked_narrowing_zv + = get_locked_narrowing_zv (window_point (it->w)); } } @@ -16266,7 +16301,6 @@ do { if (! polling_stopped_here) stop_polling (); \ do { if (polling_stopped_here) start_polling (); \ polling_stopped_here = false; } while (false) - /* Perhaps in the future avoid recentering windows if it is not necessary; currently that causes some problems. */ @@ -16352,6 +16386,8 @@ redisplay_internal (void) FOR_EACH_FRAME (tail, frame) XFRAME (frame)->already_hscrolled_p = false; + reset_outermost_narrowings (); + retry: /* Remember the currently selected window. */ sw = w; @@ -36711,10 +36747,11 @@ 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, and the narrowing is locked (see -`narrow-to-region'), so that these functions cannot use `widen' to gain -access to other portions of buffer text. */); +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. */); Vfontification_functions = Qnil; Fmake_variable_buffer_local (Qfontification_functions); |