diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index 1b32f18922c..e09fd4e7ca5 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -1154,6 +1154,7 @@ saved bounds. In that case it is equivalent to @end example @cindex labeled narrowing +@cindex labeled restriction When the optional argument @var{label}, a symbol, is present, the narrowing is @dfn{labeled}. A labeled narrowing differs from a non-labeled one in several ways: diff --git a/lisp/subr.el b/lisp/subr.el index f82826e819c..ca1fc2886b4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3975,7 +3975,7 @@ same LABEL argument. "Helper function for `with-restriction', which see." (save-restriction (narrow-to-region start end) - (if label (internal--lock-narrowing label)) + (if label (internal--label-restriction label)) (funcall body))) (defmacro without-restriction (&rest rest) @@ -3997,7 +3997,7 @@ are lifted. (defun internal--without-restriction (body &optional label) "Helper function for `without-restriction', which see." (save-restriction - (if label (internal--unlock-narrowing label)) + (if label (internal--unlabel-restriction label)) (widen) (funcall body))) diff --git a/src/buffer.c b/src/buffer.c index 0c740775e5b..252231357bc 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -2386,6 +2386,7 @@ Any narrowing restriction in effect (see `narrow-to-region') is removed, so the buffer is truly empty after this. */) (void) { + labeled_restrictions_remove_in_current_buffer (); Fwiden (); del_range (BEG, Z); diff --git a/src/callproc.c b/src/callproc.c index 5e1e1a8cc0a..6f3d4fad9be 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1113,6 +1113,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r { /* No need to save restrictions since we delete everything anyway. */ + labeled_restrictions_remove_in_current_buffer (); Fwiden (); del_range (BEG, Z); } diff --git a/src/composite.c b/src/composite.c index 164eeb39598..885db24df01 100644 --- a/src/composite.c +++ b/src/composite.c @@ -1075,7 +1075,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, with long lines, however, NL might be far away, so pretend that the buffer is smaller. */ if (current_buffer->long_line_optimizations_p) - endpos = get_closer_narrowed_begv (cmp_it->parent_it->w, charpos); + endpos = get_small_narrowing_begv (cmp_it->parent_it->w, charpos); } } cmp_it->id = -1; @@ -1654,7 +1654,7 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, ptrdiff_t backlim, { /* In buffers with very long lines, this function becomes very slow. Pretend that the buffer is narrowed to make it fast. */ - ptrdiff_t begv = get_closer_narrowed_begv (w, window_point (w)); + ptrdiff_t begv = get_small_narrowing_begv (w, window_point (w)); if (pos > begv) head = begv; } diff --git a/src/dispextern.h b/src/dispextern.h index 4dcab113ea2..ece128949f5 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2334,21 +2334,20 @@ struct it with which display_string was called. */ ptrdiff_t end_charpos; - /* Alternate begin position of the buffer that may be used to - optimize display (see the SET_WITH_NARROWED_BEGV macro). */ - ptrdiff_t narrowed_begv; - - /* Alternate end position of the buffer that may be used to - 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; + /* Alternate begin and end positions of the buffer that are used to + optimize display of buffers with long lines. These two fields + hold the return value of the 'get_medium_narrowing_begv' and + 'get_medium_narrowing_zv' functions. */ + ptrdiff_t medium_narrowing_begv; + ptrdiff_t medium_narrowing_zv; + + /* Alternate begin and end positions of the buffer that are used for + labeled narrowings around low-level hooks in buffers with long + lines. These two fields hold the return value of the + 'get_large_narrowing_begv' and 'get_large_narrowing_zv' + functions. */ + ptrdiff_t large_narrowing_begv; + ptrdiff_t large_narrowing_zv; /* C string to iterate over. Non-null means get characters from this string, otherwise characters are read from current_buffer @@ -3410,11 +3409,9 @@ void mark_window_display_accurate (Lisp_Object, bool); void redisplay_preserve_echo_area (int); void init_iterator (struct it *, struct window *, ptrdiff_t, ptrdiff_t, struct glyph_row *, enum face_id); -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); +ptrdiff_t get_small_narrowing_begv (struct window *, ptrdiff_t); +ptrdiff_t get_large_narrowing_begv (ptrdiff_t); +ptrdiff_t get_large_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 f83c5c7259b..4c5b691eb50 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2653,182 +2653,204 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region, return del_range_1 (XFIXNUM (start), XFIXNUM (end), 1, 1); } -/* 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, - 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. */ +/* Alist of buffers in which labeled restrictions are used. The car + of each list element is a buffer, the cdr is a list of triplets + (label begv-marker zv-marker). The last triplet of that list + always uses the (uninterned) Qoutermost_restriction label, and + records the restriction bounds that were current when the first + labeled restriction was entered (which may be a narrowing that was + set by the user and is visible on display). This alist is used + internally by narrow-to-region, widen, internal--label-restriction, + internal--unlabel-restriction and save-restriction. For efficiency + reasons, an alist is used instead of a buffer-local variable: + otherwise reset_outermost_restrictions, which is called during each + redisplay cycle, would have to loop through all live buffers. */ +static Lisp_Object labeled_restrictions; + +/* Add BUF with its list of labeled RESTRICTIONS in the + labeled_restrictions alist. */ static void -narrowing_locks_add (Lisp_Object buf, Lisp_Object locks) +labeled_restrictions_add (Lisp_Object buf, Lisp_Object restrictions) { - narrowing_locks = nconc2 (list1 (list2 (buf, locks)), narrowing_locks); + labeled_restrictions = nconc2 (list1 (list2 (buf, restrictions)), + labeled_restrictions); } -/* Remove BUF and its locks from the narrowing_locks alist. Do - nothing if BUF is not present in narrowing_locks. */ +/* Remove BUF and its list of labeled restrictions from the + labeled_restrictions alist. Do nothing if BUF is not present in + labeled_restrictions. */ static void -narrowing_locks_remove (Lisp_Object buf) +labeled_restrictions_remove (Lisp_Object buf) { - narrowing_locks = Fdelq (Fassoc (buf, narrowing_locks, Qnil), - narrowing_locks); + labeled_restrictions = Fdelq (Fassoc (buf, labeled_restrictions, Qnil), + labeled_restrictions); } -/* 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. */ +/* Retrieve one of the labeled restriction bounds in BUF from the + labeled_restrictions alist, as a pointer to a struct Lisp_Marker, + or return NULL if BUF is not in labeled_restrictions or is a killed + buffer. When OUTERMOST is true, the restriction bounds that were + current when the first labeled restriction was entered are + returned. Otherwise the bounds of the innermost labeled + restriction are returned. */ static struct Lisp_Marker * -narrowing_lock_get_bound (Lisp_Object buf, bool begv, bool outermost) +labeled_restrictions_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)) + Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions); + if (NILP (restrictions)) return NULL; - buffer_locks = XCAR (XCDR (buffer_locks)); + restrictions = XCAR (XCDR (restrictions)); Lisp_Object bounds = outermost - ? XCDR (assq_no_quit (Qoutermost_narrowing, buffer_locks)) - : XCDR (XCAR (buffer_locks)); + ? XCDR (assq_no_quit (Qoutermost_restriction, restrictions)) + : XCDR (XCAR (restrictions)); 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. */ +/* Retrieve the label of the innermost labeled restriction in BUF. + Return nil if BUF is not in labeled_restrictions or is a killed + buffer. */ static Lisp_Object -narrowing_lock_peek_tag (Lisp_Object buf) +labeled_restrictions_peek_label (Lisp_Object buf) { if (NILP (Fbuffer_live_p (buf))) return Qnil; - Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks); - if (NILP (buffer_locks)) + Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions); + if (NILP (restrictions)) return Qnil; - Lisp_Object tag = XCAR (XCAR (XCAR (XCDR (buffer_locks)))); - eassert (! NILP (tag)); - return tag; + Lisp_Object label = XCAR (XCAR (XCAR (XCDR (restrictions)))); + eassert (! NILP (label)); + return label; } -/* Add a LOCK for BUF in the narrowing_locks alist. */ +/* Add a labeled RESTRICTION for BUF in the labeled_restrictions + alist. */ static void -narrowing_lock_push (Lisp_Object buf, Lisp_Object lock) +labeled_restrictions_push (Lisp_Object buf, Lisp_Object restriction) { - Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks); - if (NILP (buffer_locks)) - narrowing_locks_add (buf, list1 (lock)); + Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions); + if (NILP (restrictions)) + labeled_restrictions_add (buf, list1 (restriction)); else - XSETCDR (buffer_locks, list1 (nconc2 (list1 (lock), - XCAR (XCDR (buffer_locks))))); + XSETCDR (restrictions, list1 (nconc2 (list1 (restriction), + XCAR (XCDR (restrictions))))); } -/* Remove the innermost lock in BUF from the narrowing_locks alist. - Do nothing if BUF is not present in narrowing_locks. */ +/* Remove the innermost labeled restriction in BUF from the + labeled_restrictions alist. Do nothing if BUF is not present in + labeled_restrictions. */ static void -narrowing_lock_pop (Lisp_Object buf) +labeled_restrictions_pop (Lisp_Object buf) { - Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks); - if (NILP (buffer_locks)) + Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions); + if (NILP (restrictions)) return; - if (EQ (narrowing_lock_peek_tag (buf), Qoutermost_narrowing)) - narrowing_locks_remove (buf); + if (EQ (labeled_restrictions_peek_label (buf), Qoutermost_restriction)) + labeled_restrictions_remove (buf); else - XSETCDR (buffer_locks, list1 (XCDR (XCAR (XCDR (buffer_locks))))); + XSETCDR (restrictions, list1 (XCDR (XCAR (XCDR (restrictions))))); +} + +/* Unconditionally remove all labeled restrictions in current_buffer. */ +void +labeled_restrictions_remove_in_current_buffer (void) +{ + labeled_restrictions_remove (Fcurrent_buffer ()); } static void -unwind_reset_outermost_narrowing (Lisp_Object buf) +unwind_reset_outermost_restriction (Lisp_Object buf) { - struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, false); - struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, false); + struct Lisp_Marker *begv + = labeled_restrictions_get_bound (buf, true, false); + struct Lisp_Marker *zv + = labeled_restrictions_get_bound (buf, false, false); 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); } else - narrowing_locks_remove (buf); + labeled_restrictions_remove (buf); } -/* Restore the narrowing bounds that were set by the user, and restore - the bounds of the locked narrowing upon return. +/* Restore the restriction bounds that were current when the first + labeled restriction was entered, and restore the bounds of the + innermost labeled restriction 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. + while labeled restrictions are in effect, these restrictions will + not become 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) +reset_outermost_restrictions (void) { Lisp_Object val, buf; - for (val = narrowing_locks; CONSP (val); val = XCDR (val)) + for (val = labeled_restrictions; CONSP (val); val = XCDR (val)) { 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); + struct Lisp_Marker *begv + = labeled_restrictions_get_bound (buf, true, true); + struct Lisp_Marker *zv + = labeled_restrictions_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); + record_unwind_protect (unwind_reset_outermost_restriction, buf); } else - narrowing_locks_remove (buf); + labeled_restrictions_remove (buf); } } -/* Helper functions to save and restore the narrowing locks of the - current buffer in Fsave_restriction. */ +/* Helper functions to save and restore the labeled restrictions of + the current buffer in Fsave_restriction. */ static Lisp_Object -narrowing_locks_save (void) +labeled_restrictions_save (void) { Lisp_Object buf = Fcurrent_buffer (); - Lisp_Object locks = assq_no_quit (buf, narrowing_locks); - if (!NILP (locks)) - locks = XCAR (XCDR (locks)); - return Fcons (buf, Fcopy_sequence (locks)); + Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions); + if (! NILP (restrictions)) + restrictions = XCAR (XCDR (restrictions)); + return Fcons (buf, Fcopy_sequence (restrictions)); } static void -narrowing_locks_restore (Lisp_Object buf_and_saved_locks) +labeled_restrictions_restore (Lisp_Object buf_and_restrictions) { - Lisp_Object buf = XCAR (buf_and_saved_locks); - Lisp_Object saved_locks = XCDR (buf_and_saved_locks); - narrowing_locks_remove (buf); - if (!NILP (saved_locks)) - narrowing_locks_add (buf, saved_locks); + Lisp_Object buf = XCAR (buf_and_restrictions); + Lisp_Object restrictions = XCDR (buf_and_restrictions); + labeled_restrictions_remove (buf); + if (! NILP (restrictions)) + labeled_restrictions_add (buf, restrictions); } static void -unwind_narrow_to_region_locked (Lisp_Object tag) +unwind_labeled_narrow_to_region (Lisp_Object label) { - Finternal__unlock_narrowing (tag); + Finternal__unlabel_restriction (label); Fwiden (); } -/* Narrow current_buffer to BEGV-ZV with a narrowing locked with TAG. */ +/* Narrow current_buffer to BEGV-ZV with a restriction labeled with + LABEL. */ void -narrow_to_region_locked (Lisp_Object begv, Lisp_Object zv, Lisp_Object tag) +labeled_narrow_to_region (Lisp_Object begv, Lisp_Object zv, + Lisp_Object label) { Fnarrow_to_region (begv, zv); - Finternal__lock_narrowing (tag); + Finternal__label_restriction (label); record_unwind_protect (restore_point_unwind, Fpoint_marker ()); - record_unwind_protect (unwind_narrow_to_region_locked, tag); + record_unwind_protect (unwind_labeled_narrow_to_region, label); } DEFUN ("widen", Fwiden, Swiden, 0, 0, "", @@ -2842,11 +2864,11 @@ To gain access to other portions of the buffer, use `without-restriction' with the same label. */) (void) { - Fset (Qoutermost_narrowing, Qnil); + Fset (Qoutermost_restriction, Qnil); Lisp_Object buf = Fcurrent_buffer (); - Lisp_Object tag = narrowing_lock_peek_tag (buf); + Lisp_Object label = labeled_restrictions_peek_label (buf); - if (NILP (tag)) + if (NILP (label)) { if (BEG != BEGV || Z != ZV) current_buffer->clip_changed = 1; @@ -2856,19 +2878,21 @@ To gain access to other portions of the buffer, use } else { - struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, false); - struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, false); + struct Lisp_Marker *begv + = labeled_restrictions_get_bound (buf, true, false); + struct Lisp_Marker *zv + = labeled_restrictions_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_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 + /* If the only remaining bounds in labeled_restrictions 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); + labeled restriction is in effect in current_buffer anymore: + remove it from the labeled_restrictions alist. */ + if (EQ (label, Qoutermost_restriction)) + labeled_restrictions_pop (buf); } /* Changing the buffer bounds invalidates any recorded current column. */ invalidate_current_column (); @@ -2905,13 +2929,15 @@ argument. To gain access to other portions of the buffer, use args_out_of_range (start, end); Lisp_Object buf = Fcurrent_buffer (); - if (! NILP (narrowing_lock_peek_tag (buf))) + if (! NILP (labeled_restrictions_peek_label (buf))) { - struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, false); - struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, false); + /* Limit the start and end positions to those of the innermost + labeled restriction. */ + struct Lisp_Marker *begv + = labeled_restrictions_get_bound (buf, true, false); + struct Lisp_Marker *zv + = labeled_restrictions_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; @@ -2919,11 +2945,11 @@ argument. To gain access to other portions of the buffer, use } /* Record the accessible range of the buffer when narrow-to-region - is called, that is, before applying the narrowing. It is used - only by internal--lock-narrowing. */ - Fset (Qoutermost_narrowing, list3 (Qoutermost_narrowing, - Fpoint_min_marker (), - Fpoint_max_marker ())); + is called, that is, before applying the narrowing. That + information is used only by internal--label-restriction. */ + Fset (Qoutermost_restriction, list3 (Qoutermost_restriction, + Fpoint_min_marker (), + Fpoint_max_marker ())); if (BEGV != s || ZV != e) current_buffer->clip_changed = 1; @@ -2940,38 +2966,38 @@ argument. To gain access to other portions of the buffer, use return Qnil; } -DEFUN ("internal--lock-narrowing", Finternal__lock_narrowing, - Sinternal__lock_narrowing, 1, 1, 0, - doc: /* Lock the current narrowing with LABEL. +DEFUN ("internal--label-restriction", Finternal__label_restriction, + Sinternal__label_restriction, 1, 1, 0, + doc: /* Label the current restriction with LABEL. This is an internal function used by `with-restriction'. */) - (Lisp_Object tag) + (Lisp_Object label) { Lisp_Object buf = Fcurrent_buffer (); - Lisp_Object outermost_narrowing - = buffer_local_value (Qoutermost_narrowing, buf); - /* If internal--lock-narrowing is ever called without being preceded - by narrow-to-region, do nothing. */ - if (NILP (outermost_narrowing)) + Lisp_Object outermost_restriction + = buffer_local_value (Qoutermost_restriction, buf); + /* If internal--label-restriction is ever called without being + preceded by narrow-to-region, do nothing. */ + if (NILP (outermost_restriction)) 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 ())); + if (NILP (labeled_restrictions_peek_label (buf))) + labeled_restrictions_push (buf, outermost_restriction); + labeled_restrictions_push (buf, list3 (label, + Fpoint_min_marker (), + Fpoint_max_marker ())); return Qnil; } -DEFUN ("internal--unlock-narrowing", Finternal__unlock_narrowing, - Sinternal__unlock_narrowing, 1, 1, 0, - doc: /* Unlock a narrowing locked with LABEL. +DEFUN ("internal--unlabel-restriction", Finternal__unlabel_restriction, + Sinternal__unlabel_restriction, 1, 1, 0, + doc: /* If the current restriction is labeled with LABEL, remove its label. This is an internal function used by `without-restriction'. */) - (Lisp_Object tag) + (Lisp_Object label) { Lisp_Object buf = Fcurrent_buffer (); - if (EQ (narrowing_lock_peek_tag (buf), tag)) - narrowing_lock_pop (buf); + if (EQ (labeled_restrictions_peek_label (buf), label)) + labeled_restrictions_pop (buf); return Qnil; } @@ -3071,15 +3097,15 @@ save_restriction_restore_1 (Lisp_Object data) Lisp_Object save_restriction_save (void) { - Lisp_Object restr = save_restriction_save_1 (); - Lisp_Object locks = narrowing_locks_save (); - return Fcons (restr, locks); + Lisp_Object restriction = save_restriction_save_1 (); + Lisp_Object labeled_restrictions = labeled_restrictions_save (); + return Fcons (restriction, labeled_restrictions); } void save_restriction_restore (Lisp_Object data) { - narrowing_locks_restore (XCDR (data)); + labeled_restrictions_restore (XCDR (data)); save_restriction_restore_1 (XCAR (data)); } @@ -4748,7 +4774,7 @@ syms_of_editfns (void) DEFSYM (Qwall, "wall"); DEFSYM (Qpropertize, "propertize"); - staticpro (&narrowing_locks); + staticpro (&labeled_restrictions); DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion, doc: /* Non-nil means text motion commands don't notice fields. */); @@ -4809,12 +4835,12 @@ This variable is experimental; email 32252@debbugs.gnu.org if you need it to be non-nil. */); binary_as_unsigned = false; - DEFVAR_LISP ("outermost-narrowing", Voutermost_narrowing, + DEFVAR_LISP ("outermost-restriction", Voutermost_restriction, 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); + Voutermost_restriction = Qnil; + Fmake_variable_buffer_local (Qoutermost_restriction); + DEFSYM (Qoutermost_restriction, "outermost-restriction"); + Funintern (Qoutermost_restriction, Qnil); defsubr (&Spropertize); defsubr (&Schar_equal); @@ -4907,8 +4933,8 @@ it to be non-nil. */); defsubr (&Sdelete_and_extract_region); defsubr (&Swiden); defsubr (&Snarrow_to_region); - defsubr (&Sinternal__lock_narrowing); - defsubr (&Sinternal__unlock_narrowing); + defsubr (&Sinternal__label_restriction); + defsubr (&Sinternal__unlabel_restriction); defsubr (&Ssave_restriction); defsubr (&Stranspose_regions); } diff --git a/src/fileio.c b/src/fileio.c index f00c389a520..b50b3c6b935 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5269,6 +5269,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, } record_unwind_protect (save_restriction_restore, save_restriction_save ()); + labeled_restrictions_remove_in_current_buffer (); /* Special kludge to simplify auto-saving. */ if (NILP (start)) diff --git a/src/indent.c b/src/indent.c index 08d2bf5ea28..aef394dab88 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2065,6 +2065,7 @@ line_number_display_width (struct window *w, int *width, int *pixel_width) { record_unwind_protect (save_restriction_restore, save_restriction_save ()); + labeled_restrictions_remove_in_current_buffer (); Fwiden (); saved_restriction = true; } diff --git a/src/keyboard.c b/src/keyboard.c index f7aa496bb81..b1ccf4acde4 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -318,6 +318,8 @@ static Lisp_Object command_loop (void); static void echo_now (void); static ptrdiff_t echo_length (void); +static void safe_run_hooks_maybe_narrowed (Lisp_Object, struct window *); + /* Incremented whenever a timer is run. */ unsigned timers_run; @@ -1909,7 +1911,7 @@ safe_run_hooks (Lisp_Object hook) unbind_to (count, Qnil); } -void +static void safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct window *w) { specpdl_ref count = SPECPDL_INDEX (); @@ -1919,11 +1921,11 @@ safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct window *w) if (current_buffer->long_line_optimizations_p && long_line_optimizations_region_size > 0) { - ptrdiff_t begv = get_locked_narrowing_begv (PT); - ptrdiff_t zv = get_locked_narrowing_zv (PT); + ptrdiff_t begv = get_large_narrowing_begv (PT); + ptrdiff_t zv = get_large_narrowing_zv (PT); if (begv != BEG || zv != Z) - narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv), - Qlong_line_optimizations_in_command_hooks); + labeled_narrow_to_region (make_fixnum (begv), make_fixnum (zv), + Qlong_line_optimizations_in_command_hooks); } run_hook_with_args (2, ((Lisp_Object []) {hook, hook}), diff --git a/src/lisp.h b/src/lisp.h index 1276285e2f2..9c02d975a74 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4687,8 +4687,9 @@ 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 void narrow_to_region_locked (Lisp_Object, Lisp_Object, Lisp_Object); -extern void reset_outermost_narrowings (void); +extern void labeled_narrow_to_region (Lisp_Object, Lisp_Object, Lisp_Object); +extern void reset_outermost_restrictions (void); +extern void labeled_restrictions_remove_in_current_buffer (void); extern void init_editfns (void); extern void syms_of_editfns (void); @@ -4857,7 +4858,6 @@ extern bool detect_input_pending (void); extern bool detect_input_pending_ignore_squeezables (void); extern bool detect_input_pending_run_timers (bool); extern void safe_run_hooks (Lisp_Object); -extern void safe_run_hooks_maybe_narrowed (Lisp_Object, struct window *); extern void safe_run_hooks_2 (Lisp_Object, Lisp_Object, Lisp_Object); extern void cmd_error_internal (Lisp_Object, const char *); extern Lisp_Object command_loop_2 (Lisp_Object); diff --git a/src/lread.c b/src/lread.c index d0dc85f51c8..342d367d985 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2255,6 +2255,7 @@ readevalloop (Lisp_Object readcharfun, record_unwind_protect_excursion (); /* Save ZV in it. */ record_unwind_protect (save_restriction_restore, save_restriction_save ()); + labeled_restrictions_remove_in_current_buffer (); /* Those get unbound after we read one expression. */ /* Set point and ZV around stuff to be read. */ diff --git a/src/xdisp.c b/src/xdisp.c index 0b190529404..30a32896aba 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3482,7 +3482,7 @@ init_iterator (struct it *it, struct window *w, /* This is set only when long_line_optimizations_p is non-zero for the current buffer. */ - it->narrowed_begv = 0; + it->medium_narrowing_begv = 0; /* Compute faces etc. */ reseat (it, it->current.pos, true); @@ -3491,17 +3491,104 @@ init_iterator (struct it *it, struct window *w, CHECK_IT (it); } -/* Compute a suitable alternate value for BEGV and ZV that may be used - temporarily to optimize display if the buffer in window W contains - long lines. */ +/* How Emacs deals with long lines. + + (1) When a buffer is about to be (re)displayed, 'redisplay_window' + detects, with a heuristic, whether it contains long lines. + + This happens in 'redisplay_window' because it is only displaying + buffers with long lines that is problematic. In other words, none + of the optimizations described below is ever used in buffers that + are never displayed. + + This happens with a heuristic, which checks whether a buffer + contains long lines, each time its contents have changed "enough" + between two redisplay cycles, because a buffer without long lines + can become a buffer with long lines at any time, for example after + a yank command, or after a replace command, or while the output of + an external process is inserted in a buffer. + + When Emacs has detected that a buffer contains long lines, the + buffer-local variable 'long_line_optimizations_p' (in 'struct + buffer') is set, and Emacs does not try to detect whether the + buffer does or does not contain long lines anymore. + + What a long line is depends on the variable 'long-line-threshold', + whose default value is 50000 (characters). + + (2) When a buffer with long lines is (re)displayed, the amount of + data that the display routines consider is, in a few well-chosen + places, limited with a temporary restriction, whose bounds are + calculated with the functions below. + + (2.1) 'get_small_narrowing_begv' is used to create a restriction + which starts a few hundred characters before point. The exact + number of characters depends on the width of the window in which + the buffer is displayed. + + There is no corresponding 'get_small_narrowing_zv' function, + because it is not necessary to set the end limit of that + restriction. + + This restriction is used in four places, namely: + 'back_to_previous_line_start' and 'move_it_vertically_backward' + (with the 'SET_WITH_NARROWED_BEGV' macro), and in + 'composition_compute_stop_pos' and 'find_automatic_composition' (in + a conditional statement depending on 'long_line_optimizations_p'). + + (2.2) 'get_medium_narrowing_begv' is used to create a restriction + which starts a few thousand characters before point. The exact + number of characters depends on the size (width and height) of the + window in which the buffer is displayed. For performance reasons, + the return value of that function is cached in 'struct it', in the + 'medium_narrowing_begv' field. + + The corresponding function 'get_medium_narrowing_zv' (and + 'medium_narrowing_zv' field in 'struct it') is not used to set the + end limit of a the restriction, which is again unnecessary, but to + determine, in 'reseat', whether the iterator has moved far enough + from its original position, and whether the start position of the + restriction must be computed anew. + + This restriction is used in a single place: + 'get_visually_first_element', with the 'SET_WITH_NARROWED_BEGV' + macro. + + (2.3) 'get_large_narrowing_begv' and 'get_large_narrowing_zv' are + used to create a restriction which starts a few hundred thousand + characters before point and ends a few hundred thousand characters + after point. The size of that restriction depends on the variable + 'long-line-optimizations-region-size', whose default value is + 500000 (characters); it can be adjusted by a few hundred characters + depending on 'long-line-optimizations-bol-search-limit', whose + default value is 128 (characters). + + For performance reasons again, the return values of these functions + are stored in the 'large_narrowing_begv' and 'large_narrowing_zv' + fields in 'struct it'. + + The restriction defined by these values is used around three + low-level hooks: around 'fontification-functions', in + 'handle_fontified_prop', and around 'pre-command-hook' and + 'post-command-hook', in 'safe_run_hooks_maybe_narrowed', which is + called in 'command_loop_1'. These restrictions are set around + these hooks with 'labeled_narrow_to_region'; the restrictions are + labeled, and cannot be removed with a call to 'widen', but can be + removed with 'without-restriction' with a :label argument. +*/ static int get_narrowed_width (struct window *w) { /* In a character-only terminal, only one font size is used, so we can use a smaller factor. */ - int fact = EQ (Fterminal_live_p (Qnil), Qt) ? 2 : 3; - int width = window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS); + int fact = FRAME_WINDOW_P (XFRAME (w->frame)) ? 3 : 2; + /* If the window has no fringes (in a character-only terminal or in + a GUI frame without fringes), subtract 1 from the width for the + '\' line wrapping character. */ + int width = window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS) + - ((WINDOW_RIGHT_FRINGE_WIDTH (w) == 0 + || WINDOW_LEFT_FRINGE_WIDTH (w) == 0) ? 1 : 0); return fact * max (1, width); } @@ -3512,29 +3599,57 @@ get_narrowed_len (struct window *w) return get_narrowed_width (w) * max (1, height); } -ptrdiff_t -get_narrowed_begv (struct window *w, ptrdiff_t pos) +static ptrdiff_t +get_medium_narrowing_begv (struct window *w, ptrdiff_t pos) { int len = get_narrowed_len (w); return max ((pos / len - 1) * len, BEGV); } -ptrdiff_t -get_narrowed_zv (struct window *w, ptrdiff_t pos) +static ptrdiff_t +get_medium_narrowing_zv (struct window *w, ptrdiff_t pos) { int len = get_narrowed_len (w); return min ((pos / len + 1) * len, ZV); } +static ptrdiff_t +get_nearby_bol_pos (ptrdiff_t pos) +{ + ptrdiff_t start, pos_bytepos, cur, next, found, bol = BEGV - 1; + int dist; + for (dist = 500; dist <= 500000; dist *= 10) + { + pos_bytepos = pos == BEGV ? BEGV_BYTE : CHAR_TO_BYTE (pos); + start = pos - dist < BEGV ? BEGV : pos - dist; + for (cur = start; cur < pos; cur = next) + { + next = find_newline1 (cur, CHAR_TO_BYTE (cur), + pos, pos_bytepos, + 1, &found, NULL, false); + if (found) + bol = next; + else + break; + } + if (bol >= BEGV || start == BEGV) + return bol; + else + pos = pos - dist < BEGV ? BEGV : pos - dist; + } + return bol; +} + ptrdiff_t -get_closer_narrowed_begv (struct window *w, ptrdiff_t pos) +get_small_narrowing_begv (struct window *w, ptrdiff_t pos) { int len = get_narrowed_width (w); - return max ((pos / len - 1) * len, BEGV); + ptrdiff_t bol_pos = max (get_nearby_bol_pos (pos), BEGV); + return max (bol_pos + ((pos - bol_pos) / len - 1) * len, BEGV); } ptrdiff_t -get_locked_narrowing_begv (ptrdiff_t pos) +get_large_narrowing_begv (ptrdiff_t pos) { if (long_line_optimizations_region_size <= 0) return BEGV; @@ -3552,7 +3667,7 @@ get_locked_narrowing_begv (ptrdiff_t pos) } ptrdiff_t -get_locked_narrowing_zv (ptrdiff_t pos) +get_large_narrowing_zv (ptrdiff_t pos) { if (long_line_optimizations_region_size <= 0) return ZV; @@ -3571,7 +3686,7 @@ unwind_narrowed_begv (Lisp_Object point_min) #define SET_WITH_NARROWED_BEGV(IT,DST,EXPR,BV) \ do { \ - if (IT->narrowed_begv) \ + if (IT->medium_narrowing_begv) \ { \ specpdl_ref count = SPECPDL_INDEX (); \ record_unwind_protect (unwind_narrowed_begv, Fpoint_min ()); \ @@ -4396,17 +4511,17 @@ handle_fontified_prop (struct it *it) if (current_buffer->long_line_optimizations_p && long_line_optimizations_region_size > 0) { - ptrdiff_t begv = it->locked_narrowing_begv; - ptrdiff_t zv = it->locked_narrowing_zv; + ptrdiff_t begv = it->large_narrowing_begv; + ptrdiff_t zv = it->large_narrowing_zv; ptrdiff_t charpos = IT_CHARPOS (*it); if (charpos < begv || charpos > zv) { - begv = get_locked_narrowing_begv (charpos); - zv = get_locked_narrowing_zv (charpos); + begv = get_large_narrowing_begv (charpos); + zv = get_large_narrowing_zv (charpos); } if (begv != BEG || zv != Z) - narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv), - Qlong_line_optimizations_in_fontification_functions); + labeled_narrow_to_region (make_fixnum (begv), make_fixnum (zv), + Qlong_line_optimizations_in_fontification_functions); } /* Don't allow Lisp that runs from 'fontification-functions' @@ -7041,7 +7156,7 @@ back_to_previous_line_start (struct it *it) dec_both (&cp, &bp); SET_WITH_NARROWED_BEGV (it, IT_CHARPOS (*it), find_newline_no_quit (cp, bp, -1, &IT_BYTEPOS (*it)), - get_closer_narrowed_begv (it->w, IT_CHARPOS (*it))); + get_small_narrowing_begv (it->w, IT_CHARPOS (*it))); } /* Find in the current buffer the first display or overlay string @@ -7345,7 +7460,7 @@ back_to_previous_visible_line_start (struct it *it) it->continuation_lines_width = 0; eassert (IT_CHARPOS (*it) >= BEGV); - eassert (it->narrowed_begv > 0 /* long-line optimizations: all bets off */ + eassert (it->medium_narrowing_begv > 0 /* long-line optimizations: all bets off */ || IT_CHARPOS (*it) == BEGV || FETCH_BYTE (IT_BYTEPOS (*it) - 1) == '\n'); CHECK_IT (it); @@ -7463,24 +7578,29 @@ reseat (struct it *it, struct text_pos pos, bool force_p) if (current_buffer->long_line_optimizations_p) { - if (!it->narrowed_begv) + if (!it->medium_narrowing_begv) { - 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)); + it->medium_narrowing_begv + = get_medium_narrowing_begv (it->w, window_point (it->w)); + it->medium_narrowing_zv + = get_medium_narrowing_zv (it->w, window_point (it->w)); + it->large_narrowing_begv + = get_large_narrowing_begv (window_point (it->w)); + it->large_narrowing_zv + = get_large_narrowing_zv (window_point (it->w)); } - else if ((pos.charpos < it->narrowed_begv || pos.charpos > it->narrowed_zv) + else if ((pos.charpos < it->medium_narrowing_begv + || pos.charpos > it->medium_narrowing_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)); + it->medium_narrowing_begv + = get_medium_narrowing_begv (it->w, pos.charpos); + it->medium_narrowing_zv + = get_medium_narrowing_zv (it->w, pos.charpos); + it->large_narrowing_begv + = get_large_narrowing_begv (window_point (it->w)); + it->large_narrowing_zv + = get_large_narrowing_zv (window_point (it->w)); } } @@ -8789,7 +8909,7 @@ get_visually_first_element (struct it *it) SET_WITH_NARROWED_BEGV (it, bob, string_p ? 0 : IT_CHARPOS (*it) < BEGV ? obegv : BEGV, - it->narrowed_begv); + it->medium_narrowing_begv); if (STRINGP (it->string)) { @@ -8833,7 +8953,7 @@ get_visually_first_element (struct it *it) find_newline_no_quit (IT_CHARPOS (*it), IT_BYTEPOS (*it), -1, &it->bidi_it.bytepos), - it->narrowed_begv); + it->medium_narrowing_begv); bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true); do { @@ -10722,7 +10842,7 @@ move_it_vertically_backward (struct it *it, int dy) dec_both (&cp, &bp); SET_WITH_NARROWED_BEGV (it, cp, find_newline_no_quit (cp, bp, -1, NULL), - get_closer_narrowed_begv (it->w, IT_CHARPOS (*it))); + get_small_narrowing_begv (it->w, IT_CHARPOS (*it))); move_it_to (it, cp, -1, -1, -1, MOVE_TO_POS); } bidi_unshelve_cache (it3data, true); @@ -16394,7 +16514,7 @@ redisplay_internal (void) FOR_EACH_FRAME (tail, frame) XFRAME (frame)->already_hscrolled_p = false; - reset_outermost_narrowings (); + reset_outermost_restrictions (); retry: /* Remember the currently selected window. */ @@ -24112,6 +24232,7 @@ display_count_lines_logically (ptrdiff_t start_byte, ptrdiff_t limit_byte, ptrdiff_t val; specpdl_ref pdl_count = SPECPDL_INDEX (); record_unwind_protect (save_restriction_restore, save_restriction_save ()); + labeled_restrictions_remove_in_current_buffer (); Fwiden (); val = display_count_lines (start_byte, limit_byte, count, byte_pos_ptr); unbind_to (pdl_count, Qnil);