From 85ed1c9ca6b786763740766d77b1f806c2f301a1 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Tue, 28 Mar 2023 23:06:54 +0000 Subject: [PATCH 01/11] Code cleanup for long line optimizations This commit does not change any code, it merely renames functions and clarifies the documentation, to make the code hopefully easier to grasp. * src/dispextern.h (struct it): Rename the 'narrowed_begv', 'narrowed_zv', 'locked_narrowing_begv', 'locked_narrowing_zv' to 'medium_narrowing_begv', 'medium_narrowing_zv', 'large_narrowing_begv', 'large_narrowing_zv'. Clarify the comments. Update the prototypes of the functions renamed in xdisp.c. * src/lisp.h: Update the prototypes of the functions renamed in editfns.c. Remove the prototype of 'safe_run_hooks_maybe_narrowed', which is used only in keyboard.c. * src/xdisp.c (get_small_narrowing_begv): Renamed from 'get_closer_narrowed_begv'. (get_medium_narrowing_begv): Renamed from 'get_narrowed_begv'. (get_medium_narrowing_zv): Renamed from 'get_narrowed_zv'. (get_large_narrowing_begv): Renamed from 'get_locked_narrowing_begv'. (get_large_narrowing_zv): Renamed from 'get_locked_narrowing_zv'. (SET_WITH_NARROWED_BEGV): Use the new field names. (handle_fontified_prop): Use the new function and new field names. (back_to_previous_line_start): Use the new field name. (back_to_previous_visible_line_start): Use the new field name. (reseat): Use the new function and new field names. (get_visually_first_element): Use the new field name. (move_it_vertically_backward): Use the new function name. (redisplay_internal): Use the new function name. Also add a large comment to explain how Emacs deals with long lines. * src/keyboard.c: (safe_run_hooks_maybe_narrowed): Use the new function names from xdisp.c and editfns.c. Make the function static, and add a prototype. * src/editfns.c: (labeled_restrictions): Renamed from 'narrowing_locks'. (labeled_restrictions_add): Renamed from 'narrowing_locks_add'. (labeled_restrictions_remove): Renamed from 'narrowing_locks_remove'. (labeled_restrictions_get_bound): Renamed from 'narrowing_lock_get_bound'. (labeled_restrictions_peek_label): Renamed from 'narrowing_lock_peek_tag'. (labeled_restrictions_push): Renamed from 'narrowing_lock_push'. (labeled_restrictions_pop): Renamed from 'narrowing_lock_pop'. (unwind_reset_outermost_restriction): Renamed from 'unwind_reset_outermost_narrowing'. (reset_outermost_restrictions): Renamed from 'reset_outermost_narrowings'. (labeled_restrictions_save): Renamed from 'narrowing_locks_save'. (labeled_restrictions_restore): Renamed from 'narrowing_locks_restore'. (unwind_labeled_narrow_to_region): Renamed from 'unwind_narrow_to_region_locked'. (labeled_narrow_to_region): Renamed from 'narrow_to_region_locked'. (Finternal__label_restriction): Renamed from 'Finternal__lock_narrowing'. (Finternal__unlabel_restriction): Renamed from 'Finternal__unlock_narrowing'. (Fwiden): Use the new function names. (Fnarrow_to_region): Use the new function names. (save_restriction_save): Use the new function names. (syms_of_editfns): Use the new function names. : Renamed from 'outermost-narrowing'. * lisp/subr.el (internal--with-restriction): Use the new internal function name. (internal--without-restriction): Use the new internal function name. * src/composite.c (composition_compute_stop_pos): (find_automatic_composition): Use the new function name. * doc/lispref/positions.texi (Narrowing): Add index entry. --- doc/lispref/positions.texi | 1 + lisp/subr.el | 4 +- src/composite.c | 4 +- src/dispextern.h | 37 +++-- src/editfns.c | 299 ++++++++++++++++++++----------------- src/keyboard.c | 12 +- src/lisp.h | 5 +- src/xdisp.c | 159 +++++++++++++++----- 8 files changed, 314 insertions(+), 207 deletions(-) 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/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..957e09f9ecc 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 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 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 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,11 @@ 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_medium_narrowing_begv (struct window *, ptrdiff_t); +ptrdiff_t get_medium_narrowing_zv (struct window *, 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..ff711ee2a09 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2653,182 +2653,197 @@ 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; +/* 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 LOCKS in the narrowing_locks alist. */ +/* 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))))); } 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 +2857,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 +2871,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 +2922,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 +2938,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 +2959,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 +3090,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 +4767,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 +4828,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 +4926,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/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..a3d06c3b45d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4687,8 +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 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 init_editfns (void); extern void syms_of_editfns (void); @@ -4857,7 +4857,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/xdisp.c b/src/xdisp.c index 0b190529404..fa411e6e8dc 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,9 +3491,91 @@ 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) @@ -3513,28 +3595,28 @@ get_narrowed_len (struct window *w) } ptrdiff_t -get_narrowed_begv (struct window *w, ptrdiff_t pos) +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) +get_medium_narrowing_zv (struct window *w, ptrdiff_t pos) { int len = get_narrowed_len (w); return min ((pos / len + 1) * len, ZV); } 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 -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 +3634,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 +3653,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 +4478,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 +7123,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 +7427,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 +7545,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 +8876,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 +8920,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 +10809,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 +16481,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. */ From 7e26a5c774e7c71782d89abe1d4be125d8422a4b Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Tue, 28 Mar 2023 23:06:55 +0000 Subject: [PATCH 02/11] Remove labeled restrictions before calling Fwiden * src/editfns.c (labeled_restrictions_remove_in_current_buffer): New function. * src/lisp.h: Make it externally visible. * src/xdisp.c (display_count_lines_logically): * src/lread.c (readevalloop): * src/indent.c (line_number_display_width): * src/fileio.c (write_region): * src/callproc.c (Fcall_process_region): * src/buffer.c (Ferase_buffer): Use it. --- src/buffer.c | 1 + src/callproc.c | 1 + src/editfns.c | 7 +++++++ src/fileio.c | 1 + src/indent.c | 1 + src/lisp.h | 1 + src/lread.c | 1 + src/xdisp.c | 1 + 8 files changed, 14 insertions(+) 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/editfns.c b/src/editfns.c index ff711ee2a09..4c5b691eb50 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2756,6 +2756,13 @@ labeled_restrictions_pop (Lisp_Object buf) 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_restriction (Lisp_Object buf) { 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/lisp.h b/src/lisp.h index a3d06c3b45d..9c02d975a74 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4689,6 +4689,7 @@ extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool); 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); 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 fa411e6e8dc..c752f6712ab 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -24199,6 +24199,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); From afc2c6c13cb2ebb50a6c31fca5552f9b98b4af95 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Tue, 28 Mar 2023 23:06:56 +0000 Subject: [PATCH 03/11] Improve accuracy of cursor motion commands in long lines * src/xdisp.c (get_nearby_bol_pos): New function. (get_small_narrowing_begv): Use it. This makes cursor motion commands much more accurate in the first 500K characters of each long line. --- src/xdisp.c | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index c752f6712ab..454cbbbf6d5 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3608,11 +3608,30 @@ get_medium_narrowing_zv (struct window *w, ptrdiff_t pos) 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 = 0; + start = pos - 500000 < BEGV ? BEGV : pos - 500000; + pos_bytepos = CHAR_TO_BYTE (pos); + 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; + } + return bol; +} + ptrdiff_t get_small_narrowing_begv (struct window *w, ptrdiff_t pos) { int len = get_narrowed_width (w); - return max ((pos / len - 1) * len, BEGV); + int bol_pos = get_nearby_bol_pos (pos); + return max (bol_pos + ((pos - bol_pos) / len - 1) * len, BEGV); } ptrdiff_t @@ -3653,7 +3672,7 @@ unwind_narrowed_begv (Lisp_Object point_min) #define SET_WITH_NARROWED_BEGV(IT,DST,EXPR,BV) \ do { \ - if (IT->medium_narrowing_begv) \ + if (IT->medium_narrowing_begv) \ { \ specpdl_ref count = SPECPDL_INDEX (); \ record_unwind_protect (unwind_narrowed_begv, Fpoint_min ()); \ From 974e4f3333311b557754e2fdbaa75b0c1077fc61 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Tue, 28 Mar 2023 23:06:57 +0000 Subject: [PATCH 04/11] Make get_medium_narrowing_begv/zv static * src/xdisp.c (get_medium_narrowing_begv): (get_medium_narrowing_zv): Make these two functions static, they are only used in xdisp.c. * src/dispextern.h: Remove the prototypes. --- src/dispextern.h | 2 -- src/xdisp.c | 4 ++-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/dispextern.h b/src/dispextern.h index 957e09f9ecc..ece128949f5 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3409,8 +3409,6 @@ 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_medium_narrowing_begv (struct window *, ptrdiff_t); -ptrdiff_t get_medium_narrowing_zv (struct window *, 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); diff --git a/src/xdisp.c b/src/xdisp.c index 454cbbbf6d5..a4d02529563 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3594,14 +3594,14 @@ get_narrowed_len (struct window *w) return get_narrowed_width (w) * max (1, height); } -ptrdiff_t +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 +static ptrdiff_t get_medium_narrowing_zv (struct window *w, ptrdiff_t pos) { int len = get_narrowed_len (w); From 2093e010dc14148455480d607b2f06ee43b1e6e0 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Wed, 29 Mar 2023 14:47:32 +0000 Subject: [PATCH 05/11] Fix cursor motion in character-only terminals * src/xdisp.c (get_narrowed_width): Subtract 1 from window_body_width to account for the '\' line wrapping indication. --- src/xdisp.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index a4d02529563..880d1b0f1fa 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3580,10 +3580,14 @@ init_iterator (struct it *it, struct window *w, static int get_narrowed_width (struct window *w) { + bool term = EQ (Fterminal_live_p (Qnil), Qt); /* 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 = term ? 2 : 3; + /* In a character-only terminal, subtract 1 from the width for the + '\' line wrapping character. */ + int width = window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS) + - (term ? 1 : 0); return fact * max (1, width); } From dce08cf05ccd2551d2e304e868605102233f8c40 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Sat, 1 Apr 2023 14:14:45 +0000 Subject: [PATCH 06/11] Improve and fix last changes * src/xdisp.c (get_narrowed_width): Use WINDOW_RIGHT_FRINGE_WIDTH, which works both for character-only terminals and for GUI frames without fringes. (get_nearby_bol_pos): Instead of searching for BOL in [pos-500000..pos], gradually extend the region, starting with [pos-500..pos]. This is much faster in buffers with some long lines in the middle of lots of short lines. --- src/xdisp.c | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 880d1b0f1fa..438cbac1274 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3580,14 +3580,14 @@ init_iterator (struct it *it, struct window *w, static int get_narrowed_width (struct window *w) { - bool term = EQ (Fterminal_live_p (Qnil), Qt); /* In a character-only terminal, only one font size is used, so we can use a smaller factor. */ - int fact = term ? 2 : 3; - /* In a character-only terminal, subtract 1 from the width for the + int fact = EQ (Fterminal_live_p (Qnil), Qt) ? 2 : 3; + /* 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) - - (term ? 1 : 0); + - (WINDOW_RIGHT_FRINGE_WIDTH (w) == 0 ? 1 : 0); return fact * max (1, width); } @@ -3616,16 +3616,25 @@ static ptrdiff_t get_nearby_bol_pos (ptrdiff_t pos) { ptrdiff_t start, pos_bytepos, cur, next, found, bol = 0; - start = pos - 500000 < BEGV ? BEGV : pos - 500000; - pos_bytepos = CHAR_TO_BYTE (pos); - for (cur = start; cur < pos; cur = next) + int dist; + for (dist = 500; dist <= 500000; dist *= 10) { - next = find_newline1 (cur, CHAR_TO_BYTE (cur), pos, pos_bytepos, - 1, &found, NULL, false); - if (found) - bol = next; + 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) + return bol; else - break; + pos = pos - dist < BEGV ? BEGV : pos - dist; } return bol; } From 097c5ee8f55580ef2f7e68a5bf91a3ccf07dbeb3 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Sat, 1 Apr 2023 16:54:18 +0000 Subject: [PATCH 07/11] Two further fixes to last changes * src/xdisp.c (get_narrowed_width): Use FRAME_WINDOW_P instead of Fterminal_live_p. Also take WINDOW_LEFT_FRINGE_WIDTH into account. --- src/xdisp.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 438cbac1274..62dc3438117 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3582,12 +3582,13 @@ 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 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 ? 1 : 0); + - ((WINDOW_RIGHT_FRINGE_WIDTH (w) == 0 + || WINDOW_LEFT_FRINGE_WIDTH (w) == 0) ? 1 : 0); return fact * max (1, width); } From 0cc8d6826ad2717a3fd21240d0c97232536cab93 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Sat, 1 Apr 2023 21:13:08 +0000 Subject: [PATCH 08/11] Three final fixes to last changes * src/xdisp.c (get_nearby_bol_pos): Initialize 'bol' to BEGV - 1 instead of 0 (which fixes cursor motion commands in the presence of a narrowing), adapt the return condition accordingly, and do not restart the loop when BEGV has been reached. (get_small_narrowing_begv): Use correct type. --- src/xdisp.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 62dc3438117..940b8dc820e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3616,7 +3616,7 @@ get_medium_narrowing_zv (struct window *w, ptrdiff_t pos) static ptrdiff_t get_nearby_bol_pos (ptrdiff_t pos) { - ptrdiff_t start, pos_bytepos, cur, next, found, bol = 0; + ptrdiff_t start, pos_bytepos, cur, next, found, bol = BEGV - 1; int dist; for (dist = 500; dist <= 500000; dist *= 10) { @@ -3632,7 +3632,7 @@ get_nearby_bol_pos (ptrdiff_t pos) else break; } - if (bol) + if (bol >= BEGV || start == BEGV) return bol; else pos = pos - dist < BEGV ? BEGV : pos - dist; @@ -3644,7 +3644,7 @@ ptrdiff_t get_small_narrowing_begv (struct window *w, ptrdiff_t pos) { int len = get_narrowed_width (w); - int bol_pos = get_nearby_bol_pos (pos); + ptrdiff_t bol_pos = get_nearby_bol_pos (pos); return max (bol_pos + ((pos - bol_pos) / len - 1) * len, BEGV); } From c0b9530862c2f27a23ad058d60171e06de3e9b50 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Sat, 1 Apr 2023 23:06:53 +0000 Subject: [PATCH 09/11] Another final fix to last changes * src/xdisp.c (get_small_narrowing_begv): Refine the value of 'bol_pos'. --- src/xdisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index 940b8dc820e..30a32896aba 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3644,7 +3644,7 @@ ptrdiff_t get_small_narrowing_begv (struct window *w, ptrdiff_t pos) { int len = get_narrowed_width (w); - ptrdiff_t bol_pos = get_nearby_bol_pos (pos); + ptrdiff_t bol_pos = max (get_nearby_bol_pos (pos), BEGV); return max (bol_pos + ((pos - bol_pos) / len - 1) * len, BEGV); } From f0f08eeb05c79e7b7326931357e82e65262c3336 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Fri, 12 May 2023 21:56:28 +0000 Subject: [PATCH 10/11] Fix the return type of 'labeled_restrictions_get_bound' * src/editfns.c: (labeled_restrictions_get_bound): Return a Lisp_Object instead of a pointer to a struct Lisp_Marker. (unwind_reset_outermost_restriction, reset_outermost_restrictions) (Fwiden, Fnarrow_to_region): Adapt to the new return type. --- src/editfns.c | 83 ++++++++++++++++++++++++++------------------------- 1 file changed, 42 insertions(+), 41 deletions(-) diff --git a/src/editfns.c b/src/editfns.c index 4c5b691eb50..d02cce4aef3 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2687,20 +2687,19 @@ labeled_restrictions_remove (Lisp_Object buf) } /* 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 * + labeled_restrictions alist, as a marker, or return nil 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 Lisp_Object labeled_restrictions_get_bound (Lisp_Object buf, bool begv, bool outermost) { if (NILP (Fbuffer_live_p (buf))) - return NULL; + return Qnil; Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions); if (NILP (restrictions)) - return NULL; + return Qnil; restrictions = XCAR (XCDR (restrictions)); Lisp_Object bounds = outermost @@ -2709,7 +2708,7 @@ labeled_restrictions_get_bound (Lisp_Object buf, bool begv, bool outermost) eassert (! NILP (bounds)); Lisp_Object marker = begv ? XCAR (bounds) : XCAR (XCDR (bounds)); eassert (EQ (Fmarker_buffer (marker), buf)); - return XMARKER (marker); + return marker; } /* Retrieve the label of the innermost labeled restriction in BUF. @@ -2766,14 +2765,14 @@ labeled_restrictions_remove_in_current_buffer (void) static void unwind_reset_outermost_restriction (Lisp_Object buf) { - 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) + Lisp_Object begv = labeled_restrictions_get_bound (buf, true, false); + Lisp_Object zv = labeled_restrictions_get_bound (buf, false, false); + if (! NILP (begv) && ! NILP (zv)) { - SET_BUF_BEGV_BOTH (XBUFFER (buf), begv->charpos, begv->bytepos); - SET_BUF_ZV_BOTH (XBUFFER (buf), zv->charpos, zv->bytepos); + SET_BUF_BEGV_BOTH (XBUFFER (buf), + marker_position (begv), marker_byte_position (begv)); + SET_BUF_ZV_BOTH (XBUFFER (buf), + marker_position (zv), marker_byte_position (zv)); } else labeled_restrictions_remove (buf); @@ -2797,14 +2796,14 @@ reset_outermost_restrictions (void) { buf = XCAR (XCAR (val)); eassert (BUFFERP (buf)); - 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) + Lisp_Object begv = labeled_restrictions_get_bound (buf, true, true); + Lisp_Object zv = labeled_restrictions_get_bound (buf, false, true); + if (! NILP (begv) && ! NILP (zv)) { - SET_BUF_BEGV_BOTH (XBUFFER (buf), begv->charpos, begv->bytepos); - SET_BUF_ZV_BOTH (XBUFFER (buf), zv->charpos, zv->bytepos); + SET_BUF_BEGV_BOTH (XBUFFER (buf), + marker_position (begv), marker_byte_position (begv)); + SET_BUF_ZV_BOTH (XBUFFER (buf), + marker_position (zv), marker_byte_position (zv)); record_unwind_protect (unwind_reset_outermost_restriction, buf); } else @@ -2878,15 +2877,17 @@ To gain access to other portions of the buffer, use } else { - 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) + Lisp_Object begv = labeled_restrictions_get_bound (buf, true, false); + Lisp_Object zv = labeled_restrictions_get_bound (buf, false, false); + eassert (! NILP (begv) && ! NILP (zv)); + ptrdiff_t begv_charpos = marker_position (begv); + ptrdiff_t zv_charpos = marker_position (zv); + 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); + SET_BUF_BEGV_BOTH (current_buffer, + begv_charpos, marker_byte_position (begv)); + SET_BUF_ZV_BOTH (current_buffer, + zv_charpos, marker_byte_position (zv)); /* If the only remaining bounds in labeled_restrictions for current_buffer are the bounds that were set by the user, no labeled restriction is in effect in current_buffer anymore: @@ -2933,15 +2934,15 @@ argument. To gain access to other portions of the buffer, use { /* 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); - 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; + Lisp_Object begv = labeled_restrictions_get_bound (buf, true, false); + Lisp_Object zv = labeled_restrictions_get_bound (buf, false, false); + eassert (! NILP (begv) && ! NILP (zv)); + ptrdiff_t begv_charpos = marker_position (begv); + ptrdiff_t zv_charpos = marker_position (zv); + 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 From 1e3a66df459750071a9003a131d7f2c319dbb331 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Fri, 12 May 2023 21:56:31 +0000 Subject: [PATCH 11/11] Add an assertion in, and a commentary for, 'get_nearby_bol_pos' * src/xdisp.c: (get_nearby_bol_pos): Document the function, and add an assertion on its return value. --- src/xdisp.c | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 30a32896aba..6572d14d934 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3545,7 +3545,7 @@ init_iterator (struct it *it, struct window *w, 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 + end limit of 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. @@ -3613,10 +3613,15 @@ get_medium_narrowing_zv (struct window *w, ptrdiff_t pos) return min ((pos / len + 1) * len, ZV); } +/* Find the position of the last BOL before POS, unless it is too far + away. The buffer portion in which the search occurs is gradually + enlarged: [POS-500..POS], [POS-5500..POS-500], + [POS-55500..POS-5500], and finally [POS-555500..POS-55500]. Return + BEGV-1 if no BOL was found in [POS-555500..POS]. */ static ptrdiff_t get_nearby_bol_pos (ptrdiff_t pos) { - ptrdiff_t start, pos_bytepos, cur, next, found, bol = BEGV - 1; + ptrdiff_t start, pos_bytepos, cur, next, found, bol = BEGV - 1, init_pos = pos; int dist; for (dist = 500; dist <= 500000; dist *= 10) { @@ -3633,10 +3638,11 @@ get_nearby_bol_pos (ptrdiff_t pos) break; } if (bol >= BEGV || start == BEGV) - return bol; + break; else pos = pos - dist < BEGV ? BEGV : pos - dist; } + eassert (bol <= init_pos); return bol; }