From 85ed1c9ca6b786763740766d77b1f806c2f301a1 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Tue, 28 Mar 2023 23:06:54 +0000 Subject: [PATCH 01/33] 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/33] 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/33] 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/33] 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/33] 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/33] 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/33] 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/33] 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/33] 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 ef1f4068f6f9d614324db88e6dcc1c2b67362bde Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 11 May 2023 12:54:34 +0300 Subject: [PATCH 10/33] ; * lisp/wid-edit.el (widget-specify-insert): Fix debug spec. (Bug#63437) --- lisp/wid-edit.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 60bd2baa6fb..e51b184f874 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -499,7 +499,7 @@ With CHECK-AFTER non-nil, considers also the content after point, if needed." (defmacro widget-specify-insert (&rest form) "Execute FORM without inheriting any text properties." - (declare (debug body)) + (declare (debug (body))) `(save-restriction (let ((inhibit-read-only t) (inhibit-modification-hooks t)) From b8bcd42cabc8e2d69359402dacd3e51fe75029db Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 11 May 2023 12:59:46 +0300 Subject: [PATCH 11/33] Revert "Don't have nntp-report signal an error" This reverts commit 032969e8c65ba1ccda8466f6c61f20e0c7293ebf. The commit is being reverted because it caused bug#62845. --- lisp/gnus/nntp.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 20c176f2269..3c56f0667b7 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -314,7 +314,9 @@ retried once before actually displaying the error report." (when nntp-record-commands (nntp-record-command "*** CALLED nntp-report ***")) - (nnheader-report 'nntp args))) + (nnheader-report 'nntp args) + + (apply #'error args))) (defsubst nntp-copy-to-buffer (buffer start end) "Copy string from unibyte current buffer to multibyte buffer." From 60d5a015d1fb6f10439c80d3b0733de88c204d6c Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Thu, 11 May 2023 17:47:30 +0200 Subject: [PATCH 12/33] Update to Transient v0.4.0 Or strictly speaking v0.4.0-1-g428576a4.) --- doc/misc/transient.texi | 4 ++-- lisp/transient.el | 11 ++++++++--- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index 33d689cc01b..330fdd1e3a2 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -31,7 +31,7 @@ General Public License for more details. @finalout @titlepage @title Transient User and Developer Manual -@subtitle for version 0.3.7.50 +@subtitle for version 0.4.0 @author Jonas Bernoulli @page @vskip 0pt plus 1filll @@ -74,7 +74,7 @@ that hurdle is Psionic K's interactive tutorial, available at @end quotation @noindent -This manual is for Transient version 0.3.7.50. +This manual is for Transient version 0.4.0. @insertcopying @end ifnottex diff --git a/lisp/transient.el b/lisp/transient.el index 9785e218b19..1d763c4ddeb 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/magit/transient ;; Keywords: extensions -;; Package-Version: 0.3.7.50 +;; Package-Version: 0.4.0 ;; Package-Requires: ((emacs "26.1")) ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -3934,8 +3934,13 @@ search instead." (defun transient-isearch-abort () "Like `isearch-abort' but adapted for `transient'." (interactive) - (condition-case nil (isearch-abort) (quit)) - (transient--isearch-exit)) + (let ((around (lambda (fn) + (condition-case nil (funcall fn) (quit)) + (transient--isearch-exit)))) + (advice-add 'isearch-cancel :around around) + (unwind-protect + (isearch-abort) + (advice-remove 'isearch-cancel around)))) (defun transient--isearch-setup () (select-window transient--window) From 6fa9332e7cdb28c3990f8d1444b02b65791713d6 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 7 May 2023 21:37:01 +0200 Subject: [PATCH 13/33] Ensure that EXTRA-DATA are always written when generating autoloads * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Handle edge-case where no autoloads are found. (Bug#63260) --- lisp/emacs-lisp/loaddefs-gen.el | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 2a46fb7a022..5db9af21508 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -656,7 +656,20 @@ instead of just updating them with the new/changed autoloads." (write-region (point-min) (point-max) loaddefs-file nil 'silent) (byte-compile-info (file-relative-name loaddefs-file (car (ensure-list dir))) - t "GEN"))))))) + t "GEN"))))) + + ;; If processing files without any autoloads, the above loop will + ;; not generate any files. If the function was invoked with + ;; EXTRA-DATA, we want to ensure that even if no autoloads were + ;; found, that at least a file will have been generated containing + ;; the contents of EXTRA-DATA: + (when (and extra-data (not (file-exists-p output-file))) + (with-temp-buffer + (insert (loaddefs-generate--rubric output-file nil t)) + (search-backward "\f") + (insert extra-data) + (ensure-empty-lines 1) + (write-region (point-min) (point-max) output-file nil 'silent))))) (defun loaddefs-generate--print-form (def) "Print DEF in a format that makes sense for version control." From ba2c76fa2bc3aabfda7d1d09cc5148f3f9d8e08e Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 10 May 2023 08:58:34 +0200 Subject: [PATCH 14/33] Ensure that package menu respects 'package-install-upgrade-built-in' * lisp/emacs-lisp/package.el (package-menu--find-upgrades): Check if built-in packages can be upgraded if 'package-install-upgrade-built-in' is non-nil. --- lisp/emacs-lisp/package.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index bbe2b8bb4af..c684840ab7e 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3731,7 +3731,7 @@ corresponding to the newer version." ;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC]) (let ((pkg-desc (car entry)) (status (aref (cadr entry) 2))) - (cond ((member status '("installed" "dependency" "unsigned" "external")) + (cond ((member status '("installed" "dependency" "unsigned" "external" "built-in")) (push pkg-desc installed)) ((member status '("available" "new")) (setq available (package--append-to-alist pkg-desc available)))))) @@ -3742,6 +3742,8 @@ corresponding to the newer version." (and avail-pkg (version-list-< (package-desc-priority-version pkg-desc) (package-desc-priority-version avail-pkg)) + (xor (not package-install-upgrade-built-in) + (package--active-built-in-p pkg-desc)) (push (cons name avail-pkg) upgrades)))) upgrades)) From 09d6070e56ea21a5e9720bc619c439c09e5b2680 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 12 May 2023 15:33:06 +0300 Subject: [PATCH 15/33] ; Improve and update documentation of built-in package upgrades * doc/emacs/package.texi (Package Statuses, Package Menu) (Package Installation): * etc/NEWS: Document the options and caveats of upgrading built-in packages. --- doc/emacs/package.texi | 50 +++++++++++++++++++++++++++++++++++++++--- etc/NEWS | 7 ++++++ 2 files changed, 54 insertions(+), 3 deletions(-) diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index d1766026db2..6722185cb20 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -160,7 +160,13 @@ current line by an @kbd{i} or @kbd{d} command Mark all package with a newer available version for upgrading (@code{package-menu-mark-upgrades}). This places an installation mark on the new available versions, and a deletion mark on the old -installed versions (marked with status @samp{obsolete}). +installed versions (marked with status @samp{obsolete}). By default, +this won't mark built-in packages for which a newer version is +available, but customizing @code{package-install-upgrade-built-in} can +change that. @xref{Package Installation}. If you customize +@code{package-install-upgrade-built-in} to a non-@code{nil} value, be +sure to review all the built-in packages the @kbd{U} command marks, to +avoid updating built-in packages you don't want to overwrite. @item x @kindex x @r{(Package Menu)} @@ -258,7 +264,11 @@ This shows only the packages that have been marked to be installed or deleted. @kindex / u @r{(Package Menu)} @findex package-menu-filter-upgradable Filter package list to show only packages for which there are -available upgrades (@code{package-menu-filter-upgradable}). +available upgrades (@code{package-menu-filter-upgradable}). By +default, this filter excludes the built-in packages for which a newer +version is available, but customizing +@code{package-install-upgrade-built-in} can change that. +@xref{Package Installation}. @item / / @kindex / / @r{(Package Menu)} @@ -286,9 +296,12 @@ the package archive. The package is available for installation, but a newer version is also available. Packages with this status are hidden by default. +@cindex built-in package @item built-in The package is included in Emacs by default. It cannot be deleted -through the package menu, and is not considered for upgrading. +through the package menu, and by default is not considered for +upgrading (but you can change that by customizing +@code{package-install-upgrade-built-in}, @pxref{Package Installation}). @item dependency The package was installed automatically to satisfy a dependency of @@ -339,6 +352,37 @@ if you want to upgrade a package, you can use the @kbd{M-x package-upgrade} command, and if you want to upgrade all the packages, you can use the @kbd{M-x package-upgrade-all} command. +@vindex package-install-upgrade-built-in + By default, @code{package-install} doesn't consider built-in +packages for which new versions are available from the archives. (A +package is built-in if it is included in the Emacs distribution.) In +particular, it will not show built-in packages in the list of +completion candidates when you type at its prompt. But if you invoke +@code{package-install} with a prefix argument, it will also consider +built-in packages that can be upgraded. You can make this behavior +the default by customizing the variable +@code{package-install-upgrade-built-in}: if its value is +non-@code{nil}, @code{package-install} will consider built-in packages +even when invoked without a prefix argument. Note that the +package-menu commands (@pxref{Package Menu}) are also affected by +@code{package-install-upgrade-built-in}. + + By contrast, @code{package-upgrade} and @code{package-upgrade-all} +never consider built-in packages. If you want to use these commands +for upgrading some built-in packages, you need to upgrade each of +those packages, once, either via @kbd{C-u M-x package-install +@key{RET}}, or by customizing @code{package-install-upgrade-built-in} +to a non-@code{nil} value, and then upgrading the package once via the +package menu or by @code{package-install}. + + If you customize @code{package-install-upgrade-built-in} to a +non-@code{nil} value, be very careful when using commands that update +many packages at once, like @code{package-upgrade-all} and @kbd{U} in +the package menu: those might overwrite built-in packages that you +didn't intent to replace with newer versions from the archives. Don't +use these bulk commands if you want to update only a small number of +built-in packages. + @cindex package requirements A package may @dfn{require} certain other packages to be installed, because it relies on functionality provided by them. When Emacs diff --git a/etc/NEWS b/etc/NEWS index 5f5ae1c75a1..a28e060dfdc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1906,6 +1906,13 @@ default, this is disabled; however, if 'package-install' is invoked with a prefix argument, it will act as if this new option were enabled. +In addition, when this option is non-nil, built-in packages for which +a new version is available in archives can be upgraded via the package +menu produced by 'M-x list-packages'. If you do set this option +non-nil, we recommend not to use the 'U' command, but instead to use +'/ u' to show the packages which can be upgraded, and then unmark the +built-in packages which you don't need to overwrite from the archives. + If you customize this option, we recommend you place its non-default setting in your early-init file. From 32b42b333caf490c0fdb159172d08c08af7bff7c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 12 May 2023 17:41:39 +0300 Subject: [PATCH 16/33] ; * etc/NEWS: Fix wording in last change. --- etc/NEWS | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index a28e060dfdc..fa428d9c790 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1910,8 +1910,8 @@ In addition, when this option is non-nil, built-in packages for which a new version is available in archives can be upgraded via the package menu produced by 'M-x list-packages'. If you do set this option non-nil, we recommend not to use the 'U' command, but instead to use -'/ u' to show the packages which can be upgraded, and then unmark the -built-in packages which you don't need to overwrite from the archives. +'/ u' to show the packages which can be upgraded, and then decide +which ones of them you actually want to update from the archives. If you customize this option, we recommend you place its non-default setting in your early-init file. From acf4763417eaf7cc42e0a63a05673f89900320bf Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 12 May 2023 22:19:35 +0300 Subject: [PATCH 17/33] Fix mouse highlight with some fonts in Cairo builds * src/ftcrfont.c (ftcrfont_draw): Don't set the 'background_filled_p' flag of the glyph string. (Bug#63271) --- src/ftcrfont.c | 1 - 1 file changed, 1 deletion(-) diff --git a/src/ftcrfont.c b/src/ftcrfont.c index c9a4de8137b..49564692b75 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -590,7 +590,6 @@ ftcrfont_draw (struct glyph_string *s, GREEN_FROM_ULONG (col) / 255.0, BLUE_FROM_ULONG (col) / 255.0); #endif - s->background_filled_p = 1; cairo_rectangle (cr, x, y - FONT_BASE (s->font), s->width, FONT_HEIGHT (s->font)); cairo_fill (cr); From f0f08eeb05c79e7b7326931357e82e65262c3336 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Fri, 12 May 2023 21:56:28 +0000 Subject: [PATCH 18/33] 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 19/33] 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; } From 4bda96273490e025d1fd1a50b4bf3cab1b2def1c Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Fri, 12 May 2023 23:31:25 +0000 Subject: [PATCH 20/33] ; * admin/git-bisect-start: Update failing commits --- admin/git-bisect-start | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/admin/git-bisect-start b/admin/git-bisect-start index 511111c7f65..cae9c7918a8 100755 --- a/admin/git-bisect-start +++ b/admin/git-bisect-start @@ -82,7 +82,7 @@ done # SKIP-BRANCH 58cc931e92ece70c3e64131ee12a799d65409100 ## The list below is the exhaustive list of all commits between Dec 1 -## 2016 and Feb 28 2023 on which building Emacs with the default +## 2016 and Apr 30 2023 on which building Emacs with the default ## options, on a GNU/Linux computer and with GCC, fails. It is ## possible (though unlikely) that building Emacs with non-default ## options, with other compilers, or on other platforms, would succeed @@ -1720,3 +1720,6 @@ $REAL_GIT bisect skip $(cat $0 | grep '^# SKIP-SINGLE ' | sed 's/^# SKIP-SINGLE # SKIP-SINGLE 95692f6754c3a8f55a90df2d6f7ce62be55cdcfc # SKIP-SINGLE a3edacd3f547195740304139cb68aaa94d7b18ee # SKIP-SINGLE ae4ff4f25fbf704446f8f38d8e818f223b79042b +# SKIP-SINGLE 9686b015a0d71d08828afb0cfe6e477bbc4909ae +# SKIP-SINGLE 621e732ade0f3dc165498ebde4d55d5aacb05b56 +# SKIP-SINGLE 200dbf7d302e659e618f74bde81c7b3ccd795639 From d9f674aea50cf1fe6ac138f14b602ce2d0f5cf77 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 13 May 2023 10:07:22 +0800 Subject: [PATCH 21/33] Fix opaque region specification on no-toolkit builds * src/xterm.c (handle_one_xevent): Always specify opaque region on no-toolkit builds upon a configure event for any's window. --- src/xterm.c | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index d621d94a2cf..0899fcdc2d6 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -21178,14 +21178,28 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_cr_update_surface_desired_size (any, configureEvent.xconfigure.width, configureEvent.xconfigure.height); - if (f || (any && configureEvent.xconfigure.window == FRAME_X_WINDOW (any))) - x_update_opaque_region (f ? f : any, &configureEvent); #endif + +#if !defined USE_X_TOOLKIT && !defined USE_GTK + + /* Make the new size of the frame its opaque region. This is a + region describing areas of the window which are always + guaranteed to be completely opaque and can be treated as such + by the compositor. It is set to the width and height of the + only window in no-toolkit builds when `alpha_background' is + not set, and is cleared otherwise. */ + + if (f || (any && configureEvent.xconfigure.window + == FRAME_OUTER_WINDOW (any))) + x_update_opaque_region (f ? f : any, &configureEvent); + +#endif /* !defined USE_X_TOOLKIT && !defined USE_GTK */ + #ifdef USE_GTK if (!f && (f = any) && configureEvent.xconfigure.window == FRAME_X_WINDOW (f) - && (FRAME_VISIBLE_P(f) + && (FRAME_VISIBLE_P (f) || !(configureEvent.xconfigure.width <= 1 && configureEvent.xconfigure.height <= 1))) { @@ -21212,10 +21226,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = 0; } #endif - if (f - && (FRAME_VISIBLE_P(f) - || !(configureEvent.xconfigure.width <= 1 - && configureEvent.xconfigure.height <= 1))) + if (f && (FRAME_VISIBLE_P (f) + || !(configureEvent.xconfigure.width <= 1 + && configureEvent.xconfigure.height <= 1))) { #ifdef USE_GTK /* For GTK+ don't call x_net_wm_state for the scroll bar From fa598571adab4858282f337b45984517e197f8a9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 13 May 2023 10:27:57 +0800 Subject: [PATCH 22/33] Fix detection of tab bar windows on PGTK * src/dispnew.c (adjust_frame_glyphs_for_window_redisplay): Adjust commentary. * src/pgtkfns.c (pgtk_set_doc_edited): Remove unused function. * src/pgtkterm.c (pgtk_clear_under_internal_border): Clean up X related code. * src/pgtkterm.h: Update prototypes. * src/window.h: Define WIDNOW_TAB_BAR_P on PGTK. (bug#63472) --- src/dispnew.c | 14 ++++++++++---- src/pgtkfns.c | 7 ------- src/pgtkterm.c | 23 ++++++++++------------- src/pgtkterm.h | 1 - src/window.h | 2 +- 5 files changed, 21 insertions(+), 26 deletions(-) diff --git a/src/dispnew.c b/src/dispnew.c index fe661579daf..a928a5d1b14 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -2212,10 +2212,16 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f) w->pixel_left = 0; w->left_col = 0; - w->pixel_top = FRAME_MENU_BAR_HEIGHT (f) - + (!NILP (Vtab_bar_position) ? FRAME_TOOL_BAR_HEIGHT (f) : 0); - w->top_line = FRAME_MENU_BAR_LINES (f) - + (!NILP (Vtab_bar_position) ? FRAME_TOOL_BAR_LINES (f) : 0); + + /* Note that tab and tool bar windows appear above the internal + border, as enforced by WINDOW_TOP_EDGE_Y. */ + + w->pixel_top = (FRAME_MENU_BAR_HEIGHT (f) + + (!NILP (Vtab_bar_position) + ? FRAME_TOOL_BAR_HEIGHT (f) : 0)); + w->top_line = (FRAME_MENU_BAR_LINES (f) + + (!NILP (Vtab_bar_position) + ? FRAME_TOOL_BAR_LINES (f) : 0)); w->total_cols = FRAME_TOTAL_COLS (f); w->pixel_width = (FRAME_PIXEL_WIDTH (f) - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); diff --git a/src/pgtkfns.c b/src/pgtkfns.c index 6e5bb22375a..801f97d26d2 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -398,13 +398,6 @@ pgtk_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) pgtk_set_name_internal (f, name); } - -void -pgtk_set_doc_edited (void) -{ -} - - static void pgtk_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { diff --git a/src/pgtkterm.c b/src/pgtkterm.c index c00e13550bd..6cb1a3a4626 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -4954,22 +4954,19 @@ pgtk_clear_under_internal_border (struct frame *f) if (face) { -#define x_fill_rectangle(f, gc, x, y, w, h) \ - fill_background_by_face (f, face, x, y, w, h) - x_fill_rectangle (f, gc, 0, margin, width, border); - x_fill_rectangle (f, gc, 0, 0, border, height); - x_fill_rectangle (f, gc, width - border, 0, border, height); - x_fill_rectangle (f, gc, 0, height - border, width, border); -#undef x_fill_rectangle + fill_background_by_face (f, face, 0, margin, width, border); + fill_background_by_face (f, face, 0, 0, border, height); + fill_background_by_face (f, face, width - border, 0, border, + height); + fill_background_by_face (f, face, 0, height - border, width, + border); } else { -#define x_clear_area(f, x, y, w, h) pgtk_clear_area (f, x, y, w, h) - x_clear_area (f, 0, 0, border, height); - x_clear_area (f, 0, margin, width, border); - x_clear_area (f, width - border, 0, border, height); - x_clear_area (f, 0, height - border, width, border); -#undef x_clear_area + pgtk_clear_area (f, 0, 0, border, height); + pgtk_clear_area (f, 0, margin, width, border); + pgtk_clear_area (f, width - border, 0, border, height); + pgtk_clear_area (f, 0, height - border, width, border); } unblock_input (); diff --git a/src/pgtkterm.h b/src/pgtkterm.h index 202c6622ce3..8f2f00efdad 100644 --- a/src/pgtkterm.h +++ b/src/pgtkterm.h @@ -553,7 +553,6 @@ extern void pgtk_clear_frame (struct frame *); extern char *pgtk_xlfd_to_fontname (const char *); /* Implemented in pgtkfns.c. */ -extern void pgtk_set_doc_edited (void); extern const char *pgtk_get_defaults_value (const char *); extern const char *pgtk_get_string_resource (XrmDatabase, const char *, const char *); extern void pgtk_implicitly_set_name (struct frame *, Lisp_Object, Lisp_Object); diff --git a/src/window.h b/src/window.h index 32b5fe14f4f..2f793ebe438 100644 --- a/src/window.h +++ b/src/window.h @@ -750,7 +750,7 @@ wset_next_buffers (struct window *w, Lisp_Object val) #endif /* True if W is a tab bar window. */ -#if defined (HAVE_WINDOW_SYSTEM) && !defined (HAVE_PGTK) +#if defined (HAVE_WINDOW_SYSTEM) # define WINDOW_TAB_BAR_P(W) \ (WINDOWP (WINDOW_XFRAME (W)->tab_bar_window) \ && (W) == XWINDOW (WINDOW_XFRAME (W)->tab_bar_window)) From 7acae22f42f1b2df2042d5d77a0839f0ca9c02e7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 May 2023 11:28:38 +0300 Subject: [PATCH 23/33] Fix auto-filling in Texinfo mode This fixes auto-filling in Texinfo buffers. It was broken by the fix to bug#49558, which made M-q fill over-long @noindent lines by refraining from customizing 'paragraph-separate' in Texinfo mode. The underlying problem here is that 'auto-fill-mode' doesn't call mode-specific filling functions, but does its job by itself, and depends on 'forward-paragraph' to find the beginning of the paragraph as appropriate for calculation of 'fill-prefix', and a different value of 'paragraph-separate' broke that. As a side effect, the change below also changes paragraph-movement commands in Texinfo back to how they behaved prior to that bugfix, but I don't see why the paragraph-movement behavior introduced by that fix made more sense. Try to move through a series of @-directives, like a paragraph preceded by several @cindex entries, and you will see the inconsistencies. In any case, the adverse effects of that fix on auto-filling is unacceptable. * lisp/textmodes/texinfo.el (fill-paragraph-separate): New variable. (texinfo-mode): Set 'fill-paragraph-separate' to the default value of 'paragraph-separate'. Customize 'paragraph-separate' to the Texinfo-specific value, as it was before commit dde591571abf. (texinfo--fill-paragraph): Bind 'paragraph-separate' to the value of 'fill-paragraph-separate', to keep 'M-q' happy. --- lisp/textmodes/texinfo.el | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 7416c631c9f..bedf9ec92a5 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -409,6 +409,8 @@ REPORT-FN is the callback function." ;;; Texinfo mode +(defvar fill-paragraph-separate nil) + ;;;###autoload (define-derived-mode texinfo-mode text-mode "Texinfo" "Major mode for editing Texinfo files. @@ -482,6 +484,10 @@ value of `texinfo-mode-hook'." "\\)\\>")) (setq-local require-final-newline mode-require-final-newline) (setq-local indent-tabs-mode nil) + ;; This is used in 'texinfo--fill-paragraph'. + (setq-local fill-paragraph-separate (default-value 'paragraph-separate)) + (setq-local paragraph-separate + (concat "@[a-zA-Z]*[ \n]\\|" paragraph-separate)) (setq-local paragraph-start (concat "@[a-zA-Z]*[ \n]\\|" paragraph-start)) (setq-local fill-paragraph-function 'texinfo--fill-paragraph) @@ -536,7 +542,13 @@ value of `texinfo-mode-hook'." (defun texinfo--fill-paragraph (justify) "Function to fill a paragraph in `texinfo-mode'." - (let ((command-re "\\(@[a-zA-Z]+\\)[ \t\n]")) + (let ((command-re "\\(@[a-zA-Z]+\\)[ \t\n]") + ;; Kludge alert: we override paragraph-separate here because + ;; that is needed for filling @noindent and similar lines. + ;; The default Texinfo-specific paragraph-separate value, + ;; OTOH, is needed for auto-fill-mode, which doesn't call + ;; mode-specific functions. + (paragraph-separate fill-paragraph-separate)) (catch 'no-fill (save-restriction ;; First check whether we're on a command line that can be From bfc07100d28d0f687da0a1dd5fdfa42a92a93f88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 11 May 2023 19:24:51 +0200 Subject: [PATCH 24/33] Byte-compiler warning about mutation of constant values When we can easily detect mutation of constants (quoted lists, strings and vectors), warn. For example, (setcdr '(1 . 2) 3) (nreverse [1 2 3]) (put-text-property 0 3 'face 'highlight "moo") Such code can result in surprising behaviour and problems that are difficult to debug. * lisp/emacs-lisp/bytecomp.el (byte-compile-form, mutating-fns): Add the warning and a list of functions to warn about. * etc/NEWS: Announce. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test--with-suppressed-warnings): Add test cases. --- etc/NEWS | 20 ++++++++++ lisp/emacs-lisp/bytecomp.el | 53 ++++++++++++++++++++++++++ test/lisp/emacs-lisp/bytecomp-tests.el | 30 +++++++++++++++ 3 files changed, 103 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 3bef9d2ed2a..7d033b0b13e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -509,6 +509,26 @@ simplified away. This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. +--- +*** Warn about mutation of constant values. +The compiler now warns about code that modifies program constants in +some obvious cases. Examples: + + (setcar '(1 2) 7) + (aset [3 4] 0 8) + (aset "abc" 1 ?d) + +Such code may have unpredictable behaviour because the constants are +part of the program, not data structures generated afresh during +execution, and the compiler does not expect them to change. + +To avoid the warning, operate on an object created by the program +(maybe a copy of the constant), or use a non-destructive operation +instead. + +This warning can be suppressed using 'with-suppressed-warnings' with +the warning name 'suspicious'. + --- *** Warn about more ignored function return values. The compiler now warns when the return value from certain functions is diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 6c804056ee7..d17f1c93a76 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3488,6 +3488,22 @@ lambda-expression." (format-message "; use `%s' instead." interactive-only)) (t ".")))) + (let ((mutargs (function-get (car form) 'mutates-arguments))) + (when mutargs + (dolist (idx (if (eq mutargs 'all-but-last) + (number-sequence 1 (- (length form) 2)) + mutargs)) + (let ((arg (nth idx form))) + (when (and (or (and (eq (car-safe arg) 'quote) + (consp (nth 1 arg))) + (arrayp arg)) + (byte-compile-warning-enabled-p + 'suspicious (car form))) + (byte-compile-warn-x form "`%s' on constant %s (arg %d)" + (car form) + (if (consp arg) "list" (type-of arg)) + idx)))))) + (if (eq (car-safe (symbol-function (car form))) 'macro) (byte-compile-report-error (format-message "`%s' defined after use in %S (missing `require' of a library file?)" @@ -3557,6 +3573,43 @@ lambda-expression." (dolist (fn important-return-value-fns) (put fn 'important-return-value t))) +(let ((mutating-fns + ;; FIXME: Should there be a function declaration for this? + ;; + ;; (FUNC . ARGS) means that FUNC mutates arguments whose indices are + ;; in the list ARGS, starting at 1, or all but the last argument if + ;; ARGS is `all-but-last'. + '( + (setcar 1) (setcdr 1) (aset 1) + (nreverse 1) + (nconc . all-but-last) + (nbutlast 1) (ntake 2) + (sort 1) + (delq 2) (delete 2) + (delete-dups 1) (delete-consecutive-dups 1) + (plist-put 1) + (fillarray 1) + (store-substring 1) + (clear-string 1) + + (add-text-properties 4) (put-text-property 5) (set-text-properties 4) + (remove-text-properties 4) (remove-list-of-text-properties 4) + (alter-text-property 5) + (add-face-text-property 5) (add-display-text-property 5) + + (cl-delete 2) (cl-delete-if 2) (cl-delete-if-not 2) + (cl-delete-duplicates 1) + (cl-nsubst 3) (cl-nsubst-if 3) (cl-nsubst-if-not 3) + (cl-nsubstitute 3) (cl-nsubstitute-if 3) (cl-nsubstitute-if-not 3) + (cl-nsublis 2) + (cl-nunion 1 2) (cl-nintersection 1 2) (cl-nset-difference 1 2) + (cl-nset-exclusive-or 1 2) + (cl-nreconc 1) + (cl-sort 1) (cl-stable-sort 1) (cl-merge 2 3) + ))) + (dolist (entry mutating-fns) + (put (car entry) 'mutates-arguments (cdr entry)))) + (defun byte-compile-normal-call (form) (when (and (symbolp (car form)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 222065c2e4e..9136a6cd9b3 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1518,6 +1518,36 @@ literals (Bug#20852)." )) '((empty-body with-suppressed-warnings)) "Warning: `with-suppressed-warnings' with empty body") + + (test-suppression + '(defun zot () + (setcar '(1 2) 3)) + '((suspicious setcar)) + "Warning: `setcar' on constant list (arg 1)") + + (test-suppression + '(defun zot () + (aset [1 2] 1 3)) + '((suspicious aset)) + "Warning: `aset' on constant vector (arg 1)") + + (test-suppression + '(defun zot () + (aset "abc" 1 ?d)) + '((suspicious aset)) + "Warning: `aset' on constant string (arg 1)") + + (test-suppression + '(defun zot (x y) + (nconc x y '(1 2) '(3 4))) + '((suspicious nconc)) + "Warning: `nconc' on constant list (arg 3)") + + (test-suppression + '(defun zot () + (put-text-property 0 2 'prop 'val "abc")) + '((suspicious put-text-property)) + "Warning: `put-text-property' on constant string (arg 5)") ) (ert-deftest bytecomp-tests--not-writable-directory () From c083fa5cf80f711ac43dca1b6582aff1ad526e8e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Felici=C3=A1n=20N=C3=A9meth?= Date: Fri, 12 May 2023 01:50:05 +0100 Subject: [PATCH 25/33] Eglot: support window/showRequest (bug#62116) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: João Távora * lisp/progmodes/eglot.el (eglot-client-capabilities): Advertise window/showDocument. (eglot-handle-request window/showDocument): New handler. --- lisp/progmodes/eglot.el | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 66d893a14b5..52f87c1af5d 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -845,7 +845,8 @@ ACTION is an LSP object of either `CodeAction' or `Command' type." `(:valueSet [,@(mapcar #'car eglot--tag-faces)]))) - :window `(:workDoneProgress t) + :window `(:showDocument (:support t) + :workDoneProgress t) :general (list :positionEncodings ["utf-32" "utf-8" "utf-16"]) :experimental eglot--{}))) @@ -2366,6 +2367,28 @@ THINGS are either registrations or unregisterations (sic)." "Handle server request workspace/workspaceFolders." (eglot-workspace-folders server)) +(cl-defmethod eglot-handle-request + (_server (_method (eql window/showDocument)) &key + uri external takeFocus selection) + "Handle request window/showDocument." + (if (eq external t) (browse-url uri) + ;; Use run-with-timer to avoid nested client requests like the + ;; synchronous imenu case caused by which-func-mode. + (run-with-timer + 0 nil + (lambda () + (with-current-buffer (find-file-noselect (eglot--uri-to-path uri)) + (cond (takeFocus + (pop-to-buffer (current-buffer)) + (select-frame-set-input-focus (selected-frame))) + ((display-buffer (current-buffer)))) + (when selection + (eglot--widening + (pcase-let ((`(,beg . ,end) (eglot--range-region selection))) + (goto-char beg) + (pulse-momentary-highlight-region beg end 'highlight)))))))) + '(:success t)) + (defun eglot--TextDocumentIdentifier () "Compute TextDocumentIdentifier object for current buffer." `(:uri ,(eglot--path-to-uri (or buffer-file-name From 9f856e4cd095c24cf4e6cadbc04efaf533e59f37 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 13 May 2023 13:49:07 +0200 Subject: [PATCH 26/33] Use `mutate-constant` as warning identifier * etc/NEWS: * lisp/emacs-lisp/byte-run.el (with-suppressed-warnings): * lisp/emacs-lisp/bytecomp.el (byte-compile-warnings) (byte-compile-form): * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test--with-suppressed-warnings): Use the new warning name `mutate-constant` instead of using the somewhat overloaded `suspicious`. --- etc/NEWS | 2 +- lisp/emacs-lisp/byte-run.el | 2 +- lisp/emacs-lisp/bytecomp.el | 4 +++- test/lisp/emacs-lisp/bytecomp-tests.el | 10 +++++----- 4 files changed, 10 insertions(+), 8 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 7d033b0b13e..b4846eb11b0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -527,7 +527,7 @@ To avoid the warning, operate on an object created by the program instead. This warning can be suppressed using 'with-suppressed-warnings' with -the warning name 'suspicious'. +the warning name 'mutate-constant'. --- *** Warn about more ignored function return values. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 5b415c5e1f4..a377ec395e1 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -658,7 +658,7 @@ in `byte-compile-warning-types'; see the variable types. The types that can be suppressed with this macro are `free-vars', `callargs', `redefine', `obsolete', `interactive-only', `lexical', `ignored-return-value', `constants', -`suspicious' and `empty-body'." +`suspicious', `empty-body' and `mutate-constant'." ;; Note: during compilation, this definition is overridden by the one in ;; byte-compile-initial-macro-environment. (declare (debug (sexp body)) (indent 1)) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d17f1c93a76..a192d599d1d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -330,6 +330,8 @@ Elements of the list may be: This depends on the `docstrings' warning type. suspicious constructs that usually don't do what the coder wanted. empty-body body argument to a special form or macro is empty. + mutate-constant + code that mutates program constants such as quoted lists If the list begins with `not', then the remaining elements specify warnings to suppress. For example, (not free-vars) will suppress the `free-vars' warning. @@ -3498,7 +3500,7 @@ lambda-expression." (consp (nth 1 arg))) (arrayp arg)) (byte-compile-warning-enabled-p - 'suspicious (car form))) + 'mutate-constant (car form))) (byte-compile-warn-x form "`%s' on constant %s (arg %d)" (car form) (if (consp arg) "list" (type-of arg)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 9136a6cd9b3..a8809bda81c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1522,31 +1522,31 @@ literals (Bug#20852)." (test-suppression '(defun zot () (setcar '(1 2) 3)) - '((suspicious setcar)) + '((mutate-constant setcar)) "Warning: `setcar' on constant list (arg 1)") (test-suppression '(defun zot () (aset [1 2] 1 3)) - '((suspicious aset)) + '((mutate-constant aset)) "Warning: `aset' on constant vector (arg 1)") (test-suppression '(defun zot () (aset "abc" 1 ?d)) - '((suspicious aset)) + '((mutate-constant aset)) "Warning: `aset' on constant string (arg 1)") (test-suppression '(defun zot (x y) (nconc x y '(1 2) '(3 4))) - '((suspicious nconc)) + '((mutate-constant nconc)) "Warning: `nconc' on constant list (arg 3)") (test-suppression '(defun zot () (put-text-property 0 2 'prop 'val "abc")) - '((suspicious put-text-property)) + '((mutate-constant put-text-property)) "Warning: `put-text-property' on constant string (arg 5)") ) From 63be4d11b58630251c70508267792d4a6d431fdd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 13 May 2023 13:36:50 +0200 Subject: [PATCH 27/33] Don't mutate constants in tests * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-test--symbol-macrolet): * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-ellipsis-circular): * test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el (eieio-test-persist-interior-lists): * test/lisp/textmodes/reftex-tests.el (reftex-all-used-citation-keys): * test/src/xdisp-tests.el (xdisp-tests--minibuffer-resizing): * test/src/fns-tests.el (test-vector-delete): Mutate created objects, not constants. * test/lisp/emacs-lisp/subr-x-tests.el (subr-x-test-add-display-text-property): Mutate a created string, and compare using `equal-including-properties` without which the test was rather meaningless. * test/lisp/net/tramp-archive-tests.el (tramp-archive-test16-directory-files): Don't mutate. --- test/lisp/emacs-lisp/cl-macs-tests.el | 2 +- test/lisp/emacs-lisp/cl-print-tests.el | 2 +- .../eieio-tests/eieio-test-persist.el | 4 ++-- test/lisp/emacs-lisp/subr-x-tests.el | 17 +++++++++-------- test/lisp/net/tramp-archive-tests.el | 4 ++-- test/lisp/textmodes/reftex-tests.el | 3 ++- test/src/fns-tests.el | 2 +- test/src/xdisp-tests.el | 2 +- 8 files changed, 19 insertions(+), 17 deletions(-) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index a9ec0b76ae8..a4bc8d542d4 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -535,7 +535,7 @@ collection clause." (eval '(let ((l (list 1))) (cl-symbol-macrolet ((x 1)) (setq (car l) 0))) t)) ;; Make sure `gv-synthetic-place' isn't macro-expanded before `setf' gets to ;; see its `gv-expander'. - (should (equal (let ((l '(0))) + (should (equal (let ((l (list 0))) (let ((cl (car l))) (cl-symbol-macrolet ((p (gv-synthetic-place cl (lambda (v) `(setcar l ,v))))) diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index 7161035d75a..af94dae310c 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -90,7 +90,7 @@ (ert-deftest cl-print-tests-ellipsis-circular () "Ellipsis expansion works with circular objects." (let ((wide-obj (list 0 1 2 3 4)) - (deep-obj `(0 (1 (2 (3 (4)))))) + (deep-obj (list 0 (list 1 (list 2 (list 3 (list 4)))))) (print-length 4) (print-level 3)) (setf (nth 4 wide-obj) wide-obj) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el index 4feaebed452..4e5d2f36cf8 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el @@ -329,8 +329,8 @@ persistent class.") "container-" emacs-version ".eieio"))) (john (make-instance 'person :name "John")) (alexie (make-instance 'person :name "Alexie")) - (alst '(("first" (one two three)) - ("second" (four five six))))) + (alst (list (list "first" (list 'one 'two 'three)) + (list "second" (list 'four 'five 'six))))) (setf (slot-value thing 'alist) alst) (puthash "alst" alst (slot-value thing 'htab)) (aset (slot-value thing 'vec) 0 alst) diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index e4c270a114f..63d8fcd080c 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -709,14 +709,15 @@ [(raise 0.5) (height 2.0)])) (should (equal (get-text-property 9 'display) '(raise 0.5)))) (with-temp-buffer - (should (equal (let ((str "some useless string")) - (add-display-text-property 4 8 'height 2.0 str) - (add-display-text-property 2 12 'raise 0.5 str) - str) - #("some useless string" - 2 4 (display (raise 0.5)) - 4 8 (display ((raise 0.5) (height 2.0))) - 8 12 (display (raise 0.5))))))) + (should (equal-including-properties + (let ((str (copy-sequence "some useless string"))) + (add-display-text-property 4 8 'height 2.0 str) + (add-display-text-property 2 12 'raise 0.5 str) + str) + #("some useless string" + 2 4 (display (raise 0.5)) + 4 8 (display ((raise 0.5) (height 2.0))) + 8 12 (display (raise 0.5))))))) (ert-deftest subr-x-named-let () (let ((funs ())) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 2e2e313f35c..80ec67da8d2 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -587,11 +587,11 @@ This checks also `file-name-as-directory', `file-name-directory', (mapcar (lambda (x) (concat tmp-name x)) files))) (should (equal (directory-files tmp-name nil directory-files-no-dot-files-regexp) - (delete "." (delete ".." files)))) + (remove "." (remove ".." files)))) (should (equal (directory-files tmp-name 'full directory-files-no-dot-files-regexp) (mapcar (lambda (x) (concat tmp-name x)) - (delete "." (delete ".." files)))))) + (remove "." (remove ".." files)))))) ;; Cleanup. (tramp-archive-cleanup-hash)))) diff --git a/test/lisp/textmodes/reftex-tests.el b/test/lisp/textmodes/reftex-tests.el index 5a137ba8a67..6aa12bc3b58 100644 --- a/test/lisp/textmodes/reftex-tests.el +++ b/test/lisp/textmodes/reftex-tests.el @@ -294,7 +294,8 @@ And this should be % \\cite{ignored}. (find-file tex-file) (setq keys (reftex-all-used-citation-keys)) (should (equal (sort keys #'string<) - (sort '(;; Standard commands: + (sort (list + ;; Standard commands: "cite:2022" "Cite:2022" "parencite:2022" "Parencite:2022" "footcite:2022" "footcitetext:2022" diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 2859123da80..79ae4393f40 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1101,7 +1101,7 @@ (ert-deftest test-vector-delete () (let ((v1 (make-vector 1000 1))) - (should (equal (delete t [nil t]) [nil])) + (should (equal (delete t (vector nil t)) [nil])) (should (equal (delete 1 v1) (vector))) (should (equal (delete 2 v1) v1)))) diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el index 52ed79b0f20..dfd38a9d4c1 100644 --- a/test/src/xdisp-tests.el +++ b/test/src/xdisp-tests.el @@ -40,7 +40,7 @@ (insert "hello") (let ((ol (make-overlay (point) (point))) (max-mini-window-height 1) - (text "askdjfhaklsjdfhlkasjdfhklasdhflkasdhflkajsdhflkashdfkljahsdlfkjahsdlfkjhasldkfhalskdjfhalskdfhlaksdhfklasdhflkasdhflkasdhflkajsdhklajsdgh")) + (text (copy-sequence "askdjfhaklsjdfhlkasjdfhklasdhflkasdhflkajsdhflkashdfkljahsdlfkjahsdlfkjhasldkfhalskdjfhalskdfhlaksdhfklasdhflkasdhflkasdhflkajsdhklajsdgh"))) ;; (save-excursion (insert text)) ;; (sit-for 2) ;; (delete-region (point) (point-max)) From e6585e0be2efc3f2eaec7210b036169fbdffa9ce Mon Sep 17 00:00:00 2001 From: Peter Oliver Date: Mon, 8 May 2023 11:24:53 +0100 Subject: [PATCH 28/33] Always default ediff-auto-refine to 'on * lisp/vc/ediff-diff.el (ediff-auto-refine): always default to 'on. (Bug#63318) Copyright-paperwork-exempt: yes --- lisp/vc/ediff-diff.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index 832e3933df9..0ee973a4de6 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -142,7 +142,7 @@ The status can be =diff(A), =diff(B), or =diff(A+B).") ;;; Fine differences -(ediff-defvar-local ediff-auto-refine (if (ediff-has-face-support-p) 'on 'nix) +(ediff-defvar-local ediff-auto-refine 'on) "If `on', Ediff auto-highlights fine diffs for the current diff region. If `off', auto-highlighting is not used. If `nix', no fine diffs are shown at all, unless the user force-refines the region by hitting `*'. From c96c8a9a7d22b59af40bf7e963245ae271159bfe Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 13 May 2023 17:00:47 +0300 Subject: [PATCH 29/33] ; * lisp/vc/ediff-diff.el (ediff-auto-refine): Fix last change. --- lisp/vc/ediff-diff.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index 0ee973a4de6..42c313b3f07 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -142,7 +142,7 @@ The status can be =diff(A), =diff(B), or =diff(A+B).") ;;; Fine differences -(ediff-defvar-local ediff-auto-refine 'on) +(ediff-defvar-local ediff-auto-refine 'on "If `on', Ediff auto-highlights fine diffs for the current diff region. If `off', auto-highlighting is not used. If `nix', no fine diffs are shown at all, unless the user force-refines the region by hitting `*'. From 38706abdf7f6d919640e8e14f0e0dc6cf34aa555 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 7 May 2023 19:43:57 -0700 Subject: [PATCH 30/33] Add helper for restoring local session vars in ERC * lisp/erc/erc-common.el (erc--input-split): Suppress warning for obsolete variable `erc-send-this' in init form. * lisp/erc/erc-goodies.el (erc--keep-place-indicator-setup): Use macro `erc--restore-initialize-priors' to preserve last session's indicator position, if any. (erc-keep-place-indicator-mode, erc-keep-place-indicator-enable): Use convenience function to show missing-dependency notice. * lisp/erc/erc-sasl.el (erc-sasl-auth-source-password-as-host): Merge redundant `when' forms for clarity. (erc-sasl--init): Remove unused function. (erc-sasl-mode, erc-sasl-enable): Use helper to restore `erc-sasl--options', essentially inlining the body of the now defunct `erc-sasl--init'. * lisp/erc/erc.el (erc--restore-initialize-priors): New macro to help local modules and mode hooks prefer existing state over initializing anew. (erc--warn-once-before-connect): Add helper function to display an "error notice" just after module setup. (erc-accidental-paste-threshold-seconds) Improve doc string. * test/lisp/erc/erc-goodies-tests.el (erc-controls-highlight--examples, erc-controls-highlight--inverse, erc-controls-highlight--motd, erc-keep-place-indicator-mode): Remove feature check. For the latter, also start fake process and shadow `erc-connect-pre-hook'. * test/lisp/erc/erc-tests.el (erc--restore-initialize-priors): New test. Also see test/lisp/erc/erc-scenarios-base-local-modules.el for a more realistic exercising of this functionality. (Bug#60936) --- lisp/erc/erc-common.el | 4 +- lisp/erc/erc-goodies.el | 24 +++++------- lisp/erc/erc-sasl.el | 38 ++++++++----------- lisp/erc/erc.el | 60 ++++++++++++++++++++++++++++++ test/lisp/erc/erc-goodies-tests.el | 17 ++------- test/lisp/erc/erc-tests.el | 15 ++++++++ 6 files changed, 107 insertions(+), 51 deletions(-) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 86d78768374..f152a1a32d9 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -56,7 +56,9 @@ (cl-defstruct (erc--input-split (:include erc-input (string :read-only) (insertp erc-insert-this) - (sendp erc-send-this))) + (sendp (with-suppressed-warnings + ((obsolete erc-send-this)) + erc-send-this)))) (lines nil :type (list-of string)) (cmdp nil :type boolean)) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index cc60ba0018b..4558ff7c076 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -154,21 +154,21 @@ displays an arrow in the left fringe or margin. When it's `face', ERC adds the face `erc-keep-place-indicator-line' to the appropriate line. A value of t does both." :group 'erc - :package-version '(ERC . "5.6") + :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const t) (const server) (const target))) (defcustom erc-keep-place-indicator-buffer-type t "ERC buffer type in which to display `keep-place-indicator'. A value of t means \"all\" ERC buffers." :group 'erc - :package-version '(ERC . "5.6") + :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const t) (const server) (const target))) (defcustom erc-keep-place-indicator-follow nil "Whether to sync visual kept place to window's top when reading. For use with `erc-keep-place-indicator-mode'." :group 'erc - :package-version '(ERC . "5.6") + :package-version '(ERC . "5.6") ; FIXME sync on release :type 'boolean) (defface erc-keep-place-indicator-line @@ -209,11 +209,8 @@ the active frame." (defun erc--keep-place-indicator-setup () "Initialize buffer for maintaining `erc--keep-place-indicator-overlay'." (require 'fringe) - (setq erc--keep-place-indicator-overlay - (if-let* ((vars (or erc--server-reconnecting erc--target-priors)) - ((alist-get 'erc-keep-place-indicator-mode vars))) - (alist-get 'erc--keep-place-indicator-overlay vars) - (make-overlay 0 0))) + (erc--restore-initialize-priors erc-keep-place-indicator-mode + erc--keep-place-indicator-overlay (make-overlay 0 0)) (add-hook 'window-configuration-change-hook #'erc--keep-place-indicator-on-window-configuration-change nil t) (when-let* (((memq erc-keep-place-indicator-style '(t arrow))) @@ -232,13 +229,10 @@ the active frame." "`keep-place' with a fringe arrow and/or highlighted face." ((unless erc-keep-place-mode (unless (memq 'keep-place erc-modules) - ;; FIXME use `erc-button--display-error-notice-with-keys' - ;; to display this message when bug#60933 is ready. - (erc-display-error-notice - nil (concat - "Local module `keep-place-indicator' needs module `keep-place'." - " Enabling now. This will affect \C-]all\C-] ERC sessions." - " Add `keep-place' to `erc-modules' to silence this message."))) + (erc--warn-once-before-connect 'erc-keep-place-mode + "Local module `keep-place-indicator' needs module `keep-place'." + " Enabling now. This will affect \C-]all\C-] ERC sessions." + " Add `keep-place' to `erc-modules' to silence this message.")) (erc-keep-place-mode +1)) (if (pcase erc-keep-place-indicator-buffer-type ('target erc--target) diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index bfe17285a68..c6922b1b26b 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -137,12 +137,12 @@ that symbol is `:password', in which case, use a non-nil `erc-session-password' instead. Otherwise, just defer to `erc-auth-source-search' to pick a suitable `:host'. Expect PLIST to contain keyword params known to `auth-source-search'." - (when erc-sasl-password - (when-let ((host (if (eq :password erc-sasl-password) - (and (not (functionp erc-session-password)) - erc-session-password) - erc-sasl-password))) - (setq plist `(,@plist :host ,(format "%s" host))))) + (when-let* ((erc-sasl-password) + (host (if (eq :password erc-sasl-password) + (and (not (functionp erc-session-password)) + erc-session-password) + erc-sasl-password))) + (setq plist `(,@plist :host ,(format "%s" host)))) (apply #'erc-auth-source-search plist)) (defun erc-sasl--read-password (prompt) @@ -297,21 +297,6 @@ If necessary, pass PROMPT to `read-passwd'." (sasl-client-set-property client 'ecdsa-keyfile keyfile) client))))) -;; This stands alone because it's also used by bug#49860. -(defun erc-sasl--init () - (setq erc-sasl--state (make-erc-sasl--state)) - ;; If the previous attempt failed during registration, this may be - ;; non-nil and contain erroneous values, but how can we detect that? - ;; What if the server dropped the connection for some other reason? - (setq erc-sasl--options - (or (and erc--server-reconnecting - (alist-get 'erc-sasl--options erc--server-reconnecting)) - `((user . ,erc-sasl-user) - (password . ,erc-sasl-password) - (mechanism . ,erc-sasl-mechanism) - (authfn . ,erc-sasl-auth-source-function) - (authzid . ,erc-sasl-authzid))))) - (defun erc-sasl--mechanism-offered-p (offered) "Return non-nil when OFFERED appears among a list of mechanisms." (string-match-p (rx-to-string @@ -334,7 +319,16 @@ If necessary, pass PROMPT to `read-passwd'." This doesn't solicit or validate a suite of supported mechanisms." ;; See bug#49860 for a CAP 3.2-aware WIP implementation. ((unless erc--target - (erc-sasl--init) + (setq erc-sasl--state (make-erc-sasl--state)) + ;; If the previous attempt failed during registration, this may be + ;; non-nil and contain erroneous values, but how can we detect that? + ;; What if the server dropped the connection for some other reason? + (erc--restore-initialize-priors erc-sasl-mode + erc-sasl--options `((user . ,erc-sasl-user) + (password . ,erc-sasl-password) + (mechanism . ,erc-sasl-mechanism) + (authfn . ,erc-sasl-auth-source-function) + (authzid . ,erc-sasl-authzid))) (let* ((mech (alist-get 'mechanism erc-sasl--options)) (client (erc-sasl--create-client mech))) (unless client diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index dbf413bac74..5738ee92578 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1363,6 +1363,20 @@ See also `erc-show-my-nick'." Bound to local variables from an existing (logical) session's buffer during local-module setup and `erc-mode-hook' activation.") +(defmacro erc--restore-initialize-priors (mode &rest vars) + "Restore local VARS for MODE from a previous session." + (declare (indent 1)) + (let ((existing (make-symbol "existing")) + ;; + restore initialize) + (while-let ((k (pop vars)) (v (pop vars))) + (push `(,k (alist-get ',k ,existing)) restore) + (push `(,k ,v) initialize)) + `(if-let* ((,existing (or erc--server-reconnecting erc--target-priors)) + ((alist-get ',mode ,existing))) + (setq ,@(mapcan #'identity (nreverse restore))) + (setq ,@(mapcan #'identity (nreverse initialize)))))) + (defun erc--target-from-string (string) "Construct an `erc--target' variant from STRING." (funcall (if (erc-channel-p string) @@ -1412,6 +1426,37 @@ capabilities." (add-hook hook fun nil t) fun)) +(defun erc--warn-once-before-connect (mode-var &rest args) + "Display an \"error notice\" once. +Expect ARGS to be `erc-button--display-error-notice-with-keys' +compatible parameters, except without any leading buffers or +processes. If we're in an ERC buffer with a network process when +called, print the notice immediately. Otherwise, if we're in a +server buffer, arrange to do so after local modules have been set +up and mode hooks have run. Otherwise, if MODE-VAR is a global +module, try again at most once the next time `erc-mode-hook' +runs." + (declare (indent 1)) + (cl-assert (stringp (car args))) + (if (derived-mode-p 'erc-mode) + (unless (or (erc-with-server-buffer ; needs `erc-server-process' + (apply #'erc-button--display-error-notice-with-keys + (current-buffer) args) + t) + erc--target) ; unlikely + (let (hook) + (setq hook + (lambda (_) + (remove-hook 'erc-connect-pre-hook hook t) + (apply #'erc-button--display-error-notice-with-keys args))) + (add-hook 'erc-connect-pre-hook hook nil t))) + (when (custom-variable-p mode-var) + (let (hook) + (setq hook (lambda () + (remove-hook 'erc-mode-hook hook) + (apply #'erc--warn-once-before-connect 'erc-fake args))) + (add-hook 'erc-mode-hook hook))))) + (defun erc-server-buffer () "Return the server buffer for the current buffer's process. The buffer-local variable `erc-server-process' is used to find @@ -6094,6 +6139,21 @@ if its previous invocation was fewer than this many seconds ago. This is useful so that if you accidentally enter large amounts of text into the ERC buffer, that text is not sent to the IRC server. +This option only concerns the rapid submission of successive +lines of prompt input from an \"external\" source, such as GNU +screen or a desktop-automation script. For example, typing + + \\[kmacro-start-macro-or-insert-counter] \ +one \\`RET' two \\`RET' three \\`RET' + \\[kmacro-end-or-call-macro] in the \"*scratch*\" buffer, \ +followed by a + \\[kmacro-end-or-call-macro] again in a channel buffer, + +will send \"one\" to the server, leave \"two\" at the prompt, and +insert \"three\" in an \"overflow\" buffer. For suppression +involving input yanked from the clipboard or the kill ring, see +`erc-inhibit-multiline-input' and `erc-warn-about-blank-lines'. + If the value is nil, `erc-send-current-line' always considers any submitted line to be intentional." :group 'erc diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index a1f53c5bf88..7acacb319f1 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -21,7 +21,6 @@ ;;; Code: (require 'ert-x) (require 'erc-goodies) -(declare-function erc--initialize-markers "erc" (old-point continued) t) (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) (setq beg (+ beg (point-min))) @@ -44,9 +43,6 @@ ;; https://modern.ircdocs.horse/formatting.html (ert-deftest erc-controls-highlight--examples () - ;; FIXME remove after adding - (unless (fboundp 'erc--initialize-markers) - (ert-skip "Missing required function")) (should (eq t erc-interpret-controls-p)) (let ((erc-insert-modify-hook '(erc-controls-highlight)) erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) @@ -130,9 +126,6 @@ ;; in a high-contrast face. (ert-deftest erc-controls-highlight--inverse () - ;; FIXME remove after adding - (unless (fboundp 'erc--initialize-markers) - (ert-skip "Missing required function")) (should (eq t erc-interpret-controls-p)) (let ((erc-insert-modify-hook '(erc-controls-highlight)) erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) @@ -212,9 +205,6 @@ (":- "))) (ert-deftest erc-controls-highlight--motd () - ;; FIXME remove after adding - (unless (fboundp 'erc--initialize-markers) - (ert-skip "Missing required function")) (should (eq t erc-interpret-controls-p)) (let ((erc-insert-modify-hook '(erc-controls-highlight)) erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) @@ -256,12 +246,12 @@ ;; needed. (ert-deftest erc-keep-place-indicator-mode () - ;; FIXME remove after adding - (unless (fboundp 'erc--initialize-markers) - (ert-skip "Missing required function")) (with-current-buffer (get-buffer-create "*erc-keep-place-indicator-mode*") (erc-mode) (erc--initialize-markers (point) nil) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) (let ((assert-off (lambda () (should-not erc-keep-place-indicator-mode) @@ -275,6 +265,7 @@ (should erc-keep-place-mode))) ;; erc-insert-pre-hook + erc-connect-pre-hook erc-modules) (funcall assert-off) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index be5a566a268..b624186d88d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -868,6 +868,21 @@ (should-not (erc--valid-local-channel-p "#chan")) (should (erc--valid-local-channel-p "&local"))))) +(ert-deftest erc--restore-initialize-priors () + ;; This `pcase' expands to 100+k. Guess we could do something like + ;; (and `(,_ ((,e . ,_) . ,_) . ,_) v) first and then return a + ;; (equal `(if-let* ((,e ...)...)...) v) to cut it down to < 1k. + (should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode + foo (ignore 1 2 3) + bar #'spam)) + (`(if-let* ((,e (or erc--server-reconnecting erc--target-priors)) + ((alist-get 'erc-my-mode ,e))) + (setq foo (alist-get 'foo ,e) + bar (alist-get 'bar ,e)) + (setq foo (ignore 1 2 3) + bar #'spam)) + t)))) + (ert-deftest erc--target-from-string () (should (equal (erc--target-from-string "#chan") #s(erc--target-channel "#chan" \#chan))) From 75a412d78b6f4b4b68a7c649047cd28320110c09 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 7 May 2023 07:28:56 -0700 Subject: [PATCH 31/33] Optionally add spacing between ERC messages * etc/ERC-NEWS: Mention option `erc-fill-line-spacing'. * lisp/erc/erc-fill.el (erc-fill-line-spacing, erc-fill-spaced-commands): Add options to allow for extra spacing between messages. (erc-fill--function): Internal var allowing modules to override user option `erc-fill-function'. (erc-fill): Add extra line-spacing on certain types of messages. Prefer `erc-fill--function', when set, over `erc-fill-function'. (erc-fill--make-module-dependency-msg, erc-fill--wrap-ensure-dependencies): Rename former to latter and make more useful. (erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable): Refactor. (erc-fill--wrap-fix): Remove unused function. (erc-fill-wrap-nudge): Remove reference to nonexistent function in doc string. * test/lisp/erc/erc-fill-tests.el: (erc-fill-tests--graphic-dir): New variable. (erc-fill-tests--compare): Look in `erc-fill-tests--graphic-dir' for graphical snapshots ignored by Git. (erc-fill-line-spacing): New test. * test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: New file. (Bug#60936) --- etc/ERC-NEWS | 7 + lisp/erc/erc-fill.el | 163 +++++++++--------- test/lisp/erc/erc-fill-tests.el | 24 ++- .../fill/snapshots/spacing-01-mono.eld | 1 + 4 files changed, 110 insertions(+), 85 deletions(-) create mode 100644 test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index f2a8eb72b95..1aa445c5b9c 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -90,6 +90,13 @@ from the same connection. This customization depends on the option 'frame'. If you find the name 'displayed' unhelpful, please suggest an alternative by writing to the mailing list. +** Module 'fill' can add a bit of space between messages. +On graphical displays, it's now possible to add some breathing room +around certain messages via the new option 'erc-fill-line-spacing'. +This is especially handy when using the option 'erc-fill-wrap-merge' +to omit repeated speaker tags, which can make message boundaries less +detectable by tired eyes. + ** Some keybindings are now set by modules rather than their libraries. To put it another way, simply loading a built-in module's library no longer modifies 'erc-mode-map'. Instead, modifications occur during diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index bf995a5a5e6..074e789f719 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -116,12 +116,30 @@ Set to nil to disable." "The column at which a filled paragraph is broken." :type 'integer) +(defcustom erc-fill-line-spacing nil + "Extra space between messages on graphical displays. +This may need adjusting depending on how your faces are +configured. Its value should be larger than that of the variable +`line-spacing', if set. If unsure, try 0.5." + :package-version '(ERC . "5.6") ; FIXME sync on release + :type '(choice (const nil) number)) + +(defcustom erc-fill-spaced-commands '(PRIVMSG NOTICE) + "Types of mesages to add space between on graphical displays. +Only considered when `erc-fill-line-spacing' is non-nil." + :package-version '(ERC . "5.6") ; FIXME sync on release + :type '(set integer symbol)) + +(defvar-local erc-fill--function nil + "Internal copy of `erc-fill-function'. +Takes precedence over the latter when non-nil.") + ;;;###autoload (defun erc-fill () "Fill a region using the function referenced in `erc-fill-function'. You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'." (unless (erc-string-invisible-p (buffer-substring (point-min) (point-max))) - (when erc-fill-function + (when (or erc-fill--function erc-fill-function) ;; skip initial empty lines (goto-char (point-min)) (save-match-data @@ -130,7 +148,19 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'." (unless (eobp) (save-restriction (narrow-to-region (point) (point-max)) - (funcall erc-fill-function)))))) + (funcall (or erc-fill--function erc-fill-function)) + (when-let* ((erc-fill-line-spacing) + (p (point-min))) + (widen) + (when (or (and-let* ((cmd (get-text-property p 'erc-command))) + (memq cmd erc-fill-spaced-commands)) + (and-let* ((cmd (save-excursion + (forward-line -1) + (get-text-property (point) + 'erc-command)))) + (memq cmd erc-fill-spaced-commands))) + (put-text-property (1- p) p + 'line-spacing erc-fill-line-spacing)))))))) (defun erc-fill-static () "Fills a text such that messages start at column `erc-fill-static-center'." @@ -264,71 +294,63 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." (defvar erc-button-mode) (defvar erc-match--hide-fools-offset-bounds) -(defun erc-fill--make-module-dependency-msg (module) - (concat "Enabling default global module `" module "' needed by local" - " module `fill-wrap'. This will impact \C-]all\C-] ERC" - " sessions. Add `" module "' to `erc-modules' to avoid this" - " warning. See Info:\"(erc) Modules\" for more.")) +(defun erc-fill--wrap-ensure-dependencies () + (let (missing-deps) + (unless erc-fill-mode + (push 'fill missing-deps) + (erc-fill-mode +1)) + (when erc-fill-wrap-merge + (require 'erc-button) + (unless erc-button-mode + (push 'button missing-deps) + (erc-button-mode +1)) + (require 'erc-stamp) + (unless erc-stamp-mode + (push 'stamp missing-deps) + (erc-stamp-mode +1))) + (when missing-deps + (erc--warn-once-before-connect 'erc-fill-wrap-mode + "Enabling missing global modules %s needed by local" + " module `fill-wrap'. This will impact \C-]all\C-] ERC" + " sessions. Add them to `erc-modules' to avoid this" + " warning. See Info:\"(erc) Modules\" for more." + (mapcar (lambda (s) (format "`%s'" s)) missing-deps))))) ;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill) (define-erc-module fill-wrap nil "Fill style leveraging `visual-line-mode'. -This module displays nickname labels for speakers as overhanging -leftward (and thus right-aligned) to a common offset, as -determined by the option `erc-fill-static-center'. It depends on -the `fill' and `button' modules and assumes the option +This local module displays nicks overhanging leftward to a common +offset, as determined by the option `erc-fill-static-center'. It +depends on the `fill' and `button' modules and assumes the option `erc-insert-timestamp-function' is `erc-insert-timestamp-right' -or `erc-insert-timestamp-left-and-right' (recommended) so that it +or the default `erc-insert-timestamp-left-and-right', so that it can display right-hand stamps in the right margin. A value of -`erc-insert-timestamp-left' is unsupported. This local module -depends on the global `fill' module. To use it, either include -`fill-wrap' in `erc-modules' or set `erc-fill-function' to -`erc-fill-wrap' (recommended). You can also manually invoke one -of the minor-mode toggles as usual." - ((let (msg) - (unless erc-fill-mode - (unless (memq 'fill erc-modules) - (setq msg - ;; FIXME use `erc-button--display-error-notice-with-keys' - ;; when bug#60933 is ready. - (erc-fill--make-module-dependency-msg "fill"))) - (erc-fill-mode +1)) - (when erc-fill-wrap-merge - (require 'erc-button) - (unless erc-button-mode - (unless (memq 'button erc-modules) - (setq msg (concat msg (and msg " ") - (erc-fill--make-module-dependency-msg "button")))) - (erc-with-server-buffer - (erc-button-mode +1))) - (add-hook 'erc-button--prev-next-predicate-functions - #'erc-fill--wrap-merged-button-p nil t)) - ;; Set local value of user option (can we avoid this somehow?) - (unless (eq erc-fill-function #'erc-fill-wrap) - (setq-local erc-fill-function #'erc-fill-wrap)) - (when-let* ((vars (or erc--server-reconnecting erc--target-priors)) - ((alist-get 'erc-fill-wrap-mode vars))) - (setq erc-fill--wrap-visual-keys (alist-get 'erc-fill--wrap-visual-keys - vars) - erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars))) - (add-function :filter-args (local 'erc-stamp--insert-date-function) - #'erc-fill--wrap-stamp-insert-prefixed-date) - (when (or erc-stamp-mode (memq 'stamp erc-modules)) - (erc-stamp--display-margin-mode +1)) - (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules)) - (require 'erc-match) - (setq erc-match--hide-fools-offset-bounds t)) - (setq erc-fill--wrap-value - (or erc-fill--wrap-value erc-fill-static-center)) - (visual-line-mode +1) - (unless (local-variable-p 'erc-fill--wrap-visual-keys) - (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys)) - (when msg - (erc-display-error-notice nil msg)))) +`erc-insert-timestamp-left' is unsupported. To use it, either +include `fill-wrap' in `erc-modules' or set `erc-fill-function' +to `erc-fill-wrap' (recommended). You can also manually invoke +one of the minor-mode toggles if really necessary." + ((erc-fill--wrap-ensure-dependencies) + ;; Restore or initialize local state variables. + (erc--restore-initialize-priors erc-fill-wrap-mode + erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys + erc-fill--wrap-value erc-fill-static-center) + (setq erc-fill--function #'erc-fill-wrap) + ;; Internal integrations. + (add-function :filter-args (local 'erc-stamp--insert-date-function) + #'erc-fill--wrap-stamp-insert-prefixed-date) + (when (or erc-stamp-mode (memq 'stamp erc-modules)) + (erc-stamp--display-margin-mode +1)) + (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules)) + (require 'erc-match) + (setq erc-match--hide-fools-offset-bounds t)) + (when erc-fill-wrap-merge + (add-hook 'erc-button--prev-next-predicate-functions + #'erc-fill--wrap-merged-button-p nil t)) + (visual-line-mode +1)) ((when erc-stamp--display-margin-mode (erc-stamp--display-margin-mode -1)) (kill-local-variable 'erc-fill--wrap-value) - (kill-local-variable 'erc-fill-function) + (kill-local-variable 'erc-fill--function) (kill-local-variable 'erc-fill--wrap-visual-keys) (remove-hook 'erc-button--prev-next-predicate-functions #'erc-fill--wrap-merged-button-p t) @@ -422,28 +444,6 @@ See `erc-fill-wrap-mode' for details." (defun erc-fill--wrap-merged-button-p (point) (equal "" (get-text-property point 'display))) -;; This is an experimental helper for third-party modules. You could, -;; for example, use this to automatically resize the prefix to a -;; fraction of the window's width on some event change. Another use -;; case would be to fix lines affected by toggling a display-oriented -;; mode, like `display-line-numbers-mode'. - -(defun erc-fill--wrap-fix (&optional value) - "Re-wrap from `point-min' to `point-max'. -That is, recalculate the width of all accessible lines and reset -local prefix VALUE when non-nil." - (save-excursion - (when value - (setq erc-fill--wrap-value value)) - (let ((inhibit-field-text-motion t) - (inhibit-read-only t)) - (goto-char (point-min)) - (while (and (zerop (forward-line)) - (< (point) (min (point-max) erc-insert-marker))) - (save-restriction - (narrow-to-region (line-beginning-position) (line-end-position)) - (erc-fill-wrap)))))) - (defun erc-fill--wrap-nudge (arg) (when (zerop arg) (setq arg (- erc-fill-static-center erc-fill--wrap-value))) @@ -463,8 +463,7 @@ Offer to repeat command in a manner similar to \\`)' Reset the right margin to the default Note that misalignment may occur when messages contain -decorations applied by third-party modules. See -`erc-fill--wrap-fix' for a temporary workaround." +decorations applied by third-party modules." (interactive "p") (unless erc-fill--wrap-value (cl-assert (not erc-fill-wrap-mode)) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 170436ffbaa..fc33d0b9103 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -120,10 +120,14 @@ ;; Obviously, only run one test at a time. (defvar erc-fill-tests--save-p nil) +;; On graphical displays, echo .graphic >> .git/info/exclude +(defvar erc-fill-tests--graphic-dir "fill/snapshots/.graphic") + (defun erc-fill-tests--compare (name) - (when (display-graphic-p) - (setq name (concat name "-graphic"))) - (let* ((dir (expand-file-name "fill/snapshots/" (ert-resource-directory))) + (let* ((dir (expand-file-name (if (display-graphic-p) + erc-fill-tests--graphic-dir + "fill/snapshots/") + (ert-resource-directory))) (expect-file (file-name-with-extension (expand-file-name name dir) "eld")) (erc--own-property-names @@ -232,6 +236,20 @@ " " " " " " " " " " " " " ") (erc-fill-tests--compare "merge-02-right"))))) +(ert-deftest erc-fill-line-spacing () + :tags '(:unstable) + (unless (>= emacs-major-version 29) + (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'")) + + (let ((erc-fill-line-spacing 0.5)) + (erc-fill-tests--wrap-populate + (lambda () + (erc-fill-tests--insert-privmsg "bob" "This buffer is for text.") + (erc-display-message nil 'notice (current-buffer) "one two three") + (erc-display-message nil 'notice (current-buffer) "four five six") + (erc-fill-tests--insert-privmsg "bob" "Somebody stop me") + (erc-fill-tests--compare "spacing-01-mono"))))) + (ert-deftest erc-fill-wrap-visual-keys--body () :tags '(:unstable) (erc-fill-tests--wrap-populate diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld new file mode 100644 index 00000000000..45c3883b023 --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld @@ -0,0 +1 @@ +#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n This buffer is for text.\n*** one two three\n*** four five six\n Somebody stop me\n" 2 21 (erc-timestamp 0 line-prefix (space :width (- 27 18)) field erc-timestamp) 21 183 (erc-timestamp 0 wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (erc-timestamp 0 field erc-timestamp wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (line-spacing 0.5 wrap-prefix #2# line-prefix #3#) 191 192 (erc-timestamp 0 wrap-prefix #2# line-prefix #4=(space :width (- 27 (8))) erc-command PRIVMSG) 192 197 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 197 199 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 199 202 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 202 315 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 315 316 (erc-timestamp 0 erc-command PRIVMSG) 316 348 (erc-timestamp 0 wrap-prefix #2# line-prefix #4# erc-command PRIVMSG) 348 349 (line-spacing 0.5 wrap-prefix #2# line-prefix #4#) 349 350 (erc-timestamp 0 wrap-prefix #2# line-prefix #5=(space :width (- 27 (6))) erc-command PRIVMSG) 350 353 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 353 355 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 355 360 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 360 435 (erc-timestamp 0 wrap-prefix #2# line-prefix #5# erc-command PRIVMSG) 435 436 (line-spacing 0.5 wrap-prefix #2# line-prefix #5#) 436 437 (erc-timestamp 0 wrap-prefix #2# line-prefix #6=(space :width (- 27 0)) display #7="" erc-command PRIVMSG) 437 440 (erc-timestamp 0 wrap-prefix #2# line-prefix #6# display #7# erc-command PRIVMSG) 440 442 (erc-timestamp 0 wrap-prefix #2# line-prefix #6# display #7# erc-command PRIVMSG) 442 466 (erc-timestamp 0 wrap-prefix #2# line-prefix #6# erc-command PRIVMSG) 466 467 (line-spacing 0.5 wrap-prefix #2# line-prefix #6#) 467 484 (erc-timestamp 0 wrap-prefix #2# line-prefix #8=(space :width (- 27 (4)))) 484 485 (wrap-prefix #2# line-prefix #8#) 485 502 (erc-timestamp 0 wrap-prefix #2# line-prefix #10=(space :width (- 27 (4)))) 502 503 (line-spacing 0.5 wrap-prefix #2# line-prefix #10#) 503 504 (erc-timestamp 0 wrap-prefix #2# line-prefix #9=(space :width (- 27 (6))) erc-command PRIVMSG) 504 507 (erc-timestamp 0 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 507 525 (erc-timestamp 0 wrap-prefix #2# line-prefix #9# erc-command PRIVMSG) 525 526 (wrap-prefix #2# line-prefix #9#)) \ No newline at end of file From 867b104010760c4b7cd700078884cc774a01860a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 7 May 2023 19:43:57 -0700 Subject: [PATCH 32/33] Make some module toggles more resilient in ERC * lisp/erc/erc-goodies.el (erc-scrolltobottom-mode, erc-scrolltobottom-enable, erc-move-to-prompt-mode, erc-move-to-prompt-enable): Guard setup procedure behind `erc--updating-modules-p'. * lisp/erc/erc-imenu.el (erc-imenu-mode, erc-imenu-enable, erc-imenu-disable): Don't run setup when `erc--updating-modules-p' is non-nil. Also, don't restrict teardown to buffers of the same process. * lisp/erc/erc-match.el (erc-match-mode, erc-match-enable): Run major-mode hook member immediately outside of `erc-update-modules' in `erc-open'. * lisp/erc/erc-spelling.el (erc-spelling-mode, erc-spelling-enable): Only conditionally run setup immediately. * lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-enable, erc-stamp-disable): Run setup hook immediately. Don't forget to kill local vars in all ERC buffers during teardown. * lisp/erc/erc.el (erc--updating-modules-p): New variable that global modules can use to provide their `erc-mode-hook'-deferred code on demand while shielding it from running during early ERC buffer initialization. (erc-open): Make `erc--updating-modules-p' non-nil while activating global modules. (Bug#60936) --- lisp/erc/erc-goodies.el | 10 ++++------ lisp/erc/erc-imenu.el | 5 +++-- lisp/erc/erc-match.el | 2 ++ lisp/erc/erc-spelling.el | 5 +++-- lisp/erc/erc-stamp.el | 10 ++++++++-- lisp/erc/erc.el | 23 ++++++++++++++++++++++- 6 files changed, 42 insertions(+), 13 deletions(-) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 4558ff7c076..01eae4b63c5 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -53,9 +53,8 @@ argument to `recenter'." "This mode causes the prompt to stay at the end of the window." ((add-hook 'erc-mode-hook #'erc-add-scroll-to-bottom) (add-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom) - (dolist (buffer (erc-buffer-list)) - (with-current-buffer buffer - (erc-add-scroll-to-bottom)))) + (unless erc--updating-modules-p + (erc-buffer-filter #'erc-add-scroll-to-bottom))) ((remove-hook 'erc-mode-hook #'erc-add-scroll-to-bottom) (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom) (dolist (buffer (erc-buffer-list)) @@ -120,9 +119,8 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'." (define-erc-module move-to-prompt nil "This mode causes the point to be moved to the prompt when typing text." ((add-hook 'erc-mode-hook #'erc-move-to-prompt-setup) - (dolist (buffer (erc-buffer-list)) - (with-current-buffer buffer - (erc-move-to-prompt-setup)))) + (unless erc--updating-modules-p + (erc-buffer-filter #'erc-move-to-prompt-setup))) ((remove-hook 'erc-mode-hook #'erc-move-to-prompt-setup) (dolist (buffer (erc-buffer-list)) (with-current-buffer buffer diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index 526afd32249..9864d7c4042 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -138,9 +138,10 @@ Don't rely on this function, read it first!" ;;;###autoload(autoload 'erc-imenu-mode "erc-imenu" nil t) (define-erc-module imenu nil "Simple Imenu integration for ERC." - ((add-hook 'erc-mode-hook #'erc-imenu-setup)) + ((add-hook 'erc-mode-hook #'erc-imenu-setup) + (unless erc--updating-modules-p (erc-buffer-filter #'erc-imenu-setup))) ((remove-hook 'erc-mode-hook #'erc-imenu-setup) - (erc-with-all-buffers-of-server erc-server-process nil + (erc-with-all-buffers-of-server nil nil (when erc-imenu--create-index-function (setq imenu-create-index-function erc-imenu--create-index-function) (kill-local-variable 'erc-imenu--create-index-function))))) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index c08a640260c..86883260413 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -54,6 +54,8 @@ you can decide whether the entire message or only the sending nick is highlighted." ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append) (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec) + (unless erc--updating-modules-p + (erc-buffer-filter #'erc-match--modify-invisibility-spec)) (erc--modify-local-map t "C-c C-k" #'erc-go-to-log-matches-buffer)) ((remove-hook 'erc-insert-modify-hook #'erc-match-message) (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec) diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el index 8fce2508ceb..8e5424f4162 100644 --- a/lisp/erc/erc-spelling.el +++ b/lisp/erc/erc-spelling.el @@ -39,8 +39,9 @@ ;; Use erc-connect-pre-hook instead of erc-mode-hook as pre-hook is ;; called AFTER the server buffer is initialized. ((add-hook 'erc-connect-pre-hook #'erc-spelling-init) - (dolist (buffer (erc-buffer-list)) - (erc-spelling-init buffer))) + (unless erc--updating-modules-p + (erc-with-all-buffers-of-server nil nil + (erc-spelling-init (current-buffer))))) ((remove-hook 'erc-connect-pre-hook #'erc-spelling-init) (dolist (buffer (erc-buffer-list)) (with-current-buffer buffer (flyspell-mode 0))))) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index f90a8fc50b1..9191bbe5a2a 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -165,11 +165,17 @@ from entering them and instead jump over them." ((add-hook 'erc-mode-hook #'erc-munge-invisibility-spec) (add-hook 'erc-insert-modify-hook #'erc-add-timestamp t) (add-hook 'erc-send-modify-hook #'erc-add-timestamp t) - (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)) + (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) + (unless erc--updating-modules-p + (erc-buffer-filter #'erc-munge-invisibility-spec))) ((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec) (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) - (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect))) + (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) + (erc-with-all-buffers-of-server nil nil + (kill-local-variable 'erc-timestamp-last-inserted) + (kill-local-variable 'erc-timestamp-last-inserted-left) + (kill-local-variable 'erc-timestamp-last-inserted-right)))) (defun erc-stamp--recover-on-reconnect () (when-let ((priors (or erc--server-reconnecting erc--target-priors))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 5738ee92578..a104d7ad542 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2084,6 +2084,26 @@ Except ignore all local modules, which were introduced in ERC 5.5." (push mode local-modes)) (error "`%s' is not a known ERC module" module))))) +(defvar erc--updating-modules-p nil + "Non-nil when running `erc--update-modules' in `erc-open'. +This allows global modules with known or likely dependents (or +some other reason for activating after session initialization) to +conditionally run setup code traditionally reserved for +`erc-mode-hook' in the setup portion of their mode toggle. Note +that being \"global\", they'll likely want to do so in all ERC +buffers and ensure the code is idempotent. For example: + + (add-hook \\='erc-mode-hook #\\='erc-foo-setup-fn) + (unless erc--updating-modules-p + (erc-with-all-buffers-of-server nil + (lambda () some-condition-p) + (erc-foo-setup-fn))) + +This means that when a dependent module is initializing and +realizes it's missing some required module \"foo\", it can +confidently call (erc-foo-mode 1) without having to learn +anything about the dependency's implementation.") + (defun erc--setup-buffer-first-window (frame a b) (catch 'found (walk-window-tree @@ -2243,7 +2263,8 @@ Returns the buffer for the given server or channel." (set-buffer buffer) (setq old-point (point)) (setq delayed-modules - (erc--merge-local-modes (erc--update-modules) + (erc--merge-local-modes (let ((erc--updating-modules-p t)) + (erc--update-modules)) (or erc--server-reconnecting erc--target-priors))) From a7dcc0d55c641d3a16ed64528e726fb297726cbf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 13 May 2023 17:03:20 +0200 Subject: [PATCH 33/33] Fix regexp bugs * lisp/progmodes/idlwave.el (idlwave-make-tags): * lisp/obsolete/mantemp.el (mantemp-insert-cxx-syntax): Repair obviously over-escaped control characters. --- lisp/obsolete/mantemp.el | 2 +- lisp/progmodes/idlwave.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/obsolete/mantemp.el b/lisp/obsolete/mantemp.el index 5349ec32cab..9fd6c91cc4e 100644 --- a/lisp/obsolete/mantemp.el +++ b/lisp/obsolete/mantemp.el @@ -152,7 +152,7 @@ the lines." (while (re-search-forward "^.+" nil t) (progn (beginning-of-line) - (if (looking-at "struct[\\t ]+\\|class[\\t ]+") + (if (looking-at "struct[\t ]+\\|class[\t ]+") (insert "template ") (insert "template class ")))) (goto-char (point-min)) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 0b5ed93068a..cafd7b95da7 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -3891,7 +3891,7 @@ you specify /." (while (and item) ;; ;; Call etags - (if (not (string-match "^[ \\t]*$" item)) + (if (not (string-match "^[ \t]*$" item)) (progn (message "%s" (concat "Tagging " item "...")) (setq errbuf (get-buffer-create "*idltags-error*"))